如何在Delphi XE2 Win64平台上使FastCodePatch工作？

Question

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应用程序。

- Chau Chee Yang

Answer 1

对于FastcodeAddressPatch函数，我尝试过这个版本在32位和64位模式下都能正常工作。关键是将“pointer”更改为“integer”，因为Intel相对跳转指令（$E9）在64位模式下仍然使用32位偏移量。

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;

- Ville Krumlinde

---

啊哈，现在我想取消我的点赞。在Win64上，Integer(ADestination) - Integer(ASource) 是不正确的。你需要使用 NativeInt。 - David Heffernan

@David：在表达式中更改为NativeInt。作为表达式目标的Distance字段需要像你说的一样是32位的。 - Ville Krumlinde

答案底部还有一个虚假的整数转换。 - David Heffernan

@David：已修复。由于指针与整数转换不会产生编译器警告，而且当我在调试器中运行时，所有地址都在32位范围内，因此很容易忘记这些事情。我希望Delphi调试器中有一个复选框，可以强制程序在>2GB的地址空间中运行，以确保触发32位->64位转换错误。 - Ville Krumlinde

有这个东西，但 Delphi 调试器里没有。它叫做自顶向下的内存分配，是一个Windows设置，可以在注册表中设置。使用它需要有一个 LARGEADDRESSAWARE 应用程序和 64 位，但非常好用。你可以为每个应用程序配置它，但那会更加困难。唯一的缺点是很多杀毒软件不能处理这个设置。我发现最好用的是 Security Essentials。 - David Heffernan

Answer 2

以下代码适用于Win32独立版和打包版，Win64独立版和打包版：

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;

- Chau Chee Yang

---

这实际上是对另一个问题的答案。Ville回答了你最初的问题。在软件包中修补函数是一种不同的游戏。你提供的代码也需要在32位目标上使用。 - David Heffernan

很棒的代码！我确认它在32/64位的Windows 7下，甚至启用了DEP，在Delphi 10.1（Berlin）下完美运行。 - Paulo França Lacerda