API HOOK

  • 主题发起人 主题发起人 import
  • 开始时间 开始时间
I

import

Unregistered / Unconfirmed
GUEST, unregistred user!
贴子见:
http://www.csdn.net/expert/topic/39/39641.shtm
http://www.csdn.net/expert/topic/50/50840.shtm
http://x57.deja.com/threadmsg_ct.xp?AN=696933069&CONTEXT=976054538.742850612
Yes. I already posted the answer before you
asked the question, under "Answer: Hook TextOut and other API" But here it is again, for delphi 3 under windows 95
(and I've heard it works in Delphi 5 under windows 2000)
 
As for books about internal windows stuff, the two authors you are after are Matt Pietrek, and Jeffrey Richter. I think Jeffrey Richter's book you are after is now called something like Developing Applications for Windows,
but it used to have a different name "Advanced Windows". Actually I haven't read either of their latest books. This is all my own work and not really based on anything of theirs.
 
From:
Carl Kenner <carl_kenner@hotmail.com>
 
Tue 3:01
 
Subject:
Answer: Hook TextOut and other API
 
I finally worked out how to hook all windows functions
and replace them with my own. To demonstrate I made
a delphi program that will hook into all the TextOut
functions in all of your programs, so that all the text
displayed on the screen is in Pig Latin.
 
This program has only been tested on WINDOWS 95
Let me know if it works on 98 or Me or NT or 2000
 
Enjoy!
 
Carl Kenner
 
PS. It took me a whole year of research to work this
out, so if you give me some credit I will be happy.
=================================
 
library PigLatinDll;
 
uses
Windows,
SysUtils,
Classes,
HookTextUnit in 'HookTextUnit.pas';
 
function PigLatinWord(s: String): String;
Var start: String; Capitalize, AllCapitals: Boolean; i: Integer; begin
Result:=s;
if length(s)<=1 then exit;
Capitalize:=IsCharUpper(s[1]);
AllCapitals:=True;
for i:=1 to length(s) do begin
if IsCharLower(s) 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<=' ') do begin
Result:=Result+s;
Inc(i);
end;
 
// convert any numbers into latin numbers
w:='';
while (i<=length(s)) and (s>='0') and (s<='9') do begin w:=w+s;
Inc(i);
end;
Result:=Result+LatinNumber(w);
 
// add any other symbols unchanged (for now)
w:='';
while (i<=length(s)) and not IsCharAlphaNumeric(s) do begin w:=w+s;
Inc(i);
end;
Result:=Result+w;
 
// convert whole words into pig latin
w:='';
while (i<=length(s)) and IsCharAlpha(s) do begin
w:=w+s;
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<>#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 datestamp // 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.
 

Similar threads

A
回复
0
查看
981
Andreas Hausladen
A
S
回复
0
查看
579
SUNSTONE的Delphi笔记
S
S
回复
0
查看
673
SUNSTONE的Delphi笔记
S
S
回复
0
查看
688
SUNSTONE的Delphi笔记
S
S
回复
0
查看
683
SUNSTONE的Delphi笔记
S
后退
顶部