首页
论坛
课程
招聘
[原创]Delphi Hook Library(X86/X64)
2013-7-30 22:48 20822

[原创]Delphi Hook Library(X86/X64)

2013-7-30 22:48
20822
第一次在看雪发文.
常常见到有朋友问Hook怎么做和COM的HOOK怎么弄.
来点干货,给Delphi业界朋友做点贡献.把我之前写的一个Delphi Hook库放到了Google Code上.方便大家.
支持X86,X64的函数钩子.线程安全.
封装了对COM对象的Hook.在Hook COM对象的时候方法时会自动判断是Delphi还是其他语言实现的COM对象,从而进行智能处理.

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

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

或者到我的博客下载最新代码:
http://www.raysoftware.cn/?p=357

关键代码如下:
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, dwThreadId);
  if (hThread <> 0) and (hThread <> INVALID_HANDLE_VALUE) then
  begin
    dwSuspendCount := SuspendThread(hThread);
    // SuspendThread返回的是被挂起的引用计数,-1的话是失败.
    if dwSuspendCount <> DWORD(-1) then
    begin
      while (GetThreadContext(hThread, ctx)) do
      begin
        tryTimes := 0;
        IPReg := Pointer({$IFDEF CPUX64}ctx.Rip{$ELSE}ctx.EIP{$ENDIF});
        if (NativeInt(IPReg) >= NativeInt(ACode)) and
          (NativeInt(IPReg) <= (NativeInt(ACode) + ASize)) then
        begin
          ResumeThread(hThread);
          Sleep(100);
          SuspendThread(hThread);
          Inc(tryTimes);
          if tryTimes > 5 then
          begin
            Break;
          end;
        end
        else
        begin
          Result := hThread;
          Break;
        end;
      end;
    end;
  end;
end;
 
function SuspendOtherThread(ACode: Pointer; ASize: Integer): THandles;
var
  hSnap: THandle;
  te: THREADENTRY32;
  nThreadsInProcess: DWORD;
  hThread: THandle;
begin
  Exit;
  hSnap := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, GetCurrentProcessId());
  te.dwSize := SizeOf(te);
 
  nThreadsInProcess := 0;
  if (Thread32First(hSnap, te)) then
  begin
    while True do
    begin
      if (te.th32OwnerProcessID = GetCurrentProcessId()) then
      begin
 
        if (te.th32ThreadID <> GetCurrentThreadId()) then
        begin
          hThread := SuspendOneThread(te.th32ThreadID, ACode, ASize);
          if hThread <> INVALID_HANDLE_VALUE then
          begin
            Inc(nThreadsInProcess);
            SetLength(Result, nThreadsInProcess);
            Result[nThreadsInProcess - 1] := hThread;
          end;
        end
      end;
      te.dwSize := SizeOf(te);
      if not Thread32Next(hSnap, te) then
        Break;
    end;
    // until not Thread32Next(hSnap, te);
  end;
 
  CloseHandle(hSnap);
end;
 
procedure ResumOtherThread(threads: THandles);
var
  i: Integer;
begin
  Exit;
  for i := Low(threads) to High(threads) do
  begin
    ResumeThread(threads[i]);
    CloseHandle(threads[i]);
  end;
end;
 
{
  尝试在指定指针APtr的正负2Gb以内分配内存.32位肯定是这样的.
  64位JMP都是相对的.操作数是32位整数.所以必须保证新的函数在旧函数的正负2GB内.
  否则没法跳转到或者跳转回来.
}
function TryAllocMem(APtr: Pointer; ASize: Cardinal): Pointer;
const
  KB: Int64 = 1024;
  MB: Int64 = 1024 * 1024;
  GB: Int64 = 1024 * 1024 * 1024;
var
  mbi: TMemoryBasicInformation;
  Min, Max: Int64;
  pbAlloc: Pointer;
  sSysInfo: TSystemInfo;
begin
 
  GetSystemInfo(sSysInfo);
  Min := NativeUInt(APtr) - 2 * GB;
  if Min <= 0 then
    Min := 1;
  Max := NativeUInt(APtr) + 2 * GB;
 
  Result := nil;
  pbAlloc := Pointer(Min);
  while NativeUInt(pbAlloc) < Max do
  begin
    if (VirtualQuery(pbAlloc, mbi, SizeOf(mbi)) = 0) then
      Break;
    if ((mbi.State or MEM_FREE) = MEM_FREE) and (mbi.RegionSize >= ASize) and
      (mbi.RegionSize >= sSysInfo.dwAllocationGranularity) then
    begin
      pbAlloc :=
        PByte(ULONG_PTR((ULONG_PTR(pbAlloc) + (sSysInfo.dwAllocationGranularity
        - 1)) div sSysInfo.dwAllocationGranularity) *
        sSysInfo.dwAllocationGranularity);
      Result := VirtualAlloc(pbAlloc, ASize, MEM_COMMIT or MEM_RESERVE
{$IFDEF CPUX64}
        or MEM_TOP_DOWN
{$ENDIF}
        , PAGE_EXECUTE_READWRITE);
      if Result <> nil then
        Break;
    end;
    pbAlloc := Pointer(NativeUInt(mbi.BaseAddress) + mbi.RegionSize);
  end;
 
