问题 如何使FastCodePatch在Delphi XE2 Win64平台上运行?


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位封装。它仅适用于Standalone .exe应用程序。


5584
2017-09-28 09:50


起源



答案:


对于FastcodeAddressPatch函数,当我尝试时,此版本可以在32位和64位下工作。关键是将“指针”更改为“整数”,因为英特尔相对跳转指令($ 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;

12
2017-09-28 10:11



+1要明确区别在于问题中的版本在TJump记录中使用了一个8字节指针,这是不正确的。 - David Heffernan
啊哈,现在我想删除我的upvote。 Integer(ADestination) - Integer(ASource) 在Win64上无法正确。你需要使用 NativeInt。 - David Heffernan
@David:在表达式中更改为NativeInt。作为表达式目标的Distance-field必须是32位,就像你说的那样。 - Ville Krumlinde
在答案的底部还有另一个虚假的整数演员。 - David Heffernan
有这样的事情,但在Delphi调试器中没有。它被称为自上而下的内存分配,是Windows设置。在注册表中设置。你需要有一个LARGEADDRESSAWARE应用程序和64位才能使它值得,但它很棒。您可以按应用配置它,但这要困难得多。我发现唯一的缺点是许多病毒扫描程序无法处理该设置。我找到的最好的是Security Essentials。 - David Heffernan


答案:


对于FastcodeAddressPatch函数,当我尝试时,此版本可以在32位和64位下工作。关键是将“指针”更改为“整数”,因为英特尔相对跳转指令($ 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;

12
2017-09-28 10:11



+1要明确区别在于问题中的版本在TJump记录中使用了一个8字节指针,这是不正确的。 - David Heffernan
啊哈,现在我想删除我的upvote。 Integer(ADestination) - Integer(ASource) 在Win64上无法正确。你需要使用 NativeInt。 - David Heffernan
@David:在表达式中更改为NativeInt。作为表达式目标的Distance-field必须是32位,就像你说的那样。 - Ville Krumlinde
在答案的底部还有另一个虚假的整数演员。 - David Heffernan
有这样的事情,但在Delphi调试器中没有。它被称为自上而下的内存分配,是Windows设置。在注册表中设置。你需要有一个LARGEADDRESSAWARE应用程序和64位才能使它值得,但它很棒。您可以按应用配置它,但这要困难得多。我发现唯一的缺点是许多病毒扫描程序无法处理该设置。我找到的最好的是Security Essentials。 - David Heffernan


以下代码适用于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;

4
2017-10-06 01:33



这实际上是另一个问题的答案。维尔回答了你原来的问题。包中的修补功能是一种不同的游戏。您提供的代码也需要32位目标。 - David Heffernan
伟大的代码!我确认它与之完美配合 Delphi 10.1 (柏林)32/64位 Windows 7, 即使 DEP 启用。 - Paulo França Lacerda