Patch routine call in delphi
Asked Answered
E

3

18

I want to patch a routine call to be able to handle it myself with some modifications. I am writing a resource loader. I want to patch the Delphi's LoadResourceModule and InitInheritedComponent routines with that of mine. I have checked PatchAPI call in MadExcept.pas unit, but couldn't figure it out if i can use that for my project.

I want something like

my exe at runtime calls -> LoadResourceModule -> jump to -> MyCustomResourceModule...

Any pointers on this would be very helpful.

Eldreeda answered 23/1, 2012 at 20:34 Comment(3)
This is called detour check this question How to change the implementation (detour) of an externally declared functionDescent
I just was thinking about the same today - so using this technique would allow for example to add code in the component streaming (from DFM to application) mechanism? So, for example, I could have a central place to log used component classes, or do some quality assurance ('do not use BDE classes! or that old version of component X!')?Tugboat
@Tugboat There are other extension points that allow that to be done more easily. For example TReader.OnFindComponentClass. Patching code should always be a last resort when nothing else can get the job done.Gymnasiast
G
17

I use the following code:

procedure PatchCode(Address: Pointer; const NewCode; Size: Integer);
var
  OldProtect: DWORD;
begin
  if VirtualProtect(Address, Size, PAGE_EXECUTE_READWRITE, OldProtect) then 
  begin
    Move(NewCode, Address^, Size);
    FlushInstructionCache(GetCurrentProcess, Address, Size);
    VirtualProtect(Address, Size, OldProtect, @OldProtect);
  end;
end;

type
  PInstruction = ^TInstruction;
  TInstruction = packed record
    Opcode: Byte;
    Offset: Integer;
  end;

procedure RedirectProcedure(OldAddress, NewAddress: Pointer);
var
  NewCode: TInstruction;
begin
  NewCode.Opcode := $E9;//jump relative
  NewCode.Offset := NativeInt(NewAddress)-NativeInt(OldAddress)-SizeOf(NewCode);
  PatchCode(OldAddress, NewCode, SizeOf(NewCode));
end;

You would implement your hook/patch/detour by calling RedirectProcedure:

RedirectProcedure(@LoadResourceModule, @MyLoadResourceModule);

This will work for 32 bit code. It will also work for 64 bit code provided that both the old and new functions reside in the same executable module. Otherwise the jump distance may exceed the range of a 32 bit integer.

I'd be very interested if somebody could provide an alternative that worked for 64 bit address space irrespective of how far apart the two addresses were.

Gymnasiast answered 23/1, 2012 at 20:43 Comment(9)
It may be a good idea to either unpatch the redirection or ensure that there will be no code break at application closing - the redirected call may be made (e.g. by the RTL or another unit loaded before the redirection unit), and jump to some uninitialized code.Mecklenburg
@Arnaud That can be true. In all my use of this I redirect before any calls are made, or it's a routine with no side effects and so unpatching does not matterGymnasiast
@DavidHeffernan Just for a thought, how can i call the old procedure if i want to get the default value and then work on that value. Since in the above code, we overwrite the address of the old routine to jump to the new procedure. Something like MyLoadResourceModule internally uses LoadResourceModule and do something extra....Eldreeda
@RahulW Then you need a better patching library, one that supports trampolines. Look into MS Detours.Gymnasiast
Can this code be used on a class, instead of an instance? For instance, can I use it like this? RedirectProcedure(@TCustomEdit.Changed, @NewMethod);?Calculate
If the method is static then yes. NewMethod would have to receive the Self reference as first param. If it's virtual I guess it won't work. Use TVirtualMethodInterceptor instead.Gymnasiast
FlushInstructionCache is not necessary on x86 or x64 CPU architectures as these have a transparent cache, it's effectively no-op there. Just a note to those who, like me, have code like in this answer and wonder whether absence of FlushInstructionCache is a bug or not. It isn't.Blakeblakelee
For indirect jumps where target is in a BPL a different approach must be followed.Mahdi
@farshad it depends if you want to patch just the call from just this module, or of you want to patch the bpl itselfGymnasiast
T
8

