Patch routine call in delphi

Question

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.

Answer 1

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.

Answer 2

There's already a Delphi detours library for this.

The Delphi Detours Library is a library allowing you to hook delphi and windows API functions .It provides an easy way to insert and remove hook .

Features :

• Support x86 and x64 architecture .
• Allow calling the original function via Trampoline function.
• Support for Multi Hook.
• COM/Interfaces/win32api support.
• Support COM vtable patching.
• Fully thread-safe code hooking and unhooking .
• Support hooking Object Method .
• Supported Delphi 7/2005-2010/XE-XE7 .
• Support Lazarus/FPC .
• 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 allow to you to decode asm instructions (x86 & x64).

Answer 3

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;