How to make FastCodePatch work in Delphi XE2 Win64 platform?

Question

Unit FastCodePatch.pas works in Win32 platform. Delphi XE2 supports Win64 platform, any ideas how to make FastCodePatch works in Win64 platform?

unit FastcodePatch;

interface

function FastcodeGetAddress(AStub: Pointer): Pointer;
procedure FastcodeAddressPatch(const ASource, ADestination: Pointer);

implementation

uses
  Windows;

type
  PJump = ^TJump;
  TJump = packed record
    OpCode: Byte;
    Distance: Pointer;
  end;

function FastcodeGetAddress(AStub: Pointer): Pointer;
begin
  if PBYTE(AStub)^ = $E8 then
  begin
    Inc(Integer(AStub));
    Result := Pointer(Integer(AStub) + SizeOf(Pointer) + PInteger(AStub)^);
  end
  else
    Result := nil;
end;

procedure FastcodeAddressPatch(const ASource, ADestination: Pointer);
const
  Size = SizeOf(TJump);
var
  NewJump: PJump;
  OldProtect: Cardinal;
begin
  if VirtualProtect(ASource, Size, PAGE_EXECUTE_READWRITE, OldProtect) then
  begin
    NewJump := PJump(ASource);
    NewJump.OpCode := $E9;
    NewJump.Distance := Pointer(Integer(ADestination) - Integer(ASource) - 5);

    FlushInstructionCache(GetCurrentProcess, ASource, SizeOf(TJump));
    VirtualProtect(ASource, Size, OldProtect, @OldProtect);
  end;
end;

end.

The solution provided by Ville Krumlinde doesn't work on 64 bits package. It works on Standalone .exe application only.

Ville Krumlinde · Answer 1 · 2011-09-28T13:17:26.667

12

For the FastcodeAddressPatch-function, this version works both in 32-bit and 64-bit when I try. The key is changing "pointer" to "integer" because the Intel relative jump-instruction ($E9) still use an 32-bit offset in 64-bit mode.

type
  PJump = ^TJump;
  TJump = packed record
    OpCode: Byte;
    Distance: integer;
  end;

procedure FastcodeAddressPatch(const ASource, ADestination: Pointer);
const
  Size = SizeOf(TJump);
var
  NewJump: PJump;
  OldProtect: Cardinal;
begin
  if VirtualProtect(ASource, Size, PAGE_EXECUTE_READWRITE, OldProtect) then
  begin
    NewJump := PJump(ASource);
    NewJump.OpCode := $E9;
    NewJump.Distance := NativeInt(ADestination) - NativeInt(ASource) - Size;

    FlushInstructionCache(GetCurrentProcess, ASource, SizeOf(TJump));
    VirtualProtect(ASource, Size, OldProtect, @OldProtect);
  end;
end;

procedure Test;
begin
  MessageBox(0,'Original','',0);
end;

procedure NewTest;
begin
  MessageBox(0,'Patched','',0);
end;

procedure TForm5.FormCreate(Sender: TObject);
begin
  FastcodeAddressPatch(@Test,@NewTest);
  Test;
end;

I'm not sure what the other function does but I'm guessing it should be like this:

function FastcodeGetAddress(AStub: Pointer): Pointer;
begin
  if PBYTE(AStub)^ = $E8 then
  begin
    Inc(NativeInt(AStub));
    Result := Pointer(NativeInt(AStub) + SizeOf(integer) + PInteger(AStub)^);
  end
  else
    Result := nil;
end;

edited Sep 28 '11 at 13:17

answered Sep 28 '11 at 10:11

Ville Krumlinde

7,021
1
33
41

+1 To be clear the difference is that the version in the question uses an 8 byte pointer in the TJump record which is incorrect. – David Heffernan Sep 28 '11 at 11:12
Aha, now I want to remove my upvote. `Integer(ADestination) - Integer(ASource)` cannot be correct on Win64. You need to use `NativeInt`. – David Heffernan Sep 28 '11 at 11:22
@David: Changed to NativeInt in the expression. The Distance-field that is the destination of the expression needs to be 32-bit just like you say. – Ville Krumlinde Sep 28 '11 at 11:58
There's another spurious Integer cast at the bottom of the answer. – David Heffernan Sep 28 '11 at 12:44
@David: Fixed. It's too easy to forget these things because pointer vs integer casts does not create a compiler warning and also because when I run in debugger all the addresses are within 32-bit range anyway so errors do not appear. I wish there was a checkbox in the Delphi debugger that forced the program to run in >2gb address space to make sure 32->64 bit conversion bugs are triggered. – Ville Krumlinde Sep 28 '11 at 13:22
3

