另一个HookAPI 源码,来自EurekaLog for Delphi中的EHook.pas
来源：互联网 发布：传奇胖妞赌大小数据 编辑：程序博客网 时间：2024/05/16 17:38
经过修改后可以单独运行.
本单元实现了两种API Hook技术.
一是采用了更改各个模块中函数入口指针,实现各模块调用API时被 Hook.优点是可以选择性的对某个模块(OCX,DLL..)访问
某个API时被hook.
二是采用了所有模块都被Hook,通过修改API函数第一条指令为跳转到用户API,备份原API内容.用户可以在自己定义的API上调用原来的API.
本单元还实现了UnHook.
是一个较完整的API Hook 库程序
有兴趣的朋友可以将这个API Hook Lib扩展到对其他进程的API Hook.
本文末尾将介绍两种Hook技术的使用方法.
EHookLib.pas:
{************************************************}
{ }
{ EurekaLog v 6.x }
{ Hook Unit - EHook }
{ }
{ Copyright (c) 2001 - 2007 by Fabio Dell'Aria }
{ }
{************************************************}
unit EHookLIB;
//{$I Exceptions.inc}
interface
uses Windows;
type
THandle = Cardinal;
PPointer = ^Pointer;
PShortInt = ^ShortInt;
function HookProcedureEx(ProcAddr, NewProc: Pointer; ProcName: string): Pointer;
function UnhookProcedure(ProcAddr: Pointer): Boolean;
function HookDllProcedureEx(ImportModule, ExportModule, ProcName: string;
NewProc: Pointer): Pointer;
function TryHookDllProcedureEx(ImportModules: array of string;
ExportModule, ProcName: string; NewProc: Pointer;
var CallProc: Pointer; CanFail: Boolean): Boolean;
function TryHookProcedureEx(ExportModule, ProcName: string; NewProc: Pointer;
var CallProc: Pointer): Boolean;
function HookVirtualMethod(AClass: TClass; Index: Integer; Method: Pointer): Pointer;
function UnhookVirtualMethod(AClass: TClass; Index: Integer): Boolean;
procedure JumpToMem(Addr, Jump: Pointer);
function GetFunctionSize(Addr, MaxSize: DWord): DWord;
function GetAsmSize(Start: Pointer; var Size: Byte): Boolean;
var
CriticalError: procedure (const Section: string) = nil;
implementation
uses Classes, SysUtils;
const
EProcNullStr = 'Cannot hook a null procedure ("%s").';
ESharedAreaStr = 'Cannot hook the module "%s" located into the shared-area.';
EHookingErrorStr = 'Cannot hook the procedure "%s".';
SharedMem = $7FFFFFFF; // Don't use major value because Delphi3 don't support it.
ModRmMod = $C0; // XX??????
ModRmRM = $07; // ?????XXX
OperSizeOver = $66; // Change the operand size from 32 to 16/8 bits.
AddrSizeOver = $67; // Change the address size from 32 to 16/8 bits.
OpCodePrefixes: set of Byte =
[$F0, $F2, $F3, $2E, $36, $3E, $26, $64, $65, OperSizeOver, AddrSizeOver];
OpCodeShortJump: set of Byte = [$70..$7F, $E0..$E3, $EB]; // 1 OpCode byte
OpCodeReturn: set of Byte = [$C2, $C3..$CA, $CB]; // "Return" first byte OpCodes
OpCodeLongJump1Byte: set of Byte = [$E8..$E9]; // 1 OpCode byte
OpCodeLongJump2Bytes: set of Byte = [$80..$8F]; // 2 OpCode bytes, 1th = $0F
AsmConst: array [0..255] of Byte = ($EE, $EE, $EE, $EE, $F1, $0B, $00, $00,
$0E, $0E, $FE, $FE, $F1, $EB, $00, $FF, $EE, $EE, $EE, $EE, $E1, $EB, $E0,
$E0, $EE, $FE, $FE, $FE, $F1, $FB, $F0, $F0, $EE, $EE, $EE, $EE, $F1, $FB,
$FF, $F0, $EE, $EE, $EE, $EE, $E1, $EB, $EF, $E0, $0E, $0E, $0E, $0E, $01,
$0B, $FF, $F0, $FE, $FE, $FE, $FE, $F1, $FB, $FF, $F0, $E0, $E0, $E0, $E0,
$E0, $E0, $E0, $E0, $E0, $E0, $E0, $E0, $E0, $E0, $E0, $E0, $E0, $E0, $E0,
$E0, $E0, $E0, $E0, $E0, $E0, $E0, $E0, $E0, $E0, $E0, $E0, $E0, $E0, $E0,
$EE, $EE, $EF, $EF, $EF, $EF, $EB, $EE, $E1, $EE, $F0, $F0, $E0, $E0, $E1,
$E1, $E1, $E1, $E1, $E1, $E1, $01, $F1, $F1, $F1, $F1, $F1, $F1, $E1, $E1,
$BE, $BE, $BE, $BE, $BE, $BE, $BE, $BE, $BE, $BE, $BE, $BE, $BE, $BE, $BE,
$BE, $E0, $E0, $E0, $E0, $E0, $E0, $E0, $E0, $E0, $E0, $ED, $E0, $E0, $E0,
$E0, $E0, $04, $04, $04, $E4, $E0, $E0, $E0, $E0, $01, $0B, $00, $E0, $E0,
$E0, $E0, $E0, $E1, $E1, $E1, $E1, $E1, $E1, $E1, $E1, $FB, $FB, $EB, $EB,
$EB, $EB, $EB, $EB, $EE, $EE, $E2, $E0, $EE, $EE, $EE, $EE, $03, $00, $02,
$00, $00, $01, $00, $00, $FE, $EE, $EE, $EE, $E1, $E1, $F0, $E0, $EE, $EE,
$EE, $EE, $EE, $EE, $EE, $EE, $E1, $E1, $E1, $E1, $E1, $E1, $F1, $E1, $EB,
$EB, $ED, $E1, $E0, $E0, $E0, $E0, $FF, $E0, $EF, $EF, $E0, $E0, $EE, $EE,
$E0, $E0, $E0, $E0, $E0, $E0, $EE, $FE);
type
EHookError = class(Exception);
EProcNull = class(EHookError);
EHookingError = class(EHookError);
ESharedArea = class(EHookError);
EIgnoreException = class(Exception);
TProc = procedure;
TRedirectOpCodes = packed record
JMPOpCode: Byte;
JMPDistance: DWord;
end;
TPrefixes = set of Byte;
THookedProcedure = record
OriginalProc, HookedBlockPt: Pointer;
HookedBlockSize: DWord;
POriginalAsmPt: Pointer;
POriginalAsmSize: DWord;
end;
PHookedProcedure = ^ THookedProcedure;
PSaveDLLProc = ^TSaveDLLProc;
TSaveDLLProc = packed record
HookModule: THandle;
ExportModule: string;
OldProc, NewProc: Pointer;
end;
THookedData = packed record
ClassType: TClass;
OriginalMethod: Pointer;
Index: Integer;
end;
PHookedData = ^THookedData;
PWin9xDebugThunk = ^TWin9xDebugThunk;
TWin9xDebugThunk = packed record
PUSH: Byte; // PUSH instruction opcode ($68)
Addr: Pointer; // The actual address of the DLL routine
JMP: Byte; // JMP instruction opcode ($E9)
Rel: Integer; // Relative displacement (a Kernel32 address)
end;
IMAGE_IMPORT_DESCRIPTOR = packed record
UnUsed: array [0..11] of Byte;
Name: DWord;
FirstThunk: DWord; // RVA to IAT
end;
PImageImportDescriptor = ^IMAGE_IMPORT_DESCRIPTOR;
IMAGE_THUNK_DATA = packed record
Function_: DWord; // PDWord
end;
PImageThunkData = ^IMAGE_THUNK_DATA;
PImageDosHeader = ^TImageDosHeader;
TImageDosHeader = packed record // DOS .EXE header
e_magic: Word; // Magic number
UnUsed: array [0..57] of Byte;
_lfanew: LongInt; // File address of new exe header
end;
THookedMethodsList = class(TList)
private
FLock: TRTLCriticalSection;
function GetItem(Index: Integer): PHookedData;
protected
public
constructor Create;
destructor Destroy; override;
procedure Lock;
procedure Unlock;
procedure Delete(Index: Integer);
property Items[Index: Integer]: PHookedData read GetItem; default;
end;
const
TRedirectOpCodesSize = SizeOf(TRedirectOpCodes);
var
HookedProcedures, DllList: TList;
HookedMethodsList: THookedMethodsList;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
{ THookedMethods }
constructor THookedMethodsList.Create;
begin
inherited;
InitializeCriticalSection(FLock);
end;
function THookedMethodsList.GetItem(Index: Integer): PHookedData;
begin
Result := PHookedData(TList(Self).Items[Index]);
end;
procedure THookedMethodsList.Lock;
begin
EnterCriticalSection(FLock);
end;
procedure THookedMethodsList.Unlock;
begin
LeaveCriticalSection(FLock);
end;
procedure THookedMethodsList.Delete(Index: Integer);
var
Data: PHookedData;
Ptr: Pointer;
begin
Ptr := Items[Index];
Data := PHookedData(Ptr);
Dispose(Data);
inherited;
end;
destructor THookedMethodsList.Destroy;
var
I: Integer;
begin
Lock;
try
for I := 0 to HookedMethodsList.Count - 1 do
UnhookVirtualMethod(HookedMethodsList[0]^.ClassType, HookedMethodsList[0]^.Index);
finally
Unlock;
end;
DeleteCriticalSection(FLock);
inherited;
end;
//------------------------------------------------------------------------------
function GetReadableSize(Address, Size: DWord): DWord;
const
ReadAttributes = [PAGE_READONLY, PAGE_READWRITE, PAGE_WRITECOPY, PAGE_EXECUTE,
PAGE_EXECUTE_READ, PAGE_EXECUTE_READWRITE, PAGE_EXECUTE_WRITECOPY];
var
MemInfo: TMemoryBasicInformation;
Tmp: DWord;
begin
Result := 0;
if (VirtualQuery(Pointer(Address), MemInfo, SizeOf(MemInfo)) = SizeOf(MemInfo)) and
(MemInfo.State = MEM_COMMIT) and (MemInfo.Protect in ReadAttributes) then
begin
Result := (MemInfo.RegionSize - (Address - DWord(MemInfo.BaseAddress)));
if (Result < Size) then
begin
repeat
Tmp := GetReadableSize((DWord(MemInfo.BaseAddress) + MemInfo.RegionSize), (Size - Result));
if (Tmp > 0) then Inc(Result, Tmp)
else Result := 0;
until (Result >= Size) or (Tmp = 0);
end;
end;
end;
function IsValidBlockAddr(Address, Size: DWord): Boolean;
begin
Result := (GetReadableSize(Address, Size) >= Size);
end;
function ConvertAddress(Addr: DWord): DWord;
type
TJMPCode = packed record
JMPOpCode: Word;
JMPPtr: PDWord;
MOVOpCode: Word;
end;
PJMPCode = ^TJMPCode;
var
JMP: PJMPCode;
begin
Result := Addr;
if (IsValidBlockAddr(Addr, 8)) then
begin
JMP := PJMPCode(Addr);
if (JMP^.JMPOpCode = $25FF) and (IsValidBlockAddr(DWord(JMP^.JMPPtr), 4)) then
Result := JMP^.JMPPtr^;
end;
end;
//------------------------------------------------------------------------------
function GetVirtualMethod(AClass: TClass; const Index: Integer): Pointer;
begin
Result := PPointer(Integer(AClass) + (Index * 4))^
end;
procedure SetVirtualMethod(AClass: TClass; Index: Integer; Method: Pointer);
var
PatchAddress: PPointer;
OldProtectionCode: DWord;
begin
PatchAddress := PPointer(Integer(AClass) + (Index * 4));
if (FindHInstance(PatchAddress) = 0) then Exit; // Check for unloaded module...
VirtualProtect(PatchAddress, 4, PAGE_EXECUTE_READWRITE, @OldProtectionCode);
PatchAddress^ := Method;
VirtualProtect(PatchAddress, 4, OldProtectionCode, @OldProtectionCode);
FlushInstructionCache(GetCurrentProcess, PatchAddress, 4);
end;
function HookVirtualMethod(AClass: TClass; Index: Integer; Method: Pointer): Pointer;
var
HData: PHookedData;
n: Integer;
begin
Result := nil;
if (Assigned(HookedMethodsList)) then
begin
HookedMethodsList.Lock;
try
Result := GetVirtualMethod(AClass, Index);
if (Result = Method) then
begin // Just hooked...
for n := 0 to (HookedMethodsList.Count - 1) do
begin
if ((HookedMethodsList[n]^.ClassType = AClass) and
(HookedMethodsList[n]^.Index = Index)) then
begin
Result := HookedMethodsList[n]^.OriginalMethod;
Break;
end;
end;
end
else
begin // First hook...
SetVirtualMethod(AClass, Index, Method);
New(HData);
HData^.ClassType := AClass;
HData^.OriginalMethod := Result;
HData^.Index := Index;
HookedMethodsList.Add(HData);
end;
finally
HookedMethodsList.Unlock;
end;
end;
end;
function UnhookVirtualMethod(AClass: TClass; Index: Integer): Boolean;
var
n: Integer;
begin
Result := False;
if (Assigned(HookedMethodsList)) then
begin
HookedMethodsList.Lock;
try
for n := 0 to (HookedMethodsList.Count - 1) do
begin
if ((HookedMethodsList[n]^.ClassType = AClass) and
(HookedMethodsList[n]^.Index = Index)) then
begin
SetVirtualMethod(AClass, Index, HookedMethodsList[n]^.OriginalMethod);
HookedMethodsList.Delete(n);
Result := True;
Break;
end;
end;
finally
HookedMethodsList.Unlock;
end;
end;
end;
//------------------------------------------------------------------------------
procedure WriteMem(Addr: Pointer; const Data; Size: DWord);
var
OldProtectionCode: DWord;
begin
VirtualProtect(Addr, Size, PAGE_EXECUTE_READWRITE, @OldProtectionCode);
Move(Data, Addr^, Size);
VirtualProtect(Addr, Size, oldProtectionCode, @OldProtectionCode);
FlushInstructionCache(GetCurrentProcess, Addr, Size);
end;
procedure JumpToMem(Addr, Jump: Pointer);
var
JumpOpCode: TRedirectOpCodes;
begin
JumpOpCode.JMPOpCode := $E9; // JMP OpCode
JumpOpCode.JMPDistance := (DWord(Jump) - DWord(Addr) - 5); // JMP Distance
WriteMem(Addr, JumpOpCode, TRedirectOpCodesSize);
end;
function ModuleFileName(HModule: THandle): string;
var
Buff: array[0..MAX_PATH - 1] of Char;
begin
GetModuleFileName(HModule, Buff, SizeOf(Buff));
Result := Buff;
end;
function ModRMByte(Prefixes: TPrefixes; OpCodeSize, OpCode, ModRM, SID: Byte): Byte;
var
RmMod, RmRM: Byte;
function AddrSize: Byte;
begin
Result := 4;
if (OperSizeOver in Prefixes) then Dec(Result, 2);
end;
function SIDSize: Byte;
begin
Result := 1;
if (SID and $07 = $05) then Inc(Result, 4);
end;
begin
Result := 0;
RmMod := (ModRM and ModRmMod) shr 6;
RmRM := (ModRM and ModRmRM);
if (not (AddrSizeOver in Prefixes)) then
case rmMod of // 32 bit mode...
0: begin
Result := 0;
if (RmRM = 4) then Inc(Result, SIDSize)
else
if (RmRM = 5) then Inc(Result, 4);
end;
1: begin
Result := 1;
if (RmRM = 4) then Inc(Result);
end;
2: begin
Result := 4;
if (RmRM = 4) then Inc(Result);
end;
3: Result := 0;
end
else
case rmMod of // 16 bit mode...
0: begin
Result := 0;
if (RmRM = 6) then Inc(Result, 2);
end;
1: Result := 1;
2: Result := 2;
3: Result := 0;
end;
if (opCodeSize = 1) then // OpCode extensions...
begin
if (OpCode in [$6B, $80, $82, $83, $C0, $C1, $C6]) then Inc(Result)
else
if (OpCode in [$69, $81, $C7]) then Inc(Result, AddrSize)
else
if (OpCode = $F6) and (ModRM and $38 = 0) then Inc(Result)
else
if (OpCode = $F7) and (ModRM and $38 = 0) then Inc(Result, AddrSize);
end
else
if (OpCode in [$70, $71, $72, $73, $A4, $AC, $BA, $C2, $C4, $C5, $C6]) then Inc(Result);
end;
function GetAsmSize(Start: Pointer; var Size: Byte): Boolean;
var
OpCode, OpCodeSize, OpCodeType, Mask, Shift, ModRM, PrefixesSize: Byte;
Ptr: PByte;
Prefixes: TPrefixes;
begin
Size := 1;
Prefixes := [];
Ptr := Start;
repeat
OpCode := Ptr^;
if (OpCode in [AddrSizeOver, OperSizeOver]) then Prefixes := Prefixes + [OpCode];
Inc(Ptr);
until (not (OpCode in OpCodePrefixes));
PrefixesSize := (DWord(Ptr) - DWord(Start) - 1);
if (OpCode = $0F) then
begin
OpCodeSize := 2;
OpCode := Ptr^;
Inc(Ptr);
Mask := $F0;
Shift := 4;
end
else
begin
OpCodeSize := 1;
Mask := $0F;
Shift := 0;
end;
OpCodeType := ((AsmConst[OpCode] and Mask) shr Shift);
Result := (OpCodeType <> $0F);
if (Result) then
begin
if (OpCodeType < $0E) then
begin
Size := (OpCodeType + OpCodeSize);
if (Size > OpCodeSize + 6) then
begin
Dec(Size, 7);
if (OperSizeOver in Prefixes) then Dec(Size, 2);
end;
end
else
begin
ModRM := Ptr^;
Inc(Ptr);
Size := (ModRMByte(Prefixes, OpCodeSize, OpCode, ModRM, Ptr^) + OpCodeSize + 1);
end;
Inc(Size, PrefixesSize);
end;
end;
function GetFunctionSize(Addr, MaxSize: DWord): DWord;
var
AsmSize: DWord;
OpSize, OpCode: Byte;
Pt, PtEnd: PChar;
begin
Result := 1;
if (MaxSize = 0) then
begin
Result := 0;
Exit;
end;
try
Pt := PChar(Addr);
PtEnd := PChar(Pt + MaxSize - 1);
AsmSize := 0;
while (Pt <= PtEnd) do
begin
if (GetAsmSize(Pt, OpSize)) then
begin
// Skip the prefixes OpCodes...
while ((PByte(Pt)^ in OpCodePrefixes) and (Pt <= PtEnd)) do Inc(Pt);
OpCode := PByte(Pt)^;
if (OpCode in OpCodeReturn) then
begin
Result := (AsmSize + OpSize);
Exit;
end;
end
else OpSize := 1;
Inc(AsmSize, OpSize);
Inc(Pt, OpSize);
end;
except
Result := 0;
end;
end;
function CalculateRelocatedAsmSize(Addr: Pointer; Size: Word): DWord;
var
AsmSize: DWord;
OpSize, OpCode: Byte;
Pt, PtStart, PtEnd, JmpTo: PChar;
Delta: Integer;
begin
Pt := PChar(Addr);
PtStart := Pt;
PtEnd := PChar(Pt + Size - 1);
Result := Size;
AsmSize := 0;
while (AsmSize < Size) do
begin
if (GetAsmSize(Pt, OpSize)) then
begin
// Skip the prefixes OpCodes...
while ((PByte(Pt)^ in OpCodePrefixes) and (Pt <= PtEnd)) do Inc(Pt);
OpCode := PByte(Pt)^;
if (OpCode in OpCodeShortJump) then
begin
Delta := PShortInt(Pt + 1)^;
JmpTo := (Pt + 2 + Delta);
if ((JmpTo < PtStart) or (JmpTo > PtEnd + 1)) then Inc(Result, 5);
end;
end
else OpSize := 1;
Inc(AsmSize, OpSize);
Inc(Pt, OpSize);
end;
end;
procedure RelocateMemory(NewAddr, OldAddr: Pointer; Size: DWord);
var
AsmSize: DWord;
OpSize, OpCode, OpBytes: Byte;
OldPt, Pt, PtStart, PtEnd, JmpTo, ShortJumpsPt: PChar;
NewDistance, Distance, Delta: Integer;
begin
OldPt := OldAddr;
Pt := PChar(NewAddr);
PtStart := Pt;
PtEnd := PChar(Pt + Size - 1);
ShortJumpsPt := (Pt + Size + SizeOf(TRedirectOpCodes));
AsmSize := 0;
while (AsmSize < Size) do
begin
if (GetAsmSize(Pt, OpSize)) then
begin
// Skip the prefixes OpCodes...
while ((PByte(Pt)^ in OpCodePrefixes) and (Pt <= PtEnd)) do Inc(Pt);
// Check for 2 bytes OpCode instructions...
OpCode := PByte(Pt)^;
if (OpCode = $0F) then // 2 bytes OpCode size
begin
Inc(Pt);
OpCode := PByte(Pt)^;
Dec(OpSize);
OpBytes := 2;
end
else OpBytes := 1;
// Search for relative Jump/Call instructions...
if ((OpBytes = 1) and (OpCode in OpCodeShortJump)) then
begin
Distance := PShortInt(Pt + 1)^;
JmpTo := (Pt + 2 + Distance);
// Check if need relocation...
if (JmpTo < PtStart) or (JmpTo > (PtEnd + 1)) then
begin
JmpTo := (OldPt + Integer(AsmSize) + OpSize + Distance);
JumpToMem(ShortJumpsPt, JmpTo);
Distance := (ShortJumpsPt - (Pt + 2));
WriteMem((Pt + 1), Distance, 1);
Inc(ShortJumpsPt, SizeOf(TRedirectOpCodes));
end;
end
else
if ((OpBytes = 1) and (OpCode in OpCodeLongJump1Byte)) or
((OpBytes = 2) and (OpCode in OpCodeLongJump2Bytes)) then
begin
Distance := PInteger(Pt + 1)^;
JmpTo := (Pt + 5 + Distance);
// Check if need relocation...
if (JmpTo < PtStart) or (JmpTo > (PtEnd + 1)) then
begin
Delta := (OldPt + Integer(AsmSize) - Pt + (OpBytes - 1));
NewDistance := (Distance + Delta);
WriteMem(Pt + 1, NewDistance, 4);
end;
end;
end
else OpSize := 1;
Inc(AsmSize, OpSize);
Inc(Pt, OpSize);
end;
end;
function HookProcedure(ProcAddr, NewProc: Pointer): Pointer;
var
PProc, Pt, PAsm: PChar;
AsmSize, FullAsmSize, OldProtectionCode: DWord;
OpSize: Byte;
n: Integer;
PHookedBlock: PHookedProcedure;
begin
for n := 0 to HookedProcedures.Count - 1 do
begin
PHookedBlock := PHookedProcedure(HookedProcedures[n]);
if (ProcAddr = PHookedBlock^.OriginalProc) then
begin
Result := PHookedBlock^.HookedBlockPt;
Exit;
end;
end;
PProc := ProcAddr;
Pt := PProc;
AsmSize := 0;
repeat
if (not (GetAsmSize(Pt, OpSize))) then OpSize := 1;
Inc(AsmSize, OpSize);
Inc(Pt, OpSize);
until (AsmSize >= 5);
FullAsmSize := (CalculateRelocatedAsmSize(PProc, AsmSize) + SizeOf(TRedirectOpCodes));
GetMem(PAsm, FullAsmSize);
// Save hooked data...
New(PHookedBlock);
PHookedBlock^.OriginalProc := ProcAddr;
PHookedBlock^.HookedBlockPt := PAsm;
PHookedBlock^.HookedBlockSize := FullAsmSize;
PHookedBlock^.POriginalAsmSize := AsmSize;
GetMem(PHookedBlock^.POriginalAsmPt, AsmSize);
Move(PProc^, PHookedBlock^.POriginalAsmPt^, AsmSize);
HookedProcedures.Add(PHookedBlock);
// Transform this data-block into executable code-block.
VirtualProtect(PAsm, FullAsmSize, PAGE_EXECUTE_READWRITE, @OldProtectionCode);
// Copy first ASM instructions from Procedure to Hook block...
Move(PProc^, PAsm^, AsmSize);
RelocateMemory(PAsm, PProc, AsmSize);
JumpToMem((PAsm + AsmSize), (PProc + AsmSize)); // JMP from Hook block to Procedure...
JumpToMem(PProc, NewProc); // JMP from Procedure to Hook block...
Result := PAsm;
end;
function HookProcedureEx(ProcAddr, NewProc: Pointer; ProcName: string): Pointer;
begin
ProcAddr := Pointer(ConvertAddress(DWord(ProcAddr)));
NewProc := Pointer(ConvertAddress(DWord(NewProc)));
if (ProcAddr = nil) then
raise EProcNull.CreateFmt(EProcNullStr, [ProcName])
else
if (DWord(ProcAddr) > SharedMem) and // Shared Area...
(Win32Platform <> VER_PLATFORM_WIN32_NT) then // Win9X/ME ...
raise ESharedArea.CreateFmt(ESharedAreaStr,
[ModuleFileName(FindHInstance(ProcAddr))]);
try
Result := HookProcedure(ProcAddr, NewProc);
except
raise EHookingError.CreateFmt(EHookingErrorStr, [ProcName]);
end;
end;
function UnhookProcedure(ProcAddr: Pointer): Boolean;
var
n: Integer;
PHookedBlock: PHookedProcedure;
begin
Result := False;
n := 0;
while (n <= HookedProcedures.Count - 1) do
begin
PHookedBlock := PHookedProcedure(HookedProcedures[n]);
if (ProcAddr = PHookedBlock^.OriginalProc) then
begin
WriteMem(PHookedBlock^.OriginalProc, PHookedBlock^.POriginalAsmPt^, PHookedBlock^.POriginalAsmSize);
FreeMem(PHookedBlock^.POriginalAsmPt, PHookedBlock^.POriginalAsmSize);
FreeMem(PHookedBlock^.HookedBlockPt, PHookedBlock^.HookedBlockSize);
FreeMem(PHookedBlock, SizeOf(THookedProcedure));
HookedProcedures.Delete(n);
Result := True;
end;
Inc(n);
end;
end;
function HookDllProcedure(ImportModule: THandle; ExportModule: string; OldProc, NewProc: Pointer;
ProcName: string; CanFail, Unhook: Boolean): Pointer;
var
FromProcDebugThunk, ImportThunk: PWin9xDebugThunk;
IsThunked, FoundProc: Boolean;
NtHeader: PImageNtHeaders;
ImportDir: TImageDataDirectory;
ImportDesc: PImageImportDescriptor;
CurrName: PChar;
ImportEntry: PImageThunkData;
Base: Pointer;
SaveDLLProc: PSaveDLLProc;
function IsWin9xDebugThunk(P: Pointer): Boolean;
begin
with PWin9xDebugThunk(P)^ do
Result := (PUSH = $68) and (JMP = $E9);
end;
// Mapped or loaded image related functions
function PeMapImgNtHeaders(const BaseAddress: Pointer): PImageNtHeaders;
begin
Result := nil;
if (not IsValidBlockAddr(DWord(BaseAddress), SizeOf(TImageDosHeader))) then Exit;
if (PImageDosHeader(BaseAddress)^.e_magic <> IMAGE_DOS_SIGNATURE) or
(PImageDosHeader(BaseAddress)^._lfanew = 0) then Exit;
Result := PImageNtHeaders(DWORD(BaseAddress) + DWORD(PImageDosHeader(BaseAddress)^._lfanew));
if (not IsValidBlockAddr(DWord(Result), SizeOf(TImageNtHeaders))) or
(Result^.Signature <> IMAGE_NT_SIGNATURE) then Result := nil
end;
procedure CheckFail;
begin
if (not CanFail) then
raise EHookingError.CreateFmt(EHookingErrorStr, [ProcName]);
end;
begin
Result := nil;
if (OldProc = nil) then
raise EProcNull.CreateFmt(EProcNullStr, [ProcName]);
if (ImportModule > SharedMem) and // Shared Area...
(Win32Platform <> VER_PLATFORM_WIN32_NT) then // Win9X/ME ...
raise ESharedArea.CreateFmt(ESharedAreaStr, [ModuleFileName(ImportModule)]);
Base := Pointer(ImportModule);
FromProcDebugThunk := PWin9xDebugThunk(OldProc);
IsThunked := (Win32Platform <> VER_PLATFORM_WIN32_NT) and IsWin9xDebugThunk(FromProcDebugThunk);
NtHeader := PeMapImgNtHeaders(Base);
if (NtHeader = nil) then
begin
CheckFail;
Exit;
end;
ImportDir := NtHeader.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT];
if (ImportDir.VirtualAddress = 0) then
begin
CheckFail;
Exit;
end;
ImportDesc := PImageImportDescriptor(DWORD(Base) + ImportDir.VirtualAddress);
while (ImportDesc^.Name <> 0) do
begin
CurrName := (PChar(Base) + ImportDesc^.Name);
if (StrIComp(CurrName, PChar(ExportModule)) = 0) then
begin
ImportEntry := PImageThunkData(DWORD(Base) + ImportDesc^.FirstThunk);
while (ImportEntry^.Function_ <> 0) do
begin
if IsThunked then
begin
ImportThunk := PWin9xDebugThunk(ImportEntry^.Function_);
FoundProc := IsWin9xDebugThunk(ImportThunk) and
(ImportThunk^.Addr = FromProcDebugThunk^.Addr);
end
else
FoundProc := Pointer(ImportEntry^.Function_) = OldProc;
if FoundProc then
begin
WriteMem(@ImportEntry^.Function_, NewProc, 4);
if (not Unhook) then
begin
New(SaveDLLProc);
SaveDLLProc^.OldProc := OldProc;
SaveDLLProc^.NewProc := NewProc;
SaveDLLProc^.HookModule := ImportModule;
SaveDLLProc^.ExportModule := ExportModule;
DllList.Add(SaveDLLProc);
end;
Result := OldProc;
end;
Inc(ImportEntry);
end;
end;
Inc(ImportDesc);
end;
if (not CanFail) and (Result = nil) then
raise EHookingError.CreateFmt(EHookingErrorStr, [ProcName]);
end;
function TryHookDllProcedureEx(ImportModules: array of string;
ExportModule, ProcName: string; NewProc: Pointer;
var CallProc: Pointer; CanFail: Boolean): Boolean;
var
TmpProc, OldProc: Pointer;
HModule: THandle;
n: integer;
begin
Result := False;
OldProc := GetProcAddress(GetModuleHandle(PChar(ExportModule)), PChar(ProcName));
for n := low(ImportModules) to high(ImportModules) do
begin
HModule := GetModuleHandle(PChar(ImportModules[n]));
if (HModule <> 0) then
begin
TmpProc := HookDllProcedure(HModule, ExportModule, OldProc, NewProc,
ExportModule + '.' + ProcName, CanFail, False);
Result := (Result) or (TmpProc <> nil);
end;
end;
CallProc := OldProc; // WARNING don't move to HERE!!!
end;
function TryHookProcedureEx(ExportModule, ProcName: string; NewProc: Pointer;
var CallProc: Pointer): Boolean;
var
TmpProc, OldProc: Pointer;
begin
Result := False;
OldProc := GetProcAddress(GetModuleHandle(PChar(ExportModule)), PChar(ProcName));
TmpProc := nil;
if Assigned(OldProc) then TmpProc := HookProcedureEx(OldProc, NewProc, ProcName);
Result := (Result) or (TmpProc <> nil);
CallProc := TmpProc; // WARNING don't move to HERE!!!
end;
function HookDllProcedureEx(ImportModule, ExportModule, ProcName: string;
NewProc: Pointer): Pointer;
var
OldProc: Pointer;
begin
OldProc := GetProcAddress(GetModuleHandle(PChar(ExportModule)), PChar(ProcName));
Result := HookDllProcedure(GetModuleHandle(PChar(ImportModule)), ExportModule,
OldProc, NewProc, ExportModule + '.' + ProcName, False, False);
end;
//------------------------------------------------------------------------------
procedure Init;
begin
DllList := TList.Create;
HookedMethodsList := THookedMethodsList.Create;
HookedProcedures := TList.Create;
end;
procedure Done;
var
n: Integer;
P: PSaveDLLProc;
PHookedBlock: PHookedProcedure;
begin
for n := 0 to DllList.Count - 1 do
begin
P := PSaveDLLProc(DllList[n]);
HookDLLProcedure(P^.HookModule, P^.ExportModule, P^.NewProc, P^.OldProc, '', True, True);
Dispose(P);
end;
DllList.Free;
DllList := nil;
HookedMethodsList.Free;
HookedMethodsList := nil;
for n := HookedProcedures.Count - 1 downto 0 do
begin
PHookedBlock := HookedProcedures[n];
UnhookProcedure(PHookedBlock^.OriginalProc);
end;
HookedProcedures.Free;
HookedProcedures := nil;
end;
//------------------------------------------------------------------------------
procedure SafeExec(Proc: TProc; Section: string);
var
Error: string;
begin
try
Proc;
except
on Err: TObject do
begin
if (Err is EIgnoreException) then raise;
if (@CriticalError <> nil) then
begin
CriticalError(Format('%s (Address: %s)', [Section, IntToHex(DWord(@Proc), 8)]));
Abort;
end
else
begin
if (ExceptObject is Exception) then Error := Exception(ExceptObject).Message
else Error := 'General internal error.';
raise Exception.CreateFmt('Critical error at: "%s"'#13#10'Error: "%s".', [Section, Error]);
end;
end;
end;
end;
//------------------------------------------------------------------------------
initialization
SafeExec(Init, 'EHook.Init');
finalization
SafeExec(Done, 'EHook.Done');
end.
下面是示例程序:
代码:type //保存原API函数地址 Kernel_WriteFile: function(hFile: Integer;
const Buffer;
nNumberOfBytesToWrite: Cardinal;
var lpNumberOfBytesWritten: Cardinal;
lpOverlapped: Pointer): Integer;
stdcall;
//自定义api函数function MyWriteFile(hFile: THandle;
Buffer:PPChar;
nNumberOfBytesToWrite: DWORD;
var lpNumberOfBytesWritten: DWORD;
lpOverlapped: POverlapped): BOOL;
stdcall;
var i:DWORD;
begin //将所有写入的数据取反 for i:=LongWord(Buffer) to LongWord(Buffer)+nNumberOfBytesToWrite-1 do begin A:=PByte(i)^;
A:=not A;
PByte(i)^:=A;
end;
//调用原来的系统文件 Result:=Kernel_WriteFile(hFile, Buffer, nNumberOfBytesToWrite, lpNumberOfBytesWritten, lpOverlapped);
end;
上面准备好了用户自定义API,和保存系统API函数指针.
下面介绍用法:
1.对单独模块进行API Hook
例如,假设我们的程序中包括了Mapx5.ocx, lin.dll和其他一些dll模块,
我们只想Hook程序的MapX5.OCX和 Lin.dll两个模块的WriteFile这个API函数,
调用函数TryHookDllProcedureEx:
代码: S:=ExtractFilePath(Application.ExeName);
//获取路径 // Hooked "WriteFile" Windows API... TryHookDllProcedureEx( [S+'MapX5.OCX', S+'Lin.dll'], //仅改变Mapx5.ocx, lin.dll两个模块的WriteFile功能 kernel32, 'WriteFile', @HookedWriteFile, @Kernel_WriteFile, True);
2.对所有模块进行API Hook
更简单,调用函数TryHookProcedureEx
代码: TryHookProcedureEx( kernel32, 'CreateFileA', @MyCreateFileA, @Kernel_CreateFileA);
Unhook某个函数:
更更简单,调用 UnHookProcedure:
代码: UnHookProcedure(@Kernel_WriteFile);
- 另一个HookAPI 源码,来自EurekaLog for Delphi中的EHook.pas
- Delphi中的SendKeys函数 - sndKey32.Pas 下载
- EurekaLog 对Delphi线程的影响
- Delphi SendKeys.Pas
- delphi Opencv.pas
- delphi IPL.pas
- delphi 的 Glut.pas
- Delphi 完整的Bug决议工具EurekaLog的使用
- EurekaLog 7.0.7.1 Entprise 破解版，支持 Delphi XE 5
- Delphi 完整的Bug决议工具EurekaLog的使用
- Delphi 完整的Bug决议工具EurekaLog的使用
- delphi 的 GL.pas opengl
- DELPHI中的ADODB.pas 单元中，一个直到今天都还没有解决的BUG
- QQ连连看 for Delphi 源码
- 一个过期的Delphi问题（找不到DesignIntf.pas、Proxies.pas、ComponentDesigner.pas）
- delphi操作png的单元pngimage.pas包括引用的ZlibExApi.pas和 PngLang.pas
- Delphi函数大全1-StrUtils.pas
- Delphi函数大全3-SysUtils.pas
- Java集合HashSet-ArrayList-HashMap的线程同步控制方法和区别
- 我的第一个头文件（2012.07.06）
- D2: Win95 + Speaker + Sound := possible
- 一位码农的人生自述（十一）------学习
- Android4.03 运行
- 另一个HookAPI 源码,来自EurekaLog for Delphi中的EHook.pas
- TestDirector8.0 下载 安装
- 接口对接
- 268. Like father, like son. 有其父，必有其子
- 关于URL优化的一些经验
- ubuntu搭建object-c环境
- 一位码农的人生自述（十二）------高中（终）
- Ubuntu 12.04 改造指南
- BI与ERP 谁先谁后？
