谁能给我一个用Delphi写的拦截系统API函数（如MessageBox）的例子？300分重谢(0分)

谁能给我一个用Delphi写的拦截系统API函数（如MessageBox）的例子？
要求能在D5下编译通过，300分重谢。
请注意，要能拦截系统所有的对这个API函数的调用！换句话说，它要能拦截其他
的进程的API。
我的邮箱是8wm8@sohu.com

library PigLatinDll;

uses
Windows,
SysUtils,
Classes,
HookTextUnit in 'HookTextUnit.pas';

function PigLatinWord(s: String): String;
Var start: String; Capitalize, AllCapitals: Boolean; i: Integer; begin
Result:=s;
if length(s)<=1 then exit;
Capitalize:=IsCharUpper(s[1]);
AllCapitals:=True;
for i:=1 to length(s) do begin
if IsCharLower(s) then begin
AllCapitals:=False; break;
end;
end;
start:=lowercase(copy(s,1,2));
if (start[1]<'a') or (start[1]>'z') then exit;
if (start[1] in ['a','e','i','o','u']) then start:='';
if (start<>'ch') and (start<>'th') and (start<>'sh') and (start<>'wh')

and (start<>'qu') and (start<>'kn') and (start<>'wr') then delete(start,2,1);
Result:=copy(s,length(start)+1,length(s))+start;
if start='' then Result:=Result+'yay' else Result:=Result+'ay'; if AllCapitals then result:=Uppercase(Result) else
if Capitalize then result[1]:=Upcase(result[1]);
end;

function IntToRoman(n: Integer): String;
Var i, units, tens, hundreds, thousands: Integer;
begin
If (n>=5000) or (n<=0) then Result:=IntToStr else begin thousands:=n div 1000; n:=n mod 1000;
hundreds:=n div 100; n:=n mod 100;
tens:=n div 10; n:=n mod 10;
units:=n;
Result:='';
for i:=1 to Thousands do begin
Result:=Result+'M';
end;
Case Hundreds of
1: Result:=Result+'C';
2: Result:=Result+'CC';
3: Result:=Result+'CCC';
4: Result:=Result+'CD';
5: Result:=Result+'D';
6: Result:=Result+'DC';
7: Result:=Result+'DCC';
8: Result:=Result+'DCCC';
9: Result:=Result+'CM';
end;
Case Tens of
1: Result:=Result+'X';
2: Result:=Result+'XX';
3: Result:=Result+'XXX';
4: Result:=Result+'XL';
5: Result:=Result+'L';
6: Result:=Result+'LX';
7: Result:=Result+'LXX';
8: Result:=Result+'LXXX';
9: Result:=Result+'XC';
end;
Case Units of
1: Result:=Result+'I';
2: Result:=Result+'II';
3: Result:=Result+'III';
4: Result:=Result+'IV';
5: Result:=Result+'V';
6: Result:=Result+'VI';
7: Result:=Result+'VII';
8: Result:=Result+'VIII';
9: Result:=Result+'IX';
end;
end;
end;

function LatinNumber(s: String): String;
Var n: Integer;
begin
try
n:=StrToInt(s);
Result:=IntToRoman;
except
Result:=s;
end;
end;

function Conv(s: String): String;
Var i: Integer; w: String;
begin
Result:='';
try
if s='' then exit;
i:=1;
while (i<=length(s)) do begin
while (i<=length(s)) and (s<=' ') do begin
Result:=Result+s;
Inc(i);
end;

// convert any numbers into latin numbers
w:='';
while (i<=length(s)) and (s>='0') and (s<='9') do begin w:=w+s;
Inc(i);
end;
Result:=Result+LatinNumber(w);

// add any other symbols unchanged (for now)
w:='';
while (i<=length(s)) and not IsCharAlphaNumeric(s) do begin w:=w+s;
Inc(i);
end;
Result:=Result+w;

// convert whole words into pig latin
w:='';
while (i<=length(s)) and IsCharAlpha(s) do begin
w:=w+s;
Inc(i);
end;
Result:=Result+PigLatinWord(w);
end;
except
end;
end;

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
HookTextOut(Conv);
end.

====================================================

unit HookTextUnit;

interface
uses Windows, SysUtils, Classes, PEStuff;

type
TConvertTextFunction = function(text: String): String;
TTextOutA = function(hdc: HDC; x,y: Integer; text: PAnsiChar; len: Integer): BOOL; stdcall;
TTextOutW = function(hdc: HDC; x,y: Integer; text: PWideChar; len: Integer): BOOL; stdcall;
TExtTextOutA = function(hdc: HDC; x,y: Integer; Options: DWORD; Clip: PRect;
text: PAnsiChar; len: Integer; dx: PInteger): BOOL; stdcall;
TExtTextOutW = function(hdc: HDC; x,y: Integer; Options: DWORD; Clip: PRect;
text: PWideChar; len: Integer; dx: PInteger): BOOL; stdcall;
TDrawTextA = function(hdc: HDC; text: PAnsiChar; len: Integer; rect: PRect;
Format: DWORD): Integer; stdcall;
TDrawTextW = function(hdc: HDC; text: PWideChar; len: Integer; rect: PRect;
Format: DWORD): Integer; stdcall;
TDrawTextExA = function(hdc: HDC; text: PAnsiChar; len: Integer; rect: PRect;
Format: DWORD; DTParams: PDrawTextParams): Integer; stdcall;
TDrawTextExW = function(hdc: HDC; text: PWideChar; len: Integer; rect: PRect;
Format: DWORD; DTParams: PDrawTextParams): Integer; stdcall;

