BSOne.SFC/Tocsg.Lib/VCL/Other/KDL.Detours.pas

126 lines
3.1 KiB
Plaintext

(* Run-time redirection of a function calls inside of the executable module.
Attention: this unit is full of dirty hacks. :)
Copyright (C) 2006 - 2018 Kryvich, Belarusian Linguistic Software team.
*)
unit KDL.Detours;
{$IF NOT DEFINED(MSWINDOWS)}
{$Message Fatal 'Only Windows platform is supported,'
+ ' If you can do it on other platforms - tell me how.'}
{$IFEND}
interface
type
// Dump of original func, pointers to Original & New funcs
TFuncReplacement = class
private
var OrigDump: packed array[0..4] of Byte;
OrigFunc, MyFunc: Pointer;
fReplaced: Boolean; // Is func replaced now
procedure SetReplaced(aReplaced: Boolean);
public
constructor Create(aOrigFunc, aMyFunc: Pointer);
destructor Destroy; override;
property Replaced: Boolean read fReplaced write SetReplaced;
end;
implementation
uses
SysUtils, Windows;
type
// Used for Windows 95
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;
function IsWin9xDebugThunk(AnAddr: Pointer): Boolean; // copied from JclPeImage.pas
{ -> EAX: AnAddr }
asm
TEST EAX, EAX
JZ @@NoThunk
CMP BYTE PTR [EAX].TWin9xDebugThunk.PUSH, $68
JNE @@NoThunk
CMP BYTE PTR [EAX].TWin9xDebugThunk.JMP, $E9
JNE @@NoThunk
XOR EAX, EAX
MOV AL, 1
JMP @@Exit
@@NoThunk:
XOR EAX, EAX
@@Exit:
end;
type
// Used for packages
PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
TAbsoluteIndirectJmp = packed record
// FF25B8A9BD02 jmp dword ptr [$02bda9b8] -- x86
// 0000000000E31380 FF2522D00000 jmp qword ptr [rel $0000d022] -- x64
OpCode: Word;
Addr: UInt32;
end;
function GetActualAddr(Proc: Pointer): Pointer;
begin
if Proc <> nil then begin
if (Win32Platform <> VER_PLATFORM_WIN32_NT)
and IsWin9xDebugThunk(Proc)
then
Proc := PWin9xDebugThunk(Proc).Addr; // !! not tested for x64
if PAbsoluteIndirectJmp(Proc).OpCode = $25FF then // JMP mem32
// It's possible in packages
Result := PPointer(
{$IFDEF CPUX64} NativeInt(Proc) + 6 + {$ENDIF} // FF /4 jmp r/m64
PAbsoluteIndirectJmp(Proc).Addr)^
else
Result := Proc;
end else
Result := nil;
end;
{ TFuncReplacement }
constructor TFuncReplacement.Create(aOrigFunc, aMyFunc: Pointer);
var
OldProtect: DWORD;
begin
OrigFunc := GetActualAddr(aOrigFunc);
MyFunc := aMyFunc;
Move(OrigFunc^, OrigDump[0], 5);
VirtualProtect(OrigFunc, 5, PAGE_EXECUTE_READWRITE,
@OldProtect);
end;
destructor TFuncReplacement.Destroy;
begin
SetReplaced(False);
inherited;
end;
procedure TFuncReplacement.SetReplaced(aReplaced: Boolean);
var
Offset: Int32;
begin
if aReplaced = fReplaced then
Exit;
if aReplaced then begin // Set MyFunc
Offset := NativeInt(MyFunc) - NativeInt(OrigFunc) - 5;
Byte(OrigFunc^) := $E9;
Move(Offset, Pointer(NativeInt(OrigFunc)+1)^, 4);
end else // Set OrigFunc
Move(OrigDump[0], OrigFunc^, 5);
fReplaced := aReplaced;
end;
end.