Hook sem usar bibliotecas externas

Hooking, ou API Hooking é quando substituimos a entrada de um método qualquer por um método nosso. Assim todas as chamadas de um determinado método chamarão na verdade o método novo.

Existem outras técnicas e bibliotecas para fazer isso. Para dizer a verdade eu não sou expert nesse assunto. Geralmente as bibliotecas tem uma opção/função de callback onde você armazena uma referência à função original, assim pode chamar a função original dentro da substituta, antes ou depois do seu próprio código, para que ela possa ser mais parecida ou equivalente à original, com pouco esforço da sua parte.

Nesta biblioteca que fizemos aqui nós não temos essa opção. Uma vez substituindo a função original  não teremos mais acesso a ela, só a nova, até o momento do UnHook. Além disso não podemos chamar a função original, apenas a nova. Chamar a original dentro da nova é como a nova chamar ela mesma, e isso resulta em loop recursivo e stack overflow.

Isso significa que você é obrigado a sobrescrever inteiramente a lógica da nova.

Esses tipos, funções de API e algoritmos eu retirei (copiei) de sites que fazem patches em bugs da VCL para versões antigas do Delphi, ou que fazem substituições ao Memory Manager. O FastMM por exemplo tem um código muito parecido com esse para substituir o memory manager nativo do delphi pelo proposto por eles.

Não entendo plenamente como e porque funciona isso aqui, mas .... funciona. Quem puder me dar uma ajuda para elucidar e complementar esse assunto aqui neste blog agradeço.

Abaixo o código que eu dei uma alterada:

unit uLazHook;
{**************************************************************************************************}
{                                                                                                  }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
{ License at http://www.mozilla.org/MPL/                                                           }
{                                                                                                  }
{ The Original Code is VCLFixPack.pas.                                                             }
{                                                                                                  }
{ The Initial Developer of the Original Code is Andreas Hausladen (Andreas.Hausladen@gmx.de).      }
{ Portions created by Andreas Hausladen are Copyright © 2008 Andreas Hausladen.                  }
{ All Rights Reserved.                                                                             }
{                                                                                                  }
{**************************************************************************************************}

{$mode objfpc}{$H+}

{$R-} // range check off
interface

type

  //abaixo alguns tipos de estruturas para obter informações da função ReadProcessMemory
  TJumpOfs = Integer;
  PPointer = ^Pointer;

  //esse serve para armazenar a distância entre os pontos de entrada da função original e da sua
  PXRedirCode = ^TXRedirCode;
  TXRedirCode = packed record
    Jump: Byte;
    Offset: TJumpOfs;
  end;

  //não faço idéia ;P
  PWin9xDebugThunk = ^TWin9xDebugThunk;
  TWin9xDebugThunk = packed record
    PUSH: Byte;
    Addr: Pointer;
    JMP: TXRedirCode;
  end;

  //menos ainda
  PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
  TAbsoluteIndirectJmp = packed record
    OpCode: Word;   //$FF25(Jmp, FF /4)
    Addr: PPointer;
  end;

  { TLazHook }
  TLazHook = class
  private
         FProc: Pointer;
         FDestinationProc: Pointer;
         FBackupRedirCode: TXRedirCode;
  public
        constructor Create(Proc, Dest: Pointer);
        destructor Destroy; override;
  end;


implementation
uses
  SysUtils,
  Windows,
  Classes;



//obtem o endereço do método baseado no tipo de SO
function GetActualAddr(Proc: Pointer): Pointer;

  function IsWin9xDebugThunk(AAddr: Pointer): Boolean;
  begin
    //não faço idéia do que significam esses endereços
    Result := (AAddr <> nil) and
              (PWin9xDebugThunk(AAddr)^.PUSH = $68) and
              (PWin9xDebugThunk(AAddr)^.JMP.Jump = $E9);
  end;

begin
  if Proc <> nil then
  begin
    if (Win32Platform <> VER_PLATFORM_WIN32_NT) and IsWin9xDebugThunk(Proc) then
      Proc := PWin9xDebugThunk(Proc)^.Addr;
    //não faço idéia do que significa esse $25ff
    if (PAbsoluteIndirectJmp(Proc)^.OpCode = $25FF) then
      Result := PAbsoluteIndirectJmp(Proc)^.Addr^
    else
      Result := Proc;
  end
  else
    Result := nil;
end;


//cria o hook (substitui uma função na memória pela sua)
procedure HookProc(Proc, Dest: Pointer; var BackupCode: TXRedirCode);
var
  n: DWORD;
  Code: TXRedirCode;
begin
  Proc := GetActualAddr(Proc);
  Assert(Proc <> nil);
  if ReadProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n) then
  begin
    //não sei porque deve ser $E9 nem o que significa, só sei que é 233 em hexadecimal
    Code.Jump := $E9;
    Code.Offset := PAnsiChar(Dest) - PAnsiChar(Proc) - SizeOf(Code);
    WriteProcessMemory(GetCurrentProcess, Proc, @Code, SizeOf(Code), n);
  end;
