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

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

Answer 1

下面的代码同时适用于Win32的 - 独立和包装，Win64的 - 独立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; 

Answer 2

对于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;