end;
 
function HookProc(DLLName, FuncName: PChar; NewFunc: Pointer): Pointer;
var
  h: HMODULE;
begin
  Result := nil;
  h := GetModuleHandle(DLLName);
  if h = 0 then
    h := LoadLibrary(DLLName);
  if h = 0 then
    Exit;
  Result := HookProc(GetProcAddress(h, FuncName), NewFunc);
end;
 
function HookProc(Func, NewFunc: Pointer): Pointer;
var
  oldProc: POldProc;
  newProc: PNewProc;
  backCodeSize: Integer;
  newProtected, oldProtected: DWORD;
  threads: THandles;
  nOriginalPriority: Integer;
  JmpAfterBackCode: PJMPCode;
begin
  Result := nil;
  if (Func = nil) or (NewFunc = nil) then
    Exit;
  newProc := PNewProc(Func);
  backCodeSize := CalcHookCodeSize(Func);
  if backCodeSize < 0 then
    Exit;
  nOriginalPriority := GetThreadPriority(GetCurrentThread());
  SetThreadPriority(GetCurrentThread(), THREAD_PRIORITY_TIME_CRITICAL);
  // 改写内存的时候要挂起其他线程,以免造成错误.
  threads := SuspendOtherThread(Func, backCodeSize);
  try
    if not VirtualProtect(Func, backCodeSize, PAGE_EXECUTE_READWRITE,
      oldProtected) then
      Exit;
    //
 
    Result := TryAllocMem(Func, PageSize);
    // VirtualAlloc(nil, PageSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
    if Result = nil then
      Exit;
 
    FillMemory(Result, SizeOf(TOldProc), $90);
    oldProc := POldProc(Result);
{$IFDEF USEINT3}
    oldProc.Int3OrNop := $CC;
{$ENDIF}
    oldProc.BackUpCodeSize := backCodeSize;
    oldProc.OldFuncAddr := Func;
    CopyMemory(@oldProc^.BackCode, Func, backCodeSize);
    JmpAfterBackCode := PJMPCode(@oldProc^.BackCode[backCodeSize]);
{$IFDEF USELONGJMP}
    oldProc^.JmpRealFunc.JMP := $25FF;
    oldProc^.JmpRealFunc.JmpOffset := 0;
    oldProc^.JmpRealFunc.Addr := UIntPtr(Int64(Func) + backCodeSize);
 
    JmpAfterBackCode^.JMP := $25FF;
    JmpAfterBackCode^.JmpOffset := 0;
    JmpAfterBackCode^.Addr := UIntPtr(Int64(Func) + backCodeSize);
 
    oldProc^.JmpHookFunc.JMP := $25FF;
    oldProc^.JmpHookFunc.JmpOffset := 0;
    oldProc^.JmpHookFunc.Addr := UIntPtr(NewFunc);
{$ELSE}
    oldProc^.JmpRealFunc.JMP := $E9;
    oldProc^.JmpRealFunc.Addr := (NativeInt(Func) + backCodeSize) -
      (NativeInt(@oldProc^.JmpRealFunc) + 5);
 
    oldProc^.JmpHookFunc.JMP := $E9;
    oldProc^.JmpHookFunc.Addr := NativeInt(NewFunc) -
      (NativeInt(@oldProc^.JmpHookFunc) + 5);
{$ENDIF}
    //
    FillMemory(Func, backCodeSize, $90);
 
    newProc^.JMP := $E9;
    newProc^.Addr := NativeInt(@oldProc^.JmpHookFunc) -
      (NativeInt(@newProc^.JMP) + 5);;
    // NativeInt(NewFunc) - (NativeInt(@newProc^.JMP) + 5);
 
    if not VirtualProtect(Func, backCodeSize, oldProtected, newProtected) then
      Exit;
    // 刷新处理器中的指令缓存.以免这部分指令被缓存.执行的时候不一致.
    FlushInstructionCache(GetCurrentProcess(), newProc, backCodeSize);
    FlushInstructionCache(GetCurrentProcess(), oldProc, PageSize);
  finally
    ResumOtherThread(threads);
    SetThreadPriority(GetCurrentThread(), nOriginalPriority);
  end;
end;
 
function UnHook(OldFunc: Pointer): boolean;
var
  oldProc: POldProc ABSOLUTE OldFunc;
  newProc: PNewProc;
  backCodeSize: Integer;
  newProtected, oldProtected: DWORD;
  threads: THandles;
  nOriginalPriority: Integer;
