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

Posted 2023-02-22

【中文标题】如何让 FastCodePatch 在 Delphi XE2 Win64 平台上工作？

【英文标题】：How to make FastCodePatch work in Delphi XE2 Win64 platform?

【发布时间】：2011-09-28 09:50:19

【问题描述】：

Unit 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】：

对于 FastcodeAddressPatch 功能，当我尝试时，此版本可在 32 位和 64 位中运行。关键是将“指针”更改为“整数”，因为 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;

【讨论】：

+1 要明确区别是问题中的版本在 TJump 记录中使用了一个 8 字节指针，这是不正确的。

啊哈，现在我想删除我的赞成票。 Integer(ADestination) - Integer(ASource) 在 Win64 上不正确。您需要使用NativeInt。

@David：在表达式中更改为 NativeInt。就像你说的那样，作为表达式目标的距离字段需要是 32 位的。

答案底部还有另一个虚假的整数类型。

有这样的东西，但在Delphi调试器中没有。这称为自上而下的内存分配，是一种 Windows 设置。在注册表中设置。你需要一个 LARGEADDRESSAWARE 应用程序和 64 位才能让它物有所值，但它很棒。您可以为每个应用程序配置它，但这要困难得多。我发现唯一的缺点是许多病毒扫描程序无法处理该设置。我发现最好的是 Security Essentials。

【参考方案2】：

以下代码适用于 Win32 - Standalone 和 Package、Win64 - Standalone 和 Package：

type
  TNativeUInt = $if CompilerVersion < 23Cardinal$elseNativeUInt$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 Win32Result := PPointer(J.Addr)^$endif
    $ifdef Win64Result := PPointer(TNativeUInt(Proc) + J.Addr + 6Instruction 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;

【讨论】：

这实际上是另一个问题的答案。维尔回答了你原来的问题。包中的修补功能是另一回事。 32 位目标也需要您提供的代码。

很棒的代码！我确认它与 32/64 位 Windows 7 下的 Delphi 10.1（柏林）完美配合，即使启用了 DEP。