API HOOK

贴子见：

http://www.csdn.net/expert/topic/39/39641.shtm

http://www.csdn.net/expert/topic/50/50840.shtm

http://x57.deja.com/threadmsg_ct.xp?AN=696933069&CONTEXT=976054538.742850612

Yes. I already posted the answer before you

asked the question, under "Answer: Hook TextOut and other API" But here it is again, for delphi 3 under windows 95

(and I've heard it works in Delphi 5 under windows 2000)

As for books about internal windows stuff, the two authors you are after are Matt Pietrek, and Jeffrey Richter. I think Jeffrey Richter's book you are after is now called something like Developing Applications for Windows,

but it used to have a different name "Advanced Windows". Actually I haven't read either of their latest books. This is all my own work and not really based on anything of theirs.

From:

Carl Kenner <carl_kenner@hotmail.com>

Tue 3:01

Subject:

Answer: Hook TextOut and other API

I finally worked out how to hook all windows functions

and replace them with my own. To demonstrate I made

a delphi program that will hook into all the TextOut

functions in all of your programs, so that all the text

displayed on the screen is in Pig Latin.

This program has only been tested on WINDOWS 95

Let me know if it works on 98 or Me or NT or 2000

Enjoy!

Carl Kenner

PS. It took me a whole year of research to work this

out, so if you give me some credit I will be happy.

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

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[i]) then begin

AllCapitals:=False; break;

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(n) 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;

function LatinNumber(s: String): String;

Var n: Integer;

begin

try

n:=StrToInt(s);

Result:=IntToRoman(n);

except

Result:=s;

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[i]<=' ') do begin

Result:=Result+s[i];

Inc(i);

end;

// convert any numbers into latin numbers

w:='';

while (i<=length(s)) and (s[i]>='0') and (s[i]<='9') do begin w:=w+s[i];

Inc(i);

end;

Result:=Result+LatinNumber(w);

// add any other symbols unchanged (for now)

w:='';

while (i<=length(s)) and not IsCharAlphaNumeric(s[i]) do begin w:=w+s[i];

Inc(i);

end;

Result:=Result+w;

// convert whole words into pig latin

w:='';

while (i<=length(s)) and IsCharAlpha(s[i]) do begin

w:=w+s[i];

Inc(i);

end;

Result:=Result+PigLatinWord(w);

end;

except

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[i]<>#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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

begin

BeenDone:=TList.Create;

try

Result:=PatchAddressInModule(GetModuleHandle(nil),OldFunc,NewFunc); finally

BeenDone.Free;

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.