Come far funzionare FastCodePatch nella piattaforma Delphi XE2 Win64?

Question

L'unità FastCodePatch.pas funziona con la piattaforma Win32. Delphi XE2 supporta la piattaforma Win64, qualche idea su come far funzionare FastCodePatch nella piattaforma 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. 

La soluzione fornita da Ville Krumlinde non funziona su 64 bit pacchetto. Funziona solo con l'applicazione .exe standalone.

Answer 1

Il seguente codice funziona sia per Win32 - Standalone e Package, Win64 - Standalone e pacchetto:

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

Per la funzione FastcodeAddressPatch, questa versione funziona sia a 32 che a 64 bit quando provo. La chiave sta cambiando il "puntatore" in "intero" perché l'istruzione di salto relativa Intel ($ E9) utilizza ancora un offset a 32 bit in modalità 64 bit.

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; 

io non sono sicuro di quello che l'altra funzione fa ma credo che dovrebbe essere simile a questo:

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;