要看讨论请搜索:怎么拦截系统函数?(超高度难题!)
具体例子请看:
http://x57.deja.com/threadmsg_ct.xp?AN=696933069&CONTEXT=976054538.742850612Yes. 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 <[email protected]>
 
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;
  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.