本文整理自网络,侵删。
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.
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.
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.
相关阅读 >>
Delphi mediaplayer android 下播放 mp4 的问题
Delphi关于dbgrid和webbrowser的焦点问题
Delphi 工程判断内存溢出reportmemoryleaksonshutdown := true;
更多相关阅读请进入《Delphi》频道 >>