程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> 攻破“金山詞霸”的技術堡壘

攻破“金山詞霸”的技術堡壘

編輯:Delphi

  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 ime 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.

  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved