实现拦截API的钩子(Hook)

道理不多讲，简单说就是将系统API的跳转地址，替换为我们自己写的API的地址，所以要求我们自定义的API函数要和被拦截的API有相同的参数。在用完后，记得恢复。

 

因为要挂全局的钩子，所以Hook的部分，做成DLL。   源码下载

 

Hook.DLL主工程文件代码

library Hook; uses SysUtils, Windows, Classes, ApiDefine in 'ApiDefine.pas', APIHook in 'APIHook.pas'; {$R *.res} var HookHandle: HHook; function HookProc(code:Integer;wparam:WPARAM;lparam:LPARAM):LRESULT;stdcall; begin Result := CallNextHookEx(HookHandle,code,wparam,lparam); end; procedure SetHook;stdcall; begin HookHandle := SetWindowsHookEx(WH_GETMESSAGE,@HookProc,HInstance,0); end; procedure StopHook;stdcall; begin UnhookWindowsHookEx(HookHandle); end; exports SetHook name 'SetHook', StopHook name 'StopHook'; {已启动就挂上，修改API函数指向} begin API_Hook; end.

 

APIHook单元，这个单元实现对API地址的替换

unit APIHook; interface uses Windows, SysUtils, Classes; type //引入表入口数据结构 Image_Import_Entry = packed record OriginalFirstThunk:DWORD; TimeDateStamp:DWORD; ForwarderChain:DWORD; Name:DWORD; FirstThunk:DWORD; end; PImage_Import_Entry = ^Image_Import_Entry; TImportCode = packed record JmpCode: Word; AddressOfPFun: PPointer; end; PImportCode = ^TImportCode; function GetFunTrueAddress(Code:Pointer):Pointer; function ReplaceFunAddress(oldfun:Pointer;newfun:Pointer):Integer; implementation //获得实际地址 function GetFunTrueAddress(Code: Pointer): Pointer; var func: PImportCode; begin Result := Code; if Code = nil then exit; try func := code; if (func.JmpCode = $25FF) then begin Result := func.AddressOfPFun^; end; except Result := nil; end; end; //替换地址 function ReplaceFunAddress(oldfun:Pointer;newfun:Pointer): Integer; var IsDone: TList; function ReplaceAddressInModule(hModule: THandle; OldFunc, NewFunc: Pointer): Integer; var DosHeader: PImageDosHeader; NTHeader: PImageNTHeaders; ImportDesc: PImage_Import_Entry; RVA: DWORD; Func: ^Pointer; DLL: string; f: Pointer; written: DWORD; begin Result := 0; DosHeader := Pointer(hModule); //已经找过，则退出 if IsDone.IndexOf(DosHeader) >= 0 then exit; IsDone.Add(DosHeader); oldfun := GetFunTrueAddress(OldFunc); if IsBadReadPtr(DosHeader, SizeOf(TImageDosHeader)) then exit; if DosHeader.e_magic <> IMAGE_DOS_SIGNATURE then exit; NTHeader := Pointer(Integer(DosHeader) + DosHeader._lfanew); //引入表的虚拟地址 RVA := NTHeader^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress; if RVA = 0 then exit; ImportDesc := pointer(integer(DosHeader) + RVA); while (ImportDesc^.Name <> 0) do begin //引入文件名 DLL := PChar(Integer(DosHeader) + ImportDesc^.Name); //获得该DLL的句柄，然后递归查找 ReplaceAddressInModule(GetModuleHandle(PChar(DLL)), oldfun, newfun); //引入函数入口 Func := Pointer(Integer(DOSHeader) + ImportDesc.FirstThunk); //如果函数指针不为空 while Func^ <> nil do begin //取得真是地址 f := GetFunTrueAddress(Func^); //如果和我们要拦截的Api函数地址一样 if f = oldfun then begin //替换成我们自己的Api地址 WriteProcessMemory(GetCurrentProcess, Func, @NewFunc, 4, written); if Written > 0 then Inc(Result); end; //继续找 Inc(Func); end; Inc(ImportDesc); end; end; begin IsDone := TList.Create; try //GetModuleHandle,参数nil，为获取自身的模块句柄 Result := ReplaceAddressInModule(GetModuleHandle(nil), oldfun, newfun); finally IsDone.Free; end; end; end.

 

ApiDefine单元，这里实现我们自定义的API

