Delphi Hook Library

常常见到有朋友问Hook怎么做和COM的HOOK怎么弄.
来点干货,给Delphi业界朋友做点贡献.把我之前写的一个Delphi Hook库放到了Google Code上.方便大家.
微软官方钩子库Detours X86是免费的,X64可是要1000美刀的哦.
支持X86,X64的函数钩子.线程安全.
封装了对COM对象的Hook.在Hook COM对象的时候方法时会自动判断是Delphi还是其他语言实现的COM对象,从而进行智能处理.

其实代码加注释也就几百行.一个单元文件而已.
其中使用了开源的BeaEngine的反汇编引擎来判断代码的大小,避免机器指令被从中间切开.

Google Code
http://code.google.com/p/delphi-hook-library/

更新在

http://www.raysoftware.cn/?p=493

关键文件按内容如下:

unit HookUtils;

{
  wr960204武稀松.2012.2

  主页  http://www.raysoftware.cn

  通用Hook库.
  支持X86和X64.
  使用了开源的BeaEngine反汇编引擎.BeaEngine的好处是可以用BCB编译成OMF格式的Obj,
  被链接进Delphi的DCU和目标文件中.不需要额外带DLL.
  BeaEngin引擎

http://www.beaengine.org/

  限制:
  1.不能Hook代码大小小于5个字节的函数.
  2.不能Hook前五个字节中有跳转指令的函数.
  希望使用的朋友们自己也具有一定的汇编或者逆向知识.
  Hook函数前请确定该函数不属于上面两种情况.


  另外钩COM对象有一个技巧,如果你想在最早时机勾住某个COM对象,
  可以在你要钩的COM对象创建前自己先创建一个该对象,Hook住,然后释放你自己的对象.
  这样这个函数已经被下钩子了,而且是钩在这个COM对象创建前的.
}
interface

{ 下函数钩子
  64位中会有一种情况失败,就是VirtualAlloc不能在被Hook函数地址正负2Gb范围内分配到内存.
  不过这个可能微乎其微.几乎不可能发生.
}
function HookProc(Func, NewFunc: Pointer): Pointer; overload;
function HookProc(DLLName, FuncName: PChar; NewFunc: Pointer): Pointer;
  overload;
{ 计算COM对象中方法的地址;AMethodIndex是方法的索引.
  AMethodIndex是接口包含父接口的方法的索引.
  例如:
  IA = Interface
  procedure A();//因为IA是从IUnKnow派生的,IUnKnow自己有3个方法,所以AMethodIndex=3
  end;
  IB = Interface(IA)
  procedure B(); //因为IB是从IA派生的,所以AMethodIndex=4
  end;
}
function CalcInterfaceMethodAddr(var AInterface; AMethodIndex: Integer)
  : Pointer;
// 下COM对象方法的钩子
function HookInterface(var AInterface; AMethodIndex: Integer;
  NewFunc: Pointer): Pointer;
// 解除钩子
function UnHook(OldFunc: Pointer): boolean;

implementation

uses
  BeaEngineDelphi, Windows, TLHelp32;

const
  PageSize = 4096;
{$IFDEF CPUX64}
{$DEFINE USELONGJMP}
{$ENDIF}
  { .$DEFINE USEINT3 }// 在机器指令中插入INT3,断点指令.方便调试.

type
  THandles = array of THandle;
  ULONG_PTR = NativeUInt;
  POldProc = ^TOldProc;

  PJMPCode = ^TJMPCode;

  TJMPCode = packed record
{$IFDEF USELONGJMP}
    JMP: Word;
    JmpOffset: Int32;
{$ELSE}
    JMP: byte;
{$ENDIF}
    Addr: UIntPtr;
  end;

  TOldProc = packed record
{$IFDEF USEINT3}
    Int3OrNop: byte;
{$ENDIF}
    BackCode: array [0 .. $20 - 1] of byte;
    JmpRealFunc: TJMPCode;
    JmpHookFunc: TJMPCode;

    BackUpCodeSize: Integer;
    OldFuncAddr: Pointer;
  end;

  PNewProc = ^TNewProc;

  TNewProc = packed record
    JMP: byte;
    Addr: Integer;
  end;

  // 计算需要覆盖的机器指令大小.借助了BeaEngin反汇编引擎.以免指令被从中间切开
function CalcHookCodeSize(Func: Pointer): Integer;
var
  ldiasm: TDISASM;
  len: longint;
begin
  Result := 0;
  ZeroMemory(@ldiasm, SizeOf(ldiasm));
  ldiasm.EIP := UIntPtr(Func);
  ldiasm.Archi := {$IFDEF CPUX64}64{$ELSE}32{$ENDIF};
  while Result < SizeOf(TNewProc) do
  begin
    len := Disasm(ldiasm);
    Inc(ldiasm.EIP, len);
    Inc(Result, len);
  end;
end;

const
  THREAD_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or $3FF;

function OpenThread(dwDesiredAccess: DWORD; bInheritHandle: BOOL;
  dwThreadId: DWORD): THandle; stdcall; external kernel32;

function SuspendOneThread(dwThreadId: NativeUInt; ACode: Pointer;
  ASize: Integer): THandle;
var
  hThread: THandle;
  dwSuspendCount: DWORD;
  ctx: TContext;
  IPReg: Pointer;
  tryTimes: Integer;
begin
  Result := INVALID_HANDLE_VALUE;
  hThread := OpenThread(THREAD_ALL_ACCESS, FALSE, dwThread