转贴——DELPHI中API HOOK

caterpilla

1、自定义一个记录
------------------------------------------------

TImportCode = packed record
JumpInstruction : Word; // 应该是$25FF，JUMP指令
AddressOfPointerToFunction: PPointer;// 真正的开始地址
end;
PImportCode = ^TImportCode;

------------------------------------------------

2、用下面的函数返回函数的真正地址
------------------------------------------------
function TrueFunctionAddress(func: Pointer): Pointer;
var
Code: PImportCode;
begin
Result:= func;
if func = nil then exit;
try
Code := func;
if (Code.JumpInstruction = $25FF) then begin
Result := Code.AddressOfPointerToFunction^;
end;
except
Result := nil;
end;
end;

------------------------------------------------

3、替换函数：
Procedure PermuteFunction(OldFunc:PPOinter; NewFunc:Pointer);
var
written: DWORD;
begin
WriteProcessMemory(GetCurrentProcess, OldFunc, @NewFunc, 4, written);
end;

------------------------------------------------

4、第一个程序
------------------------------------------------
unit mess;

interface
uses
Windows, Messages, SysUtils, Classes, APIHook;

procedure API_Hookup;
procedure Un_API_Hook;

var
FuncMessageboxA, FuncMessageboxW: PImportCode;

implementation

type
TMessageA = function(hwn: hwnd; lptext: pchar; lpcapion: pchar; utype: cardinal): integer; stdcall;
TMessageW = function(hwn: hwnd; lptext: pwidechar; lpcapion: pwidechar; utype: cardinal): integer; stdcall;

var
OldMessageBoxA: TMessageA;
OldMessageBoxW: TMessageW;


function MyBoxA(hwn:hwnd;lptext:pchar;lpcapion:pchar;utype:cardinal): integer; stdcall;
begin
result := OldMessageBoxA(hwn, 'Succes Hook A !', lpcapion, utype);
end;

function MyBoxw(hwn:hwnd;lptext:pwidechar;lpcapion:pwidechar;utype:cardinal): integer; stdcall;
begin
result := OldMessageBoxW(hwn, '成功挂上W!', lpcapion, utype);
end;

procedure API_Hookup;
begin
if @OldMessageBoxA = nil then
@OldMessageBoxA := TrueFunctionAddress(@messageboxA);
if @OldMessageBoxW = nil then
@OldMessageBoxW := TrueFunctionAddress(@messageboxW);

PermuteFunction(FuncMessageboxA.AddressOfPointerToFunction, @MyBoxA);
PermuteFunction(FuncMessageboxW.AddressOfPointerToFunction, @MyBoxW);
end;

procedure Un_API_hook;
begin
If @OldMessageBoxA <> nil then begin
PermuteFunction(FuncMessageboxA.AddressOfPointerToFunction, @OldMessageboxA);
PermuteFunction(FuncMessageboxW.AddressOfPointerToFunction, @OldMessageboxW);
end;
end;

initialization
FuncMessageboxA := @MessageboxA;
FuncMessageboxW := @MessageboxW;
end.

------------------------------------------------

5、在主窗体上添加三个按钮，添加Onclick代码,如下：
------------------------------------------------
procedure TForm1.Button1Click( Sender : TObject);
begin
API_HookUp;
end;

procedure TForm1.Button3Click( Sender : TObject);
begin
Un_API_Hook;
end;

procedure TForm1.Button2Click( Sender : TObject);
begin
MessageBoxA(Form1.Handle,'NO HOOK UP A','MessageBoxA',MB_OK);
MessageBoxW(Form1.Handle,'NO HOOK UP W','MessageBoxW',MB_OK);
end;

------------------------------------------------

6、如果现在新建一个Application TestTry，在Form上添加一个按钮，
其Onclick事件如下：
------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
begin
MessageBoxA(Form1.Handle,'NO HOOK UP A','MessageBoxA',MB_OK);
MessageBoxW(Form1.Handle,'NO HOOK UP W','MessageBoxW',MB_OK);
MessageBox (Form1.Handle,'NO HOOK UP BOX','MessageBox',MB_OK);
end;

___________________________________________________________


7、第二个程序
___________________________________________________________

uses
Windows,
SysUtils,
Classes,
APIHook in 'APIHook.pas',
mess in 'mess.pas';

{$R *.RES}

function GetMsgProc(code: integer; removal: integer; msg: Pointer): Integer; stdcall;
begin
Result := 0;
end;

Var HookHandle: THandle;

