Как заставить FastCodePatch работать на платформе Delphi XE2 Win64?

Модуль FastCodePatch.pas работает на платформе Win32. Delphi XE2 поддерживает платформу Win64, любые идеи о том, как заставить FastCodePatch работать на платформе Win64?

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.

Решение, предоставленное Ville Krumlinde, не работает с 64-битным пакетом. Он работает только с автономным .exe-приложением.

Ответ 1

Следующий код работает как для Win32 - Standalone, так и для Package, Win64 - Standalone и 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;

Ответ 2

Для функции FastcodeAddressPatch эта версия работает как в 32-битном, так и в 64-битном при попытке. Ключ меняет "указатель" на "целое", потому что относительная команда перехода от Intel ($ E9) по-прежнему использует 32-битное смещение в 64-битном режиме.

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;

Я не уверен, что делает другая функция, но я предполагаю, что это должно быть так:

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;