end;

//faz voltar ao normal
procedure UnhookProc(Proc: Pointer; var BackupCode: TXRedirCode);
var
  n: Cardinal;
begin
  if (BackupCode.Jump <> 0) and (Proc <> nil) then
  begin
    Proc := GetActualAddr(Proc);
    Assert(Proc <> nil);
    WriteProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n);
    BackupCode.Jump := 0;
  end;
end;




{ TLazHook }

//atalho para criar o hook com a facilidade de se usar uma classe
constructor TLazHook.Create(Proc, Dest: Pointer);
begin
     FProc:=Proc;
     FDestinationProc:=Dest;
     HookProc(FProc ,FDestinationProc, FBackupRedirCode);
end;

//destruindo o hook e voltando a procedure ao normal
destructor TLazHook.Destroy;
begin
  UnhookProc(FProc, FBackupRedirCode);
  inherited Destroy;
end;

end.

Agora o código usado para testar o Hook. Repare que são necessários 3 passos:
1) Definir a sua propria função, que deve ter a mesma assinatura que a função (método ou procedimento) hookada/substituída.
2) Criar o objeto de Hook passando como parâmetro ponteiros para os métodos de origem e destino e manter uma referência a este objeto até a hora de destruí-lo
3) quando o hook não for mais necessário ou no momento de fechar o programa devemos desfazer o hook.

No exemplo eu uso uma função com a mesma assinatura que a ShowMessage, chamada MyShowMessage, mas que internamente usa a messagebox, para substituir a ShowMessage. Eu comentei esse exemplo e abaixo fiz outro mais complexo, o contrário: eu sobrescrevo a api do windows MessageBox com uma função minha de mesma assinatura mas com chamada ao ShowMessage internamente. É importante aqui o uso de stdcall para indicar a ordem correta dos argumentos da função, pois a api do windows foi feita em C/C++.

unit Unit1; 

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, uLazHook, windows;

type

  { TfrmHook }

  TfrmHook = class(TForm)
    btCriaHook: TButton;
    btMetodoOriginal: TButton;
    btMeuMetodo: TButton;
    btDestroiHook: TButton;
    procedure btCriaHookClick(Sender: TObject);
    procedure btMetodoOriginalClick(Sender: TObject);
    procedure btMeuMetodoClick(Sender: TObject);

  private
    { private declarations }
  public
    { public declarations }
    FHook: TLazHook;
  end;


var
  frmHook: TfrmHook;

  //minha procedure personalizada
  procedure MyShowMessage(const aMsg: string);
  function MyMessageBox(hWnd:HWND; lpText:LPCSTR; lpCaption:LPCSTR; uType:UINT):longint; stdcall; //stdcall pq a api foi feita em C


implementation

//minha procedure personalizada
procedure MyShowMessage(const aMsg: string);
begin

     //algo feito no início

     //chamada a procedure original
     MessageBox(0, pchar(aMsg), 'Mensagem', MB_ICONINFORMATION);

     //algo feito no fim

end;

function MyMessageBox(hWnd:HWND; lpText:LPCSTR; lpCaption:LPCSTR; uType:UINT):longint; stdcall;
begin
     ShowMessage(string(lpText));
     Result := 0;
end;

{ TfrmHook }

procedure TfrmHook.btCriaHookClick(Sender: TObject);
begin
     {
     FHook := TLazHook.Create(
           @ShowMessage, //ponteiro para a procedure original (seu código vai ser copiado na procedure acima)
           @MyShowMessage //procedure Destino, a que fizemos para substituir
     );
     }

     FHook := TLazHook.Create(
           @MessageBox, //ponteiro para a procedure original (seu código vai ser copiado na procedure acima)
           @MyMessageBox //procedure Destino, a que fizemos para substituir
     );
end;

procedure TfrmHook.btMetodoOriginalClick(Sender: TObject);
begin
     //ShowMessage('Hello World');
     MessageBox(0, 'Hello World', 'Mensagem', 0);
end;

procedure TfrmHook.btMeuMetodoClick(Sender: TObject);
begin
  //MyShowMessage('Hello World');
  MyMessageBox(0, 'Hello World', 'Mensagem', 0);
end;



initialization
  {$I unit1.lrs}

end.

Nesse exemplo só podemos hookar/enganchar/sobrescrever (não faço idéia do termo correto em português) funções no próprio processo e não no windows inteiro. Ainda não sei fazer a parte de injeção de "código" em dll's.
Funciona em Delphi e Lazarus. Para alternar entre os exemplos descomente os de cima e comente os de baixo.

Faça o download e divirta-se ;)