There's already DDetours for this:

The DDetours is a library allowing you to hook Delphi and Windows API functions. It provides an easy way to insert and remove hook.

Features :

  • Supports x86 and x64 architecture.
  • Supports multiple hook for a single function.
  • Supports Delphi 7/2005-2010/XE-Rio(Delphi 10.3).
  • Supports Lazarus/FPC.
  • Supports recursive function inside the hook function.
  • Supports hooking interfaces methods by MethodName or MethodIndex.
  • Supports COM vtable patching.
  • Supports hooking object methods.
  • Allows calling the original function via Trampoline/NextHook function.
  • COM/Interfaces/win32api support.
  • Thread-safe for hooking and unhooking.
  • 64 bit address is supported.
  • The library does not use any external library.
  • The library can insert and remove the hook at any time.
  • The library contains InstDecode library, that allows you to decode CPU instructions (x86/x64).

(as of 2.2 from 2020-06-09)

Transferase answered 8/12, 2014 at 8:39 Comment(0)
M
4

I modified David Heffernan's code for 64-bit support and indirect jump to methods in a BPL. With some help from: http://chee-yang.blogspot.com.tr/2008/11/hack-into-delphi-class.html

type
  PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
  TAbsoluteIndirectJmp = packed record
    OpCode: Word;  // $FF25(Jmp, FF /4) 
    Addr: DWORD;  // 32-bit address
                  // in 32-bit mode: it is a direct jmp address to target method
                  // in 64-bit mode: it is a relative pointer to a 64-bit address used to jmp to target method
  end;

  PInstruction = ^TInstruction;
  TInstruction = packed record
    Opcode: Byte;
    Offset: Integer;
  end;


function GetActualAddr(Proc: Pointer): Pointer;
begin
  Result := Proc;
  if Result <> nil then
    if PAbsoluteIndirectJmp(Result)^.OpCode = $25FF then  // we need to understand if it is proc entry or a jmp following an address
{$ifdef CPUX64}
      Result := PPointer( NativeInt(Result) + PAbsoluteIndirectJmp(Result)^.Addr + SizeOf(TAbsoluteIndirectJmp))^;
      // in 64-bit mode target address is a 64-bit address (jmp qword ptr [32-bit relative address] FF 25 XX XX XX XX)
      // The address is in a loaction pointed by ( Addr + Current EIP = XX XX XX XX + EIP)
      // We also need to add (instruction + operand) size (SizeOf(TAbsoluteIndirectJmp)) to calculate relative address
      // XX XX XX XX + Current EIP + SizeOf(TAbsoluteIndirectJmp)
{$else}
      Result := PPointer(PAbsoluteIndirectJmp(Result)^.Addr)^;
      // in 32-bit it is a direct address to method
{$endif}
end;

procedure PatchCode(Address: Pointer; const NewCode; Size: Integer);
var
  OldProtect: DWORD;
begin
  if VirtualProtect(Address, Size, PAGE_EXECUTE_READWRITE, OldProtect) then //FM: remove the write protect on Code Segment
  begin
    Move(NewCode, Address^, Size);
    FlushInstructionCache(GetCurrentProcess, Address, Size);
    VirtualProtect(Address, Size, OldProtect, @OldProtect); // restore write protection
  end;
end;

procedure RedirectProcedure(OldAddress, NewAddress: Pointer);
var
  NewCode: TInstruction;
begin
  OldAddress := GetActualAddr(OldAddress); 

  NewCode.Opcode := $E9;//jump relative
  NewCode.Offset := NativeInt(NewAddress) - NativeInt(OldAddress) - SizeOf(NewCode);

  PatchCode(OldAddress, NewCode, SizeOf(NewCode));
end;
Mahdi answered 11/3, 2017 at 8:16 Comment(1)
It will work for 64 bit code provided that both the old and new functions reside in the same executable module. Otherwise the jump distance may exceed the range of a 32 bit integer. So it has the same limitation as David's code.Trapper

© 2022 - 2024 — McMap. All rights reserved.