实现拦截API的钩子(Hook)

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.