begin
  Result := FALSE;
  if (OldFunc = nil) then
    Exit;
  backCodeSize := oldProc^.BackUpCodeSize;
  newProc := PNewProc(oldProc^.OldFuncAddr);
 
  nOriginalPriority := GetThreadPriority(GetCurrentThread());
  SetThreadPriority(GetCurrentThread(), THREAD_PRIORITY_TIME_CRITICAL);
  threads := SuspendOtherThread(oldProc, SizeOf(TOldProc));
  try
    if not VirtualProtect(newProc, backCodeSize, PAGE_EXECUTE_READWRITE,
      oldProtected) then
      Exit;
 
    CopyMemory(newProc, @oldProc^.BackCode, oldProc^.BackUpCodeSize);
 
    if not VirtualProtect(newProc, backCodeSize, oldProtected, newProtected)
    then
      Exit;
    VirtualFree(oldProc, PageSize, MEM_FREE);
    // 刷新处理器中的指令缓存.以免这部分指令被缓存.执行的时候不一致.
    FlushInstructionCache(GetCurrentProcess(), newProc, backCodeSize);
  finally
    ResumOtherThread(threads);
    SetThreadPriority(GetCurrentThread(), nOriginalPriority);
  end;
end;
 
function CalcInterfaceMethodAddr(var AInterface; AMethodIndex: Integer)
  : Pointer;
type
  TBuf = array [0 .. $FF] of byte;
  PBuf = ^TBuf;
var
  pp: PPointer;
  buf: PBuf;
begin
  pp := PPointer(AInterface)^;
  Inc(pp, AMethodIndex);
  Result := pp^;
  { Delphi的COM对象的方法表比较特别,COM接口实际上是对象的一个成员,实际上调用到
    方法后Self是这个接口成员的地址,所以Delphi的COM方法不直接指向对象方法,而是指向
    一小段机器指令,把Self减去(加负数)这个成员在对象中的偏移,修正好Self指针后再跳转
    到真正对象的方法入口.
 
    所以这里要"偷窥"一下方法指针指向的头几个字节,如果是修正Self指针的,那么就是Delphi
    实现的COM对象.我们就再往下找真正的对象地址.
 
    下面代码就是判断和处理Delphi的COM对象的.其他语言实现的COM对象会自动忽略的.
    因为正常的函数头部都是对于栈底的处理或者参数到局部变量的处理代码.
    绝不可能一上来修正第一个参数,也就是Self的指针.所以根据这个来判断.
  }
  buf := Result;
  {
    add Self,[-COM对象相对实现对象偏移]
    JMP  真正的方法
    这样的就是Delphi生成的COM对象方法的前置指令
  }
{$IFDEF CPUX64}
  // add rcx, -COM对象的偏移, JMP 真正对象的方法地址,X64中只有一种stdcall调用约定.其他约定都是stdcall的别名
  if (buf^[0] = $48) and (buf^[1] = $81) and (buf^[2] = $C1) and (buf^[7] = $E9)
  then
    Result := Pointer(NativeInt(@buf[$C]) + PDWORD(@buf^[8])^);
{$ELSE}
  // add [esp + $04],-COM对象的偏移, JMP真正的对象地址,stdcall/cdecl调用约定
  if (buf^[0] = $81) and (buf^[1] = $44) and (buf^[2] = $24) and
    (buf^[03] = $04) and (buf^[8] = $E9) then
    Result := Pointer(NativeInt(@buf[$D]) + PDWORD(@buf^[9])^)
  else // add eax,-COM对象的偏移, JMP真正的对象地址,那就是Register调用约定的
    if (buf^[0] = $05) and (buf^[5] = $E9) then
      Result := Pointer(NativeInt(@buf[$A]) + PDWORD(@buf^[6])^);
{$ENDIF}
end;
 
function HookInterface(var AInterface; AMethodIndex: Integer;
  NewFunc: Pointer): Pointer;
begin
  Result := HookProc(CalcInterfaceMethodAddr(AInterface, AMethodIndex),
    NewFunc);
end;
 
end.

2021 KCTF 秋季赛 防守篇-征题倒计时(11月14日截止)!

