攻破“金山词霸”的技术堡垒!

类别:Delphi 点击:0 评论:0 推荐:

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;

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

initialization
finalization
  UnhookTextOut;
end.

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

interface
uses Windows;

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

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

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

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

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

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

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

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

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

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


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

implementation

end.

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


unit PigLatinUnit;

interface

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

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

var
  Form1: TForm1;

implementation

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

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

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

initialization
finalization
  StopHook;
end.

以上代码没有经过测试!

本文地址:http://com.8s8s.com/it/it5611.htm