TTabbedTextOutA = function(hdc: HDC; x,y: Integer; text: PAnsiChar; len: Integer;
TabCount: Integer; TabPositions: PInteger; TabOrigin: Integer): Integer; stdcall;
TTabbedTextOutW = function(hdc: HDC; x,y: Integer; text: PWideChar; len: Integer;
TabCount: Integer; TabPositions: PInteger; TabOrigin: Integer): Integer; stdcall;
TPolyTextOutA = function(hdc: HDC; pptxt: PPOLYTEXTA; count: Integer): BOOL; stdcall;
TPolyTextOutW = function(hdc: HDC; pptxt: PPOLYTEXTW; count: Integer): BOOL; stdcall;

TGetTextExtentExPointA = function(hdc: HDC; text: PAnsiChar; len: Integer;
maxExtent: Integer; Fit: PInteger; Dx: PInteger; Size: Pointer): BOOL; stdcall;
TGetTextExtentExPointW = function(hdc: HDC; text: PWideChar; len: Integer;
maxExtent: Integer; Fit: PInteger; Dx: PInteger; Size: Pointer): BOOL; stdcall;
TGetTextExtentPoint32A = function(hdc: HDC; text: PAnsiChar; len: Integer; Size: Pointer): BOOL; stdcall;
TGetTextExtentPoint32W = function(hdc: HDC; text: PWideChar; len: Integer; Size: Pointer): BOOL; stdcall;
TGetTextExtentPointA = function(hdc: HDC; text: PAnsiChar; len: Integer; Size: Pointer): BOOL; stdcall;
TGetTextExtentPointW = function(hdc: HDC; text: PWideChar; len: Integer; Size: Pointer): BOOL; stdcall;

PPointer = ^Pointer;

TImportCode = packed record
JumpInstruction: Word; // should be $25FF
AddressOfPointerToFunction: PPointer;
end;
PImportCode = ^TImportCode;

procedure HookTextOut(ConvertFunction: TConvertTextFunction);
procedure UnhookTextOut;

implementation

Var
ConvertTextFunction: TConvertTextFunction = nil;
OldTextOutA: TTextOutA = nil;
OldTextOutW: TTextOutW = nil;
OldExtTextOutA: TExtTextOutA = nil;
OldExtTextOutW: TExtTextOutW = nil;
OldDrawTextA: TDrawTextA = nil;
OldDrawTextW: TDrawTextW = nil;
OldDrawTextExA: TDrawTextExA = nil;
OldDrawTextExW: TDrawTextExW = nil;
OldTabbedTextOutA: TTabbedTextOutA = nil;
OldTabbedTextOutW: TTabbedTextOutW = nil;
OldPolyTextOutA: TPolyTextOutA = nil;
OldPolyTextOutW: TPolyTextOutW = nil;
OldGetTextExtentExPointA: TGetTextExtentExPointA = nil;
OldGetTextExtentExPointW: TGetTextExtentExPointW = nil;
OldGetTextExtentPoint32A: TGetTextExtentPoint32A = nil;
OldGetTextExtentPoint32W: TGetTextExtentPoint32W = nil;
OldGetTextExtentPointA: TGetTextExtentPointA = nil;
OldGetTextExtentPointW: TGetTextExtentPointW = nil;