There is such a thing, but not in the Delphi debugger. It's called top-down memory allocation and is a Windows setting. Set in the registry. You need to have a LARGEADDRESSAWARE app and 64 bit to make it worthwhile but it's great. You can configure it per app but that's much harder. Only downside I found was that many many virus scanners can't handle that setting. The best I found was Security Essentials. – David Heffernan Sep 28 '11 at 14:23
@David: I did not know that, I'll keep it in mind. I tried changing the Image Base setting but any value above around $70000000 does not take effect. Presumably because it is stored as a 32-bit value in the pe-file. – Ville Krumlinde Sep 28 '11 at 15:00
More likely because you aren't setting the LARGEADDRESSAWARE PE flag. – David Heffernan Sep 28 '11 at 15:04
@Ville, your code works only in standalone .exe. If my patch code (e.g.: Test and NewTest are keep in package (.bpl). Load the package will cause problem in Win64 platform. – Chau Chee Yang Oct 04 '11 at 04:26
@ChauCheeYang: Do you get an error message? Does it work in 32-bit mode with packages? If you have any more information about the problem with packages please add it to your original question. – Ville Krumlinde Oct 04 '11 at 18:06
@ChauCheeYang: No, the error message isn't "Access Violation". The error message is "Access Violation. (Violation cause) at 0xXXXXXXXX of address 0xXXXXXXXX". **Exact** error messages are important. – Ken White Oct 05 '11 at 01:25
@Ville: I have post my answer that solve the package problem. – Chau Chee Yang Oct 06 '11 at 01:33

score 5 · Accepted Answer · answered Oct 06 '11 at 01:33

The following code works for both Win32 - Standalone and Package, Win64 - Standalone and Package:

type
  TNativeUInt = {$if CompilerVersion < 23}Cardinal{$else}NativeUInt{$ifend};

  PJump = ^TJump;
  TJump = packed record
    OpCode: Byte;
    Distance: integer;
  end;

function GetActualAddr(Proc: Pointer): Pointer;
type
  PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
  TAbsoluteIndirectJmp = packed record
    OpCode: Word;   //$FF25(Jmp, FF /4)
    Addr: Cardinal;
  end;
var J: PAbsoluteIndirectJmp;
begin
  J := PAbsoluteIndirectJmp(Proc);
  if (J.OpCode = $25FF) then
    {$ifdef Win32}Result := PPointer(J.Addr)^{$endif}
    {$ifdef Win64}Result := PPointer(TNativeUInt(Proc) + J.Addr + 6{Instruction Size})^{$endif}
  else
    Result := Proc;
end;

procedure FastcodeAddressPatch(const ASource, ADestination: Pointer);
const
  Size = SizeOf(TJump);
var
  NewJump: PJump;
  OldProtect: Cardinal;
  P: Pointer;
begin
  P := GetActualAddr(ASource);
  if VirtualProtect(P, Size, PAGE_EXECUTE_READWRITE, OldProtect) then
  begin
    NewJump := PJump(P);
    NewJump.OpCode := $E9;
    NewJump.Distance := TNativeUInt(ADestination) - TNativeUInt(P) - Size;

    FlushInstructionCache(GetCurrentProcess, P, SizeOf(TJump));
    VirtualProtect(P, Size, OldProtect, @OldProtect);
  end;
end;

This is actually the answer to a different question. Ville answered your original question. Patching functions in packages is a different game. The code you present is needed on 32 bit targets too. — David Heffernan, Oct 17 '11 at 21:03
Great code! I confirm it works perfectly with `Delphi 10.1` (Berlin) under 32/64-bit `Windows 7`, even with `DEP` enabled. — Paulo França Lacerda, Feb 23 '17 at 14:30

How to make FastCodePatch work in Delphi XE2 Win64 platform?

2 Answers2

Linked