在Delphi中挂钩DLL函数

Question

我有一个coclass检查注册表以确定是否安装了一个应用程序,但它做得很差,并没有找到更新版本的应用程序.如果已安装竞争应用程序,它将尝试打开该应用程序.如果已卸载竞争应用程序,程序将崩溃.这个coclass是在DLL文件中定义的,我没有库的源代码,所以我不能只改变它.我一直在研究使用钩子来替换有效的功能,但是当我查看使用SetWindowsHookEx的MSDN文档时,它似乎很复杂.有人可以提供一个如何使用SetWindowsHookEx或其他方法挂钩到Windows的示例吗？

谢谢

编辑:我想说明我接受了我的答案,因为它对我有用.在提出问题时我无法使用其他答案,但它看起来同样好.

Answer 1

这是我自己的代码库中的一个简短示例,它显示了最基本的挂钩技术:

unit MethodHooker;

interface

implementation

uses
  SysUtils, Windows, Classes;

procedure Patch(Address: Pointer; const NewCode; Size: Integer);
var
  NumberOfBytes: DWORD;
begin
  WriteProcessMemory(GetCurrentProcess, Address, @NewCode, Size, NumberOfBytes);
end;

type
  PInstruction = ^TInstruction;
  TInstruction = packed record
    Opcode: Byte;
    Offset: Integer;
  end;

procedure Redirect(OldAddress, NewAddress: Pointer);
var
  NewCode: TInstruction;
begin
  NewCode.Opcode := $E9;//jump relative
  NewCode.Offset := Integer(NewAddress)-Integer(OldAddress)-SizeOf(NewCode);
  Patch(OldAddress, NewCode, SizeOf(NewCode));
end;

function GetCursorPos(var lpPoint: TPoint): BOOL; stdcall;
(* The GetCursorPos API in user32 fails if it is passed a memory address >2GB which
   breaks LARGEADDRESSAWARE apps.  We counter this by calling GetCursorInfo instead
   which does not suffer from the same problem. *)
var
  CursorInfo: TCursorInfo;
begin
  CursorInfo.cbSize := SizeOf(CursorInfo);
  Result := GetCursorInfo(CursorInfo);
  if Result then begin
    lpPoint := CursorInfo.ptScreenPos;
  end else begin
    lpPoint := Point(0, 0);
  end;
end;

initialization
  if not ModuleIsPackage then begin
    if not CheckWin32Version(6, 1) then begin
      //this bug was fixed in Windows 7
      Redirect(@Windows.GetCursorPos, @MethodHooker.GetCursorPos);
    end;

end.

Answer 2

对于一个非常好的绕行/挂钩单元(可以检查跳跃并应用新的偏移!)我会推荐KOLdetours.pas

我在许多项目中使用它,例如我的AsmProfiler.

顺便说一句:绕道而行,你会得到一个"蹦床",所以你也可以调用原来的功能!