function StrLenW(s: PWideChar): Integer;
Var i: Integer;
begin
if s=nil then begin
Result:=0; exit;
end;
i:=0;
try
while (s<>#0) do inc(i);
except
end;
Result:=i;
end;

function NewTextOutA(hdc: HDC; x,y: Integer; text: PAnsiChar; len: Integer): BOOL; stdcall;
Var s: String;
begin
try
if Len<0 then Len:=strlen(text);
If Len>0 then begin
SetLength(s,len);
FillChar(s[1],len+1,0);
Move(text^,s[1],len);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldTextOutA<>nil then
Result:=OldTextOutA(hdc,x,y,PAnsiChar(s),length(s))
else
Result:=False;
end else Result:=OldTextOutA(hdc,x,y,PAnsiChar(s),0);
except
Result:=False;
end;
end;

function NewTextOutW(hdc: HDC; x,y: Integer; text: PWideChar; len: Integer): BOOL; stdcall;
Var s: WideString;
begin
try
if Len<0 then Len:=strlenW(text);
If Len>0 then begin
SetLength(s,len);
FillChar(s[1],len*2+2,0);
Move(text^,s[1],len*2);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldTextOutW<>nil then
Result:=OldTextOutW(hdc,x,y,PWideChar(s),length(s))
else
Result:=False;
end else Result:=OldTextOutW(hdc,x,y,PWideChar(s),0);
except
Result:=False;
end;
end;
function NewExtTextOutA(hdc: HDC; x,y: Integer; Options: DWORD; Clip: PRect;
text: PAnsiChar; len: Integer; dx: PInteger): BOOL; stdcall;
Var s: String;
begin
try
if Len<0 then Len:=strlen(text); // ???
if Len>0 then begin
SetLength(s,len);
FillChar(s[1],len+1,0);
Move(text^,s[1],len);
if @ConvertTextFunction<>nil then s:=ConvertTextFunction(s); if @OldExtTextOutA<>nil then

Result:=OldExtTextOutA(hdc,x,y,Options,Clip,PAnsiChar(s),length(s),dx) else Result:=False;
end else Result:=OldExtTextOutA(hdc,x,y,Options,Clip,text,0,dx); except
Result:=False;
end;
end;

function NewExtTextOutW(hdc: HDC; x,y: Integer; Options: DWORD; Clip: PRect;
text: PWideChar; len: Integer; dx: PInteger): BOOL; stdcall;
Var s: WideString;
begin
try
if Len<0 then Len:=strlenW(text);
If Len>0 then begin
SetLength(s,len);
FillChar(s[1],len*2+2,0);
Move(text^,s[1],len*2);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldExtTextOutW<>nil then

Result:=OldExtTextOutW(hdc,x,y,Options,Clip,PWideChar(s),length(s),dx) else Result:=False;
end else Result:=OldExtTextOutW(hdc,x,y,Options,Clip,text,0,dx); except
Result:=False;
end;
end;

function NewDrawTextA(hdc: HDC; text: PAnsiChar; len: Integer; rect: PRect;
Format: DWORD): Integer; stdcall;
Var s: String;
begin
try
if Len<0 then Len:=strlen(text); // ???
if Len>0 then begin
SetLength(s,len);
FillChar(s[1],len+1,0);
Move(text^,s[1],len);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldDrawTextA<>nil then
Result:=OldDrawTextA(hdc,PAnsiChar(s),length(s),rect,Format) else Result:=0;
end else Result:=OldDrawTextA(hdc,text,0,rect,Format);
except
Result:=0;
end;
end;

function NewDrawTextW(hdc: HDC; text: PWideChar; len: Integer; rect: PRect;
Format: DWORD): Integer; stdcall;
Var s: WideString;
begin
try
if Len<0 then Len:=strlenW(text);
if len>0 then begin
SetLength(s,len);
FillChar(s[1],len*2+2,0);
Move(text^,s[1],len*2);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldDrawTextW<>nil then
Result:=OldDrawTextW(hdc,PWideChar(s),length(s),rect,Format) else Result:=0;
end else Result:=OldDrawTextW(hdc,text,0,rect,Format);
except
Result:=0;
end;
end;

function NewDrawTextExA(hdc: HDC; text: PAnsiChar; len: Integer; rect: PRect;
Format: DWORD; DTParams: PDrawTextParams): Integer; stdcall;
Var s: String;
begin
try
if Len<0 then Len:=strlen(text);
if len>0 then begin
SetLength(s,len);
FillChar(s[1],len+1,0);
Move(text^,s[1],len);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldDrawTextExA<>nil then

Result:=OldDrawTextExA(hdc,PAnsiChar(s),length(s),rect,Format,DTParams) else Result:=0;
end else Result:=OldDrawTextExA(hdc,text,0,rect,Format,DTParams); except
Result:=0;
end;
end;

function NewDrawTextExW(hdc: HDC; text: PWideChar; len: Integer; rect: PRect;
Format: DWORD; DTParams: PDrawTextParams): Integer; stdcall;
Var s: WideString;
begin
try
if Len<0 then Len:=strlenW(text);
if Len>0 then begin
SetLength(s,len);
FillChar(s[1],len*2+2,0);
Move(text^,s[1],len*2);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldDrawTextExW<>nil then

Result:=OldDrawTextExW(hdc,PWideChar(s),length(s),rect,Format,DTParams) else Result:=0;
end else Result:=OldDrawTextExW(hdc,text,0,rect,Format,DTParams); except
Result:=0;
end;
end;

function NewTabbedTextOutA(hdc: HDC; x,y: Integer; text: PAnsiChar; len: Integer;
TabCount: Integer; TabPositions: PInteger; TabOrigin: Integer): Integer; stdcall;
Var s: AnsiString;
begin
try
if Len<0 then Len:=strlen(text);
if Len>0 then begin
SetLength(s,len);
FillChar(s[1],len+1,0);
Move(text^,s[1],len);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldTabbedTextOutA<>nil then

Result:=OldTabbedTextOutA(hdc,x,y,PAnsiChar(s),length(s),TabCount,TabPositions,TabOrigin)

else Result:=0;
end else
Result:=OldTabbedTextOutA(hdc,x,y,text,0,TabCount,TabPositions,TabOrigin);

except
Result:=0;
end;
end;

function NewTabbedTextOutW(hdc: HDC; x,y: Integer; text: PWideChar; len: Integer;
TabCount: Integer; TabPositions: PInteger; TabOrigin: Integer): Integer; stdcall;
Var s: WideString;
begin
try
if Len<0 then Len:=strlenW(text);
if Len>0 then begin
SetLength(s,len);
FillChar(s[1],len*2+2,0);
Move(text^,s[1],len*2);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldTabbedTextOutW<>nil then
Result:=OldTabbedTextOutW(hdc,x,y,PWideChar(s),length(s),TabCount,TabPositions,TabOrigin)

else Result:=0;
end else
Result:=OldTabbedTextOutW(hdc,x,y,text,0,TabCount,TabPositions,TabOrigin);

except
Result:=0;
end;
end;

function NewPolyTextOutA(hdc: HDC; pptxt: PPOLYTEXTA; count: Integer): BOOL; stdcall;
Var s: String; i: Integer; ppnew: PPOLYTEXTA;
begin
ppnew:=nil;
try
Result:=False;
if Count<0 then exit;
if Count=0 then begin Result:=True; exit; end;
GetMem(ppnew,count*sizeof(TPOLYTEXTA));
For i:=1 to count do begin
ppnew^:=pptxt^;
if ppnew^.n<0 then ppnew^.n:=strlen(ppnew^.PAnsiChar);
if ppnew^.n>0 then begin
SetLength(s,ppnew^.n);
FillChar(s[1],ppnew^.n+1,0);
Move(ppnew^.PAnsiChar,s[1],ppnew^.n);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
ppnew^.PAnsiChar:=PAnsiChar(s);
ppnew^.n:=length(s);
if @OldPolyTextOutA<>nil then
Result:=OldPolyTextOutA(hdc,ppnew,1);
end;
Inc(pptxt);
end;
except
Result:=False;
end;
if ppnew<>nil then FreeMem(ppnew);
end;

function NewPolyTextOutW(hdc: HDC; pptxt: PPOLYTEXTW; count: Integer): BOOL; stdcall;
begin
Result:=OldPolyTextOutW(hdc,pptxt,count);
end;

function NewGetTextExtentExPointA(hdc: HDC; text: PAnsiChar; len: Integer;
maxExtent: Integer; Fit: PInteger; Dx: PInteger; Size: Pointer): BOOL; stdcall;
Var s: AnsiString;
begin
try
if Len<0 then Len:=strlen(text);
if Len>0 then begin
SetLength(s,len);
FillChar(s[1],len+1,0);
Move(text^,s[1],len);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldGetTextExtentExPointA<>nil then

Result:=OldGetTextExtentExPointA(hdc,PAnsiChar(s),length(s),maxExtent,Fit,Dx,Size)

else Result:=False;
end else
Result:=OldGetTextExtentExPointA(hdc,text,0,maxExtent,Fit,Dx,Size); except
Result:=False;
end;
end;

Function NewGetTextExtentExPointW(hdc: HDC; text: PWideChar; len: Integer;
maxExtent: Integer; Fit: PInteger; Dx: PInteger; Size: Pointer): BOOL; stdcall;
Var s: WideString;
begin
try
if Len<0 then Len:=strlenW(text);
if Len>0 then begin
SetLength(s,len);
FillChar(s[1],len*2+2,0);
Move(text^,s[1],len);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldGetTextExtentExPointW<>nil then

Result:=OldGetTextExtentExPointW(hdc,PWideChar(s),length(s),maxExtent,Fit,Dx,Size)

else Result:=False;
end else
Result:=OldGetTextExtentExPointW(hdc,text,0,maxExtent,Fit,Dx,Size); except
Result:=False;
end;
end;

function NewGetTextExtentPoint32A(hdc: HDC; text: PAnsiChar; len: Integer; Size: Pointer): BOOL; stdcall;
Var s: AnsiString;
begin
try
if Len<0 then Len:=strlen(text);
if Len>0 then begin
SetLength(s,len);
FillChar(s[1],len+1,0);
Move(text^,s[1],len);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldGetTextExtentPoint32A<>nil then

Result:=OldGetTextExtentPoint32A(hdc,PAnsiChar(s),length(s),Size) else Result:=False;
end else Result:=OldGetTextExtentPoint32A(hdc,text,0,Size);
except
Result:=False;
end;
end;

function NewGetTextExtentPoint32W(hdc: HDC; text: PWideChar; len: Integer; Size: Pointer): BOOL; stdcall;
Var s: WideString;
begin
try
if Len<0 then Len:=strlenW(text);
if Len>0 then begin
SetLength(s,len);
FillChar(s[1],len*2+2,0);
Move(text^,s[1],len);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldGetTextExtentPoint32W<>nil then

Result:=OldGetTextExtentPoint32W(hdc,PWideChar(s),length(s),Size) else Result:=False;
end else Result:=OldGetTextExtentPoint32W(hdc,text,0,Size);
except
Result:=False;
end;
end;
function NewGetTextExtentPointA(hdc: HDC; text: PAnsiChar; len: Integer; Size: Pointer): BOOL; stdcall;
Var s: AnsiString;
begin
try
if Len<0 then Len:=strlen(text);
if Len>0 then begin
SetLength(s,len);
FillChar(s[1],len+1,0);
Move(text^,s[1],len);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldGetTextExtentPointA<>nil then
Result:=OldGetTextExtentPointA(hdc,PAnsiChar(s),length(s),Size) else Result:=False;
end else Result:=OldGetTextExtentPointA(hdc,text,0,Size);
except
Result:=False;
end;
end;


function NewGetTextExtentPointW(hdc: HDC; text: PWideChar; len: Integer; Size: Pointer): BOOL; stdcall;
Var s: WideString;
begin
try
if Len<0 then Len:=strlenW(text);
if Len>0 then begin
SetLength(s,len);
FillChar(s[1],len*2+2,0);
Move(text^,s[1],len);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldGetTextExtentPoint32W<>nil then
Result:=OldGetTextExtentPointW(hdc,PWideChar(s),length(s),Size) else Result:=False;
end else Result:=OldGetTextExtentPointW(hdc,text,0,Size);
except
Result:=False;
end;
end;

function PointerToFunctionAddress(Code: Pointer): PPointer;
Var func: PImportCode;
begin
Result:=nil;
if Code=nil then exit;
try
func:=code;
if (func.JumpInstruction=$25FF) then begin
Result:=func.AddressOfPointerToFunction;
end;
except
Result:=nil;
end;
end;

function FinalFunctionAddress(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 PatchAddress(OldFunc, NewFunc: Pointer): Integer;
Var BeenDone: TList;

Function PatchAddressInModule(hModule: THandle; OldFunc, NewFunc: Pointer): Integer;
Var Dos: PImageDosHeader; NT: PImageNTHeaders;
ImportDesc: PImage_Import_Entry; rva: DWORD;
Func: PPointer; DLL: String; f: Pointer; written: DWORD;
begin
Result:=0;
Dos:=Pointer(hModule);
if BeenDone.IndexOf(Dos)>=0 then exit;
BeenDone.Add(Dos);
OldFunc:=FinalFunctionAddress(OldFunc);
if IsBadReadPtr(Dos,SizeOf(TImageDosHeader)) then exit;
if Dos.e_magic<>IMAGE_DOS_SIGNATURE then exit;
NT :=Pointer(Integer(Dos) + dos._lfanew);
// if IsBadReadPtr(NT,SizeOf(TImageNtHeaders)) then exit;

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);
PatchAddressInModule(GetModuleHandle(PChar(DLL)),OldFunc,NewFunc); Func:=Pointer(Integer(DOS)+ImportDesc.LookupTable);
While Func^<>nil do begin
f:=FinalFunctionAddress(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
BeenDone:=TList.Create;
try
Result:=PatchAddressInModule(GetModuleHandle(nil),OldFunc,NewFunc); finally
BeenDone.Free;
end;
end;

procedure HookTextOut(ConvertFunction: TConvertTextFunction);
begin
if @OldTextOutA=nil then
@OldTextOutA:=FinalFunctionAddress(@TextOutA);
if @OldTextOutW=nil then
@OldTextOutW:=FinalFunctionAddress(@TextOutW);

if @OldExtTextOutA=nil then
@OldExtTextOutA:=FinalFunctionAddress(@ExtTextOutA);
if @OldExtTextOutW=nil then
@OldExtTextOutW:=FinalFunctionAddress(@ExtTextOutW);

if @OldDrawTextA=nil then
@OldDrawTextA:=FinalFunctionAddress(@DrawTextA);
if @OldDrawTextW=nil then
@OldDrawTextW:=FinalFunctionAddress(@DrawTextW);

if @OldDrawTextExA=nil then
@OldDrawTextExA:=FinalFunctionAddress(@DrawTextExA);
if @OldDrawTextExW=nil then
@OldDrawTextExW:=FinalFunctionAddress(@DrawTextExW);

if @OldTabbedTextOutA=nil then
@OldTabbedTextOutA:=FinalFunctionAddress(@TabbedTextOutA);
if @OldTabbedTextOutW=nil then
@OldTabbedTextOutW:=FinalFunctionAddress(@TabbedTextOutW);

if @OldPolyTextOutA=nil then
@OldPolyTextOutA:=FinalFunctionAddress(@PolyTextOutA);
if @OldPolyTextOutW=nil then
@OldPolyTextOutW:=FinalFunctionAddress(@PolyTextOutW);

if @OldGetTextExtentExPointA=nil then

@OldGetTextExtentExPointA:=FinalFunctionAddress(@GetTextExtentExPointA);

if @OldGetTextExtentExPointW=nil then

@OldGetTextExtentExPointW:=FinalFunctionAddress(@GetTextExtentExPointW);

if @OldGetTextExtentPoint32A=nil then

@OldGetTextExtentPoint32A:=FinalFunctionAddress(@GetTextExtentPoint32A);

if @OldGetTextExtentPoint32W=nil then

@OldGetTextExtentPoint32W:=FinalFunctionAddress(@GetTextExtentPoint32W);


if @OldGetTextExtentPointA=nil then
@OldGetTextExtentPointA:=FinalFunctionAddress(@GetTextExtentPointA);

if @OldGetTextExtentPointW=nil then
@OldGetTextExtentPointW:=FinalFunctionAddress(@GetTextExtentPointW);



@ConvertTextFunction:=@ConvertFunction;

PatchAddress(@OldTextOutA, @NewTextOutA);
PatchAddress(@OldTextOutW, @NewTextOutW);
PatchAddress(@OldExtTextOutA, @NewExtTextOutA);
PatchAddress(@OldExtTextOutW, @NewExtTextOutW);
PatchAddress(@OldDrawTextA, @NewDrawTextA);
PatchAddress(@OldDrawTextW, @NewDrawTextW);
PatchAddress(@OldDrawTextExA, @NewDrawTextExA);
PatchAddress(@OldDrawTextExW, @NewDrawTextExW);
PatchAddress(@OldTabbedTextOutA, @NewTabbedTextOutA);
PatchAddress(@OldTabbedTextOutW, @NewTabbedTextOutW);
PatchAddress(@OldPolyTextOutA, @NewPolyTextOutA);
PatchAddress(@OldPolyTextOutW, @NewPolyTextOutW);
PatchAddress(@OldGetTextExtentExPointA, @NewGetTextExtentExPointA); PatchAddress(@OldGetTextExtentExPointW, @NewGetTextExtentExPointW); PatchAddress(@OldGetTextExtentPoint32A, @NewGetTextExtentPoint32A); PatchAddress(@OldGetTextExtentPoint32W, @NewGetTextExtentPoint32W); PatchAddress(@OldGetTextExtentPointA, @NewGetTextExtentPointA); PatchAddress(@OldGetTextExtentPointW, @NewGetTextExtentPointW); end;

procedure UnhookTextOut;
begin
If @OldTextOutA<>nil then begin
PatchAddress(@NewTextOutA, @OldTextOutA);
PatchAddress(@NewTextOutW, @OldTextOutW);
PatchAddress(@NewExtTextOutA, @OldExtTextOutA);
PatchAddress(@NewExtTextOutW, @OldExtTextOutW);
PatchAddress(@NewDrawTextA, @OldDrawTextA);
PatchAddress(@NewDrawTextW, @OldDrawTextW);
PatchAddress(@NewDrawTextExA, @OldDrawTextExA);
PatchAddress(@NewDrawTextExW, @OldDrawTextExW);
PatchAddress(@NewTabbedTextOutA, @OldTabbedTextOutA);
PatchAddress(@NewTabbedTextOutW, @OldTabbedTextOutW);
PatchAddress(@NewPolyTextOutA, @OldPolyTextOutA);
PatchAddress(@NewPolyTextOutW, @OldPolyTextOutW);
PatchAddress(@NewGetTextExtentExPointA, @OldGetTextExtentExPointA); PatchAddress(@NewGetTextExtentExPointW, @OldGetTextExtentExPointW); PatchAddress(@NewGetTextExtentPoint32A, @OldGetTextExtentPoint32A); PatchAddress(@NewGetTextExtentPoint32W, @OldGetTextExtentPoint32W); PatchAddress(@NewGetTextExtentPointA, @OldGetTextExtentPointA); PatchAddress(@NewGetTextExtentPointW, @OldGetTextExtentPointW); end;
end;

initialization
finalization
UnhookTextOut;
end.

===================================================
unit PEStuff;

interface
uses Windows;

type
PImageDosHeader = ^TImageDosHeader;
_IMAGE_DOS_HEADER = packed record { DOS .EXE
header }
e_magic: Word; { Magic
number }
e_cblp: Word; { Bytes on last page of file }
e_cp: Word; { Pages in
file }
e_crlc: Word; {
Relocations }
e_cparhdr: Word; { Size of header in
paragraphs }
e_minalloc: Word; { Minimum extra paragraphs needed }
e_maxalloc: Word; { Maximum extra paragraphs needed }
e_ss: Word; { Initial (relative) SS value }
e_sp: Word; { Initial SP
value }
e_csum: Word; {
Checksum }
e_ip: Word; { Initial IP
value }
e_cs: Word; { Initial (relative) CS value }
e_lfarlc: Word; { File address of relocation table }
e_ovno: Word; { Overlay
number }
e_res: array [0..3] of Word; { Reserved
words }
e_oemid: Word; { OEM identifier (for
e_oeminfo) }
e_oeminfo: Word; { OEM information; e_oemid specific}
e_res2: array [0..9] of Word; { Reserved
words }
_lfanew: LongInt; { File address of new exe header }
end;
TImageDosHeader = _IMAGE_DOS_HEADER;

PIMAGE_FILE_HEADER = ^IMAGE_FILE_HEADER;
IMAGE_FILE_HEADER = packed record
Machine : WORD;
NumberOfSections : WORD;
TimeDateStamp : DWORD;
PointerToSymbolTable : DWORD;
NumberOfSymbols : DWORD;
SizeOfOptionalHeader : WORD;
Characteristics : WORD;
end;

PIMAGE_DATA_DIRECTORY = ^IMAGE_DATA_DIRECTORY;
IMAGE_DATA_DIRECTORY = packed record
VirtualAddress : DWORD;
Size : DWORD;
end;

PIMAGE_SECTION_HEADER = ^IMAGE_SECTION_HEADER;
IMAGE_SECTION_HEADER = packed record
Name : packed array [0..IMAGE_SIZEOF_SHORT_NAME-1] of Char;
VirtualSize : DWORD; // or VirtualSize (union);
VirtualAddress : DWORD;
SizeOfRawData : DWORD;
PointerToRawData : DWORD;
PointerToRelocations : DWORD;
PointerToLinenumbers : DWORD;
NumberOfRelocations : WORD;
NumberOfLinenumbers : WORD;
Characteristics : DWORD;
end;

PIMAGE_OPTIONAL_HEADER = ^IMAGE_OPTIONAL_HEADER;
IMAGE_OPTIONAL_HEADER = packed record
{ Standard fields. }
Magic : WORD;
MajorLinkerVersion : Byte;
MinorLinkerVersion : Byte;
SizeOfCode : DWORD;
SizeOfInitializedData : DWORD;
SizeOfUninitializedData : DWORD;
AddressOfEntryPoint : DWORD;
BaseOfCode : DWORD;
BaseOfData : DWORD;
{ NT additional fields. }
ImageBase : DWORD;
SectionAlignment : DWORD;
FileAlignment : DWORD;
MajorOperatingSystemVersion : WORD;
MinorOperatingSystemVersion : WORD;
MajorImageVersion : WORD;
MinorImageVersion : WORD;
MajorSubsystemVersion : WORD;
MinorSubsystemVersion : WORD;
Reserved1 : DWORD;
SizeOfImage : DWORD;
SizeOfHeaders : DWORD;
CheckSum : DWORD;
Subsystem : WORD;
DllCharacteristics : WORD;
SizeOfStackReserve : DWORD;
SizeOfStackCommit : DWORD;
SizeOfHeapReserve : DWORD;
SizeOfHeapCommit : DWORD;
LoaderFlags : DWORD;
NumberOfRvaAndSizes : DWORD;
DataDirectory : packed array
[0..IMAGE_NUMBEROF_DIRECTORY_ENTRIES-1] of IMAGE_DATA_DIRECTORY; Sections: packed array [0..9999] of IMAGE_SECTION_HEADER;
end;

PIMAGE_NT_HEADERS = ^IMAGE_NT_HEADERS;
IMAGE_NT_HEADERS = packed record
Signature : DWORD;
FileHeader : IMAGE_FILE_HEADER;
OptionalHeader : IMAGE_OPTIONAL_HEADER;
end;
PImageNtHeaders = PIMAGE_NT_HEADERS;
TImageNtHeaders = IMAGE_NT_HEADERS;

{ PIMAGE_IMPORT_DESCRIPTOR = ^IMAGE_IMPORT_DESCRIPTOR;
IMAGE_IMPORT_DESCRIPTOR = packed record
Characteristics: DWORD; // or original first thunk // 0 for
terminating null import descriptor // RVA to original unbound IAT TimeDateStamp: DWORD; // 0 if not bound,
// -1 if bound, and real date/time stamp // in IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT (new BIND)
// O.W. date/time stamp of DLL bound to (Old BIND)
Name: DWORD;
FirstThunk: DWORD; // PIMAGE_THUNK_DATA // RVA to IAT (if bound this IAT has actual addresses)
ForwarderChain: DWORD; // -1 if no forwarders
end;
TImageImportDescriptor = IMAGE_IMPORT_DESCRIPTOR;
PImageImportDescriptor = PIMAGE_IMPORT_DESCRIPTOR;}

PIMAGE_IMPORT_BY_NAME = ^IMAGE_IMPORT_BY_NAME;
IMAGE_IMPORT_BY_NAME = record
Hint: Word;
Name: Array[0..0] of Char;
end;

PIMAGE_THUNK_DATA = ^IMAGE_THUNK_DATA;
IMAGE_THUNK_DATA = record
Whatever: DWORD;
end;

PImage_Import_Entry = ^Image_Import_Entry;
Image_Import_Entry = record
Characteristics: DWORD;
TimeDateStamp: DWORD;
MajorVersion: Word;
MinorVersion: Word;
Name: DWORD;
LookupTable: DWORD;
end;


const
IMAGE_DOS_SIGNATURE = $5A4D; // MZ
IMAGE_OS2_SIGNATURE = $454E; // NE
IMAGE_OS2_SIGNATURE_LE = $454C; // LE
IMAGE_VXD_SIGNATURE = $454C; // LE
IMAGE_NT_SIGNATURE = $00004550; // PE00

implementation

end.

=================================================
Create a new project with one form, with two buttons.
=================================================


unit PigLatinUnit;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
procedure StartHook; stdcall; external 'PigLatinDll.DLL';
procedure StopHook; stdcall; external 'PigLatinDll.DLL';

procedure TForm1.Button1Click(Sender: TObject);
begin
WindowState:=wsMaximized;
StartHook;
Sleep(1000);
WindowState:=wsNormal;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
WindowState:=wsMaximized;
StopHook;
Sleep(1000);
WindowState:=wsNormal;
end;

initialization
finalization
StopHook;
end.

眼花@.@

楼上的动作好快呀。

给你介绍一个控件包：
http://umn.dl.sourceforge.net/sourceforge/jcl/JCL1_21.zip

其中有很好用的API HOOK的类与例子。很经典的。

还有谁能提供资料？
我要结束帖子了。

请到这里拿分。
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1265291

请到这里拿分。
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1265291

做個標記

APIHook一直是使大家感兴趣的话题。屏幕取词，
内码转化，屏幕翻译，中文平台等等都涉及到了此
项技术。有很多文章涉及到了这项技术，但都闪烁
其词不肯明明白白的公布。我仅在这里公布以下我
用Delphi制作APIHook的一些心得。
通常的APIHOOK有这样几种方法：
1、自己写一个动态链接库，里面定义自己
写的想取代系统的API。把这个动态链接库
映射到2G以上的系统动态链接库所在空间，
把系统动态链接库中的该API的指向修改指向自
己的函数。这种方法的好处就是可以取代系统
中运行全部程序的该API。但他有个局限，就是
只适用于Win9x。（原因是NT中动态链接库不是
共享的，每个进程都有自己的一份动态链接库在
内存中的映射）
2、自己写一个动态链接库，里面定义自己
写得象替代系统的API。把这个动态链接库映射
到进程的空间里。将该进程对API的调用指向自
己写的动态链接库。这种方法的好处是可以选择
性的替代哪个进程的API。而且适用于所有的
Windows*作系统。
这里我选用的是第二种方法。
第二种方法需要先了解一点PE文件格式的知识。
首先是一个实模式的的DOS文件头，是为了保持
和DOS的兼容。
接着是一个DOS的代理模块。你在纯DOS先运行
Win32的可执行文件，看看是不是也执行了，只
是显示的的是一行信息大意是说该Windows程序
不能在DOS实模式下运行。
然后才是真正意义上的Windows可执行文件的文
件头。它的具体位置不是每次都固定的。是由文
件偏移$3C决定的。我们要用到的就是它。
如果我们在程序中调用了一个MessageBoxA函数
那么它的实现过程是这样的。他先调用在本进程
中的MessageBoxA函数然后才跳到动态链接库的
MessageBoxA的入口点。即：
call messageBoxA(0040106c)
jmp dword ptr [_jmp_MessageBoxA@16(00425294)]
其中00425294的内容存储的就是就是MessageBoxA函数的入
口地址。如果我们做一下手脚，那么......那就开始吧！

我们需要定义两个结构
type
PImage_Import_Entry = ^Image_Import_Entry;
Image_Import_Entry = record
Characteristics: DWORD;
TimeDateStamp: DWORD;
MajorVersion: Word;
MinorVersion: Word;
Name: DWORD;
LookupTable: DWORD;
end;
type
TImportCode = packed record
JumpInstruction: Word; file: //定义跳转指令jmp
AddressOfPointerToFunction: ^Pointer; file: //定义要跳转到的函数
end;
PImportCode = ^TImportCode;
然后是确定函数的地址。
function LocateFunctionAddress(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;
参数Code是函数在进程中的指针，即那条Jmp XXX的指令。$25FF就是跳转指令的机器码。 再下一篇我会讲如何替换下那个XXX的内容，让他跳到你想去的地方。

在这里我将要实现转跳。有人说修改内存内容要进入Ring 0 才可以。可是Windows本身提供了一个写内存的指令WriteProcessMemory。有了这把利器，我们几乎无所不能。如游戏的修改等在这里我们只谈APIHOOK。
function RepointFunction(OldFunc, NewFunc: Pointer): Integer;
var
IsDone: TList;
function RepointAddrInModule(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 := LocateFunctionAddress(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);
RepointAddrInModule(GetModuleHandle(PChar(DLL)), OldFunc, NewFunc);
Func := Pointer(Integer(DOS) + ImportDesc.LookupTable);
while Func^ <> nil do
begin
f := LocateFunctionAddress(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 := RepointAddrInModule(GetModuleHandle(nil), OldFunc, NewFunc);
finally
IsDone.Free;
end;
end;
有了这两个函数我们几乎可以更改任何API函数。
我们可以先写一个DLL文件。我这里以修改Text相关函数为例：
先定义几个函数：
type
TTextOutA = function(DC: HDC; X, Y: Integer; Str: PAnsiChar; Count: Integer): BOOL; stdcall;
TTextOutW = function(DC: HDC; X, Y: Integer; Str: PWideChar; Count: Integer): BOOL; stdcall;
TTextOut = function(DC: HDC; X, Y: Integer; Str: PChar; Count: Integer): BOOL; stdcall;
TDrawTextA = function(hDC: HDC; lpString: PAnsiChar; nCount: Integer; var lpRect: TRect;
uFormat: UINT): Integer; stdcall;
TDrawTextW = function(hDC: HDC; lpString: PWideChar; nCount: Integer; var lpRect: TRect;
uFormat: UINT): Integer; stdcall;
TDrawText = function(hDC: HDC; lpString: PChar; nCount: Integer; var lpRect: TRect; uFormat:
UINT): Integer; stdcall;
var
OldTextOutA: TTextOutA;
OldTextOutW: TTextOutW;
OldTextOut: TTextOut;
OldDrawTextA: TDrawTextA;
OldDrawTextW: TDrawTextW;
OldDrawText: TDrawText;
......
function MyTextOutA(DC: HDC; X, Y: Integer; Str: PAnsiChar; Count: Integer): BOOL; stdcall;
begin
OldTextOutA(DC, X, Y, 'ABC', length('ABC'));
end;

function MyTextOutW(DC: HDC; X, Y: Integer; Str: PWideChar; Count: Integer): BOOL; stdcall;
begin
OldTextOutW(DC, X, Y, 'ABC', length('ABC'));
end;

function MyTextOut(DC: HDC; X, Y: Integer; Str: PChar; Count: Integer): BOOL; stdcall;
begin
OldTextOut(DC, X, Y, 'ABC', length('ABC'));
end;

function MyDrawTextA(hDC: HDC; lpString: PAnsiChar; nCount: Integer; var lpRect: TRect; uFormat:
UINT): Integer; stdcall;
begin
OldDrawTextA(hDC, 'ABC', length('ABC'), lpRect, uFormat);
end;

function MyDrawTextW(hDC: HDC; lpString: PWideChar; nCount: Integer; var lpRect: TRect; uFormat:
UINT): Integer; stdcall;
begin
OldDrawTextW(hDC, 'ABC', length('ABC'), lpRect, uFormat);
end;

function MyDrawText(hDC: HDC; lpString: PChar; nCount: Integer; var lpRect: TRect; uFormat:
UINT): Integer; stdcall;
begin
OldDrawText(hDC, 'ABC', length('ABC'), lpRect, uFormat);
end;

调用时我们要把原来的函数地址保存下来：
if @OldTextOutA = nil then
@OldTextOutA := LocateFunctionAddress(@TextOutA);
if @OldTextOutW = nil then
@OldTextOutW := LocateFunctionAddress(@TextOutW);
if @OldTextOut = nil then
@OldTextOut := LocateFunctionAddress(@TextOut);
if @OldDrawTextA = nil then
@OldDrawTextA := LocateFunctionAddress(@DrawTextA);
if @OldDrawTextW = nil then
@OldDrawTextW := LocateFunctionAddress(@DrawTextW);
if @OldDrawText = nil then
@OldDrawText := LocateFunctionAddress(@DrawText);
然后很顺其自然的用自己的函数替换掉原来的函数
RepointFunction(@OldTextOutA, @MyTextOutA);
RepointFunction(@OldTextOutW, @MyTextOutW);
RepointFunction(@OldTextOut, @MyTextOut);
RepointFunction(@OldDrawTextA, @MyDrawTextA);
RepointFunction(@OldDrawTextW, @MyDrawTextW);
RepointFunction(@OldDrawText, @MyDrawText);
在结束时不要忘记恢复原来函数的入口，要不然你会死得很难看哟！好了我们在写一个Demo程序。你会说怎么文字没有变成ABC呀？是呀，你要刷新一下才行。最小化然后在最大化。看看变了没有。
要不然你就写代码刷新一下好了。至于去拦截其他进程的API那就用SetWindowsHookEx写一个其他的钩子将DLL映射进去就行了，我就不再浪费口水了。
掌握了该方法你几乎无所不能。你可以修改其它程序。你可以拦截Createwindow等窗口函数改变其他程序的窗口形状、你还可以入侵其它的程序，你还可以......嘿嘿。干了坏事别招出我来就行了。


function Ticker : DWord; register;
begin
asm
push EAX
push EDX
db $0f,$31
mov Result, EAX
pop EDX
pop EAX
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
showmessage(inttostr( Ticker));
end;

这是不是能多得点分呢？这里面的技术和JCL中用的是一样的，但看过这个之后，
是不是对API HOOK有一个更全面的认识？呵呵！其实很简单。

接受答案了.

嗬嗬，利用上面的方法无法截获winsock调用，我曾出2000分也未有人能够解决！