unit ApiDefine; interface uses Windows, SysUtils, Classes,Messages,APIHook,ShellAPI; procedure API_Hook; procedure API_UnHook; implementation //自定义Api的类型 type TMsgA = function(hwn: hwnd; lptext: pchar; lpcapion: pchar; utype: cardinal):integer; stdcall; TShellExc = function(hwn: HWND;lpoperate: PChar;lpfilename: PChar; lpparam: PChar; lpdir:PChar;cmd:Integer):Integer;stdcall; TTextOut = function(DC:HDC;X:Integer;Y:Integer;options:Integer;rect:PRect;str:PAnsiChar;count:Integer;dx:PInteger):Boolean;stdcall; var oldMsgA : TMsgA; oldShellExc : TShellExc; oldTextOut : TTextOut; //自定义Api的实现 function NewMsgA(hwn: hwnd; lptext: pchar; lpcaption: pchar; utype: cardinal):integer; stdcall; begin Result := oldMsgA(hwn,'成功拦截MessageBoxA','哈哈',utype); end; function NewShellExc(hwn: HWND;lpoperate: PChar;lpfilename: PChar; lpparam: PChar; lpdir:PChar;cmd:Integer):Integer;stdcall; begin Result := oldShellExc(hwn,lpoperate,'c:/2.txt',lpfilename,lpdir,cmd); end; {TextOut调用的是ExtTextOut} function NewTextOut(DC:HDC;X:Integer;Y:Integer;options:Integer;rect:PRect;str:PAnsiChar;count:Integer;dx:PInteger):Boolean;stdcall; begin {这个rect也是可以修改的，以便容纳更多的字符显示} Result := oldTextOut(DC,50,50,options,rect,'中国',count,dx); end; procedure API_Hook; begin if @oldMsgA = nil then @oldMsgA := GetFunTrueAddress(@MessageBoxA); if @oldShellExc = nil then @oldShellExc := GetFunTrueAddress(@ShellExecute); if @oldTextOut = nil then @oldTextOut := GetFunTrueAddress(@ExtTextOut); //替换 ReplaceFunAddress(@oldMsgA,@NewMsgA); ReplaceFunAddress(@oldShellExc,@NewShellExc); ReplaceFunAddress(@oldTextOut,@NewTextOut); end; procedure API_UnHook; begin if @oldMsgA <> nil then ReplaceFunAddress(@NewMsgA,@oldMsgA); if @oldShellExc <> nil then ReplaceFunAddress(@NewShellExc,@oldShellExc); if @oldTextOut <> nil then ReplaceFunAddress(@NewTextOut,@oldTextOut); end; initialization //结束时恢复原Api地址 finalization API_UnHook; end.

 

主程序代码，大家可以把，消息、打开文件、画文字的代码写到另外的程序，本程序只负责挂钩和摘钩，那样可以看到系统钩子的效果。

unit TestMain; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,ShellAPI; type TForm1 = class(TForm) btn_Hook: TButton; btn_Msg: TButton; btn_UnHook: TButton; btn_OpenFiel: TButton; btn_TextOut: TButton; procedure btn_HookClick(Sender: TObject); procedure btn_MsgClick(Sender: TObject); procedure btn_UnHookClick(Sender: TObject); procedure btn_OpenFielClick(Sender: TObject); procedure btn_TextOutClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation procedure SetHook;stdcall;external 'Hook.dll'; procedure StopHook;stdcall;external 'Hook.dll'; {$R *.dfm} procedure TForm1.btn_HookClick(Sender: TObject); begin SetHook; end; procedure TForm1.btn_UnHookClick(Sender: TObject); begin StopHook; end; {被拦截后，执行我们自己的NewMsgA方法} procedure TForm1.btn_MsgClick(Sender: TObject); begin MessageBoxA(Handle,'能拦住我吗','询问',MB_OK); end; {本想打开c:/1.txt，被拦截后，打开c:/2.txt} procedure TForm1.btn_OpenFielClick(Sender: TObject); begin ShellExecute(Handle,'open','c:/1.txt',nil,nil,SW_NORMAL); end; {本想在0,0出画出'Hello'，被拦截后，在50,50的位置画出'中国'} procedure TForm1.btn_TextOutClick(Sender: TObject); begin Self.Canvas.TextOut(0,0,'Hello'); end; end.

 

下图是执行画文字代码后的效果，本想在[0,0]坐标画出'Hello'，被拦截后，在[50,50]的位置画出'中国'