Answer: Hook TextOut and other API

[Carl Kenner]

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;
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;
end;
end;

function LatinNumber(s: String): String;
Var n: Integer;
begin
try
n:=StrToInt(s);
Result:=IntToRoman(n);
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[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;
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;
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.

[Rob Schoenaker]

Hmm... Looks impressive. I will see if it works on Win2k and let you know.

/Rob

[Rob Schoenaker]

The result with Delphi 5 and Win 2k has to be fine tuned. It looks very
promising though! I will see if I can make a funny twist to this and update
you on it.

Cheers,

/Rob

[Carl Kenner]

Thankyou. :-)

Well, it doesn't work perfectly on Win 95 either.
(compiled in Delphi 3)
It only hooks about 50% of the text output.
Any standard windows controls, such as buttons,
dialog boxes, icons, non owner-drawn menus, etc
are all not changed. I don't know why or how to
fix it. Theoretically the program should hook every
exe and dll file in the system.
Also, grayed text isn't hooked yet, but that can
be fixed. And GetTabbedTextExtent doesn't work.
And all Unicode is lost by the conversion to ascii.
I probably should change the Convert function so
that it uses wide strings instead of ansi ones.

Also, because I didn't want to make the example
too complicated, I didn't use any file maps,
and without file maps, it is impossible to call the
next hook in the chain. So all previous message
hooks are not called.

However, the following programs work almost
perfectly...
Netscape
Microsoft Word
ICQ
Help
The clock in the bottom right hand corner
Delphi 3 itself

Actually I developed this concept so that I could make
programs like those asian language viewers, and some
other practical applications. But I thought I should share
a humorous example with the world :-)

[Rob Schoenaker]

Do not analyze the following code before trying it, please.

Change the Conv function to:

function Conv(s: String): string;
var
I : Integer;
begin
Result := '';
I := Length(S);
repeat
Result := Result + S[I];
Dec(I);
until
I = 0;
end;

And have GREAT fun!

/Rob