Globaler API-Hook funktioniert nicht

[Neutral General]

Hi,

Im Moment funktionierts nicht so ganz. Also die Delphi IDE ballert mich dauernd mit ShowMessages zu aber sonst siehts mager aus.

Hier mal die ganze DLL (wobei ShowMessage zum Debuggen gedacht ist )

Delphi-Quellcode:

library FindNextFileHook;

uses
  Windows, SysUtils, Dialogs;

type
  TFindNext = function (hFindFile: THandle; var lpFindFileData: TWIN32FindData): BOOL; stdcall;

var
  Hook: hHook;

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

var FindNextOld: TFindNext = nil;
    tmp: THandle = INVALID_HANDLE_VALUE;

function MyFindNextFile(hFindFile: THandle; var lpFindFileData: TWIN32FindData): BOOL; stdcall;
var s: String;
begin
  s := lpFIndFileData.cFileName;
  if ExtractFileExt(s) = '.txt' then
    ShowMessage('Erwischt!');
end;

function NextHook(var F: TSearchRec): Integer;
asm
  nop
  nop
  nop
  nop
  nop
  add FindNextOld,5
  jmp FindNextOld
end;

procedure FindNextHooked;
asm
  push [esp+8]
  push [esp+8]
  call nexthook 
  sub FindNextOld,5
  jmp MyFindNextFile
  ret
end;

procedure HookFindNext;
var hProc: THandle;
    br,old: Cardinal;
    jmp: Pointer;
    Sicherung: Pointer;
    lib: hModule;
begin
  if @FindNextOld = nil then
  begin
    Lib := LoadLibrary('kernel32.dll');
    FindNextOld := GetProcAddress(lib,'FindNextFileA');
    FreeLibrary(lib);
  end;
  GetMem(jmp,5);
  hProc := OpenProcess(PROCESS_ALL_ACCESS,false,GetCurrentProcessID);
  try
    // Auslesen / Sichern
    VirtualProtectEx(hProc,@FindNextOld,5,PAGE_EXECUTE_WRITECOPY,old);
    GetMem(Sicherung,5);
    ReadProcessMemory(hProc,@FindNextOld,Sicherung,5,br);
    WriteProcessMemory(hProc,@NextHook,Sicherung,5,br);
    // Schreiben
    PByte(jmp)^ := $E9;
    inc(PByte(jmp));
    PCardinal(jmp)^ := Cardinal(@FindNextHooked) - Cardinal(@FindNextOld) - 5;
    dec(PByte(jmp));
    WriteProcessMemory(hProc,@FindNextOld,jmp,5,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.

Gruß
Neutral General