Globaler API-Hook funktioniert nicht

[Neutral General]

Hi,

Ich versuche gerade eine API zu hooken, nämlich FindFileNext.

Das hooken der Funktion selbst funktioniert, aber nicht im Zusammenhang mit einem (globalen) Hook.

Hier die Hook-DLL:

Delphi-Quellcode:

library FindNextFileHook;

uses
  Windows, SysUtils;

var
  Hook: hHook;
  FNCode: Pointer;

function Dummy(code: Integer; wparam: wParam; lparam: lParam): LRESULT; stdcall;
begin
  Result := CallNextHookEx(Hook,Code,wparam,lparam);
end;

function MyFindNextFile(hFindFile: THandle; var lpFindFileData: TWIN32FindData): BOOL; stdcall;
var CurrFile: String;
begin
  Result := FindNextFileA(hFindFile,lpFindFileData);
  CurrFile := PChar(@lpFindFileData.cFileName[0]);
  if ExtractFileExt(CurrFile) = '.txt' then 
    MessageBox(0,'Textdatei gefunden!','FindNextFileHook',MB_OK);
end;

procedure HookFindNext;
var hProc: THandle;
    br: Cardinal;
    jmp: Pointer;
begin
  GetMem(jmp,6);
  hProc := OpenProcess(PROCESS_ALL_ACCESS,false,GetCurrentProcessID);
  try
    // Auslesen / Sichern  
    FNCode := VirtualAllocEx(hProc,nil,6,MEM_COMMIT,PAGE_EXECUTE_READWRITE);
    ReadProcessMemory(hProc,@FindNextFile,FNCode,6,br);
    // Schreiben
    PByte(jmp)^ := $E9;
    inc(PByte(jmp));
    PCardinal(jmp)^ := Cardinal(@MyFindNextFile) - Cardinal(@FindNextFile) - 5;
    inc(PCardinal(jmp));
    PByte(jmp)^ := $E9;
    dec(PByte(jmp),5);
    WriteProcessMemory(hProc,@FindNextFile,jmp,6,br);
  finally
    FreeMem(jmp);
    CloseHandle(hProc);
  end;
end;

function InstallHook: Boolean; stdcall;
begin
  Result := False;
  if Hook = 0 then
  begin
    Hook := SetWindowsHookEx(WH_GETMESSAGE,@Dummy,
                             HInstance,0);
    Result := true;
  end;
end;

function UninstallHook: Boolean; stdcall;
begin
  Result := UnhookWindowsHookEx(Hook);
  Hook := 0;
end;

exports
  InstallHook,
  UnInstallHook;

begin
  HookFindNext;
end.

Das Programm, was den Hook installiert:

Delphi-Quellcode:

unit StartDLL;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    lib: hModule;
  end;

  THookProc = function: Boolean;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var install: THookProc;
begin
  lib := LoadLibrary('FindNextFileHook.dll');
  if lib <> INVALID_HANDLE_VALUE then
  begin
    install := GetProcAddress(lib,'InstallHook');
    if Assigned(install) then
      install;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var un: THookProc;
begin
  if lib <> 0 then
  begin
    un := GetProcAddress(lib,'UnInstallHook');
    if Assigned(un) then
      un;
  end;
  FreeLibrary(lib);
end;

procedure TForm1.FormDestroy(Sender: TObject);
var un: TUninstall;
begin
  if lib <> 0 then
  begin
    un := GetProcAddress(lib,'UnInstallHook');
    if Assigned(un) then
      un;
  end;
  FreeLibrary(lib);
end;

end.

Also ehrlichgesagt kann ich da leider auch nicht viel mehr zu sagen als: "Funktioniert nicht!"...

In der DLL wird HookFindNext ausgeführt und ich habe mir zu Debug-Zwecken auch nach fast jeder Zeile

ShowMessage(SysErrorMessage(GetLastError)); anzeigen lassen. Aber ich gehe eher davon aus, das da ein Hook-Verständnisproblem vorliegt...

Gruß
Neutral General