如何使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;