收藏
点赞0
打赏
分享
最新回复 (19)
雪    币: 203
活跃值: 活跃值 (10)
能力值: ( LV9,RANK:290 )
在线值:
发帖
回帖
粉丝
clide2000 活跃值 7 2013-7-30 23:06
2
0
感谢分享,收藏备用
雪    币: 138
活跃值: 活跃值 (15)
能力值: ( LV3,RANK:20 )
在线值:
发帖
回帖
粉丝
ProbieTmp 活跃值 2013-7-30 23:15
3
0
板凳~。
雪    币: 35757
活跃值: 活跃值 (153657)
能力值: (RANK:10 )
在线值:
发帖
回帖
粉丝
linhanshi 活跃值 2013-7-31 07:56
4
0
+1
雪    币: 40
活跃值: 活跃值 (10)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
SkyMade 活跃值 2013-7-31 09:16
5
0
这个纯干货,谢谢楼主分享了。。。学习了。
雪    币: 1781
活跃值: 活跃值 (53)
能力值: ( LV9,RANK:370 )
在线值:
发帖
回帖
粉丝
fosom 活跃值 8 2013-7-31 09:28
6
0
感谢分享,收藏备用
雪    币: 1267
活跃值: 活跃值 (10)
能力值: ( LV3,RANK:30 )
在线值:
发帖
回帖
粉丝
suiyu 活跃值 2013-7-31 11:05
7
0
其实对于Com的HOOK有一个更智能的方式,不必要自己去指定MethodIndex,自己指定这个,貌似也不太现实。Hook COM,可以先在内存中加载,创建对应的内容信息,然后获得要挂钩的函数偏移,之后根据偏移,可以计算出实际的地址,这样就不用指定这个Methodindex了。
雪    币: 111
活跃值: 活跃值 (59)
能力值: ( LV3,RANK:20 )
在线值:
发帖
回帖
粉丝
wr960204 活跃值 2013-7-31 14:05
8
0
之所以指定Index实际上就是用来计算偏移的.否则怎么计算偏移呢
雪    币: 177
活跃值: 活跃值 (255)
能力值: (RANK:290 )
在线值:
发帖
回帖
粉丝
viphack 活跃值 4 2013-7-31 15:01
9
0
备份~~
雪    币: 1267
活跃值: 活跃值 (10)
能力值: ( LV3,RANK:30 )
在线值:
发帖
回帖
粉丝
suiyu 活跃值 2013-7-31 15:54
10
0
可以计算的!先获取基地址,获取接口,之后获取接口中的函数的地址,地址对应的基地址的偏移就是的了!以前Hook D3D和OPENGL的时候,就是这样整的,不过不通用,只能针对性的Hook某函数
雪    币: 111
活跃值: 活跃值 (59)
能力值: ( LV3,RANK:20 )
在线值:
发帖
回帖
粉丝
wr960204 活跃值 2013-7-31 16:56
11
0
我之前Hook D3D也是用Index算的,Index一样要取基地址,接口,方法表地址,但是你总要知道你要Hook对应的是方法表中的第几个函数啊.
雪    币: 216
活跃值: 活跃值 (120)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
dayang 活跃值 2013-7-31 20:04
12
0
wr960204武稀松.2012.2
武稀松,这个名字亮了
雪    币: 21
活跃值: 活跃值 (229)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
靴子 活跃值 2013-8-1 12:56
13
0
先备份 后学习
雪    币: 1267
活跃值: 活跃值 (10)
能力值: ( LV3,RANK:30 )
在线值:
发帖
回帖
粉丝
suiyu 活跃值 2013-8-1 14:13
14
0
。。。不知道怎么说了,方式不同,我说的那种不是通用方法!你这个是通用方法
雪    币: 1267
活跃值: 活跃值 (10)
能力值: ( LV3,RANK:30 )
在线值:
发帖
回帖
粉丝
suiyu 活跃值 2013-8-1 14:15
15
0
呵呵,这个可是Delphi界前辈级的牛A-牛C中间的人物!
雪    币: 85
活跃值: 活跃值 (10)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
kevinjian 活跃值 2013-8-1 14:26
16
0
第一句就没看懂。我是来膜拜的
雪    币: 213
活跃值: 活跃值 (10)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
twofishboy 活跃值 2013-8-5 14:59
17
0
收藏备用的好东西啊
雪    币: 214
活跃值: 活跃值 (10)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
Jameszhou 活跃值 2013-8-5 23:15
18
0
好东西啊
收藏一下,慢慢看
雪    币: 197
活跃值: 活跃值 (131)
能力值: ( LV7,RANK:100 )
在线值:
发帖
回帖
粉丝
aqtata 活跃值 2 2013-8-6 08:24
19
0
LZ的博文是很有水平的,支持!
Delphi在这方面确实比较空白,C++下都有hook库,LZ也算填了个空白
雪    币: 111
活跃值: 活跃值 (59)
能力值: ( LV3,RANK:20 )
在线值:
发帖
回帖
粉丝
wr960204 活跃值 2013-8-6 21:48
20
0
其实也不算填补空白,估计很多Delphi码农兄弟们早就有自己的Hook库了,只是自己用没发布.
比如这个是我在2012写的.之前2002年的时候我就写了自己的Delphi Hook库.2012年重写是因为Delphi支持64位编译器.

现在发布了是方便初学者不会写Hook代码的或者减少大家重复造轮子.
游客
登录 | 注册 方可回帖
返回