procedure StartHook; stdcall;
begin
HookHandle := SetWindowsHookEx(WH_GETMESSAGE, @GetMsgProc, HInstance, 0);
end;

procedure StopHook; stdcall;
begin
UnhookWindowsHookEx( HookHandle );
end;

exports StartHook, StopHook;

begin
API_Hookup; //加载时挂上
end.

-----------------------------------------------------------


为了卸载时能解除钩子，在Unit MESS单元最后加上一句：
-----------------------------------------------------------
finalization
Un_API_hook;

-----------------------------------------------------------

当然，别忘了对MESS做相应修改。编译好后别忘了存盘。新建Application TRY2程序，主Form的单元名称不妨叫TRYUnit2，在Form1上添加三个Button，并声明:
-----------------------------------------------------------
procedure StartHook; stdcall; external 'TRYDLL.DLL';
procedure StopHook; stdcall; external 'TRYDLL.DLL';

-----------------------------------------------------------


三个Button的OnClick代码如下：
-----------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
begin
StartHook;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
MessageBoxA(Form1.Handle,'NO HOOK UP A','MessageBoxA',MB_OK);
MessageBoxW(Form1.Handle,'NO HOOK UP W','MessageBoxW',MB_OK);
MessageBox (Form1.Handle,'NO HOOK UP BOX','MessageBox',MB_OK);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
StopHook;
end;


(* ------------------------------------------- *)
(* PermuteFunction功能 ：用 NewFunc替代 OldFunc *)
(* Windows Me + Delphi 5.0 *)
(* ------------------------------------------ *)
unit APIHook;
interface
uses
Windows, Classes ;
type
PImage_Import_Entry = ^Image_Import_Entry;
Image_Import_Entry = record
Characteristics : DWORD;
TimeDateStamp : DWORD;
MajorVersion : Word;
MinorVersion : Word;
Name : DWORD;
LookupTable : DWORD;
end;

Function TrueFunctionAddress(Code: Pointer): Pointer;
Function PermuteFunction(OldFunc, NewFunc: Pointer): Integer;
implementation
type
TImportCode = packed record
JumpInstruction: Word;
AddressOfPointerToFunction: ^Pointer;
end;
PImportCode = ^TImportCode;
function TrueFunctionAddress(Code: Pointer): Pointer;
var func: PImportCode;
begin
Result := Code;
if Code = nil then exit;
try
func := code;
if (func.JumpInstruction=$25FF) then begin
Result := func.AddressOfPointerToFunction^;
end;
except
Result := nil;
end;
end;

Function PermuteFunction(OldFunc, NewFunc: Pointer): Integer;
var IsDone: TList;
Function PermuteAddrInModule(hModule: THandle; OldFunc, NewFunc: Pointer): Integer;
var
Dos : PImageDosHeader;
NT : PImageNTHeaders;
ImportDesc : PImage_Import_Entry;
RVA : DWORD;
Func : ^Pointer;
DLL : String;
f : Pointer;
written : DWORD;
begin
Result := 0;
Dos := Pointer(hModule);
if IsDone.IndexOf(Dos) >= 0 then exit;
IsDone.Add(Dos);
OldFunc := TrueFunctionAddress(OldFunc);
if IsBadReadPtr(Dos,SizeOf(TImageDosHeader)) then exit;
if Dos.e_magic <> IMAGE_DOS_SIGNATURE then exit;
NT := Pointer(Integer(Dos) + dos._lfanew);
RVA := NT^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress;

if RVA = 0 then exit;
ImportDesc := pointer(integer(Dos)+RVA);
While(ImportDesc^.Name<>0) do
begin
DLL := PChar(Integer(Dos) + ImportDesc^.Name);
PermuteAddrInModule(GetModuleHandle(PChar(DLL)),OldFunc,NewFunc);
Func := Pointer(Integer(DOS) + ImportDesc.LookupTable);
While Func^ <> nil do
begin
f := TrueFunctionAddress(Func^);
if f = OldFunc then
begin
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
Result := PermuteAddrInModule(GetModuleHandle(nil),OldFunc,NewFunc);
finally
IsDone.Free;
end;
end;
end.

[[i] 本帖最后由 caterpilla 于 2006-6-20 09:26 编辑 [/i]]

黑夜彩虹

caterpilla ，把DEMO放上来看看~~~ :handshake

caterpilla

原帖由 黑夜彩虹 于 2006-6-20 09:36 发表
caterpilla ，把DEMO放上来看看~~~ :handshake

转贴而来，非我所做。。。。。。。。。。。
学习中。。。。。。。。。。。。。