[英]How to make FastCodePatch work in Delphi XE2 Win64 platform?
Unit FastCodePatch.pas works in Win32 platform. Unit FastCodePatch.pas在Win32平台上运行。 Delphi XE2 supports Win64 platform, any ideas how to make FastCodePatch works in Win64 platform?
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.
The solution provided by Ville Krumlinde doesn't work on 64 bits package. Ville Krumlinde提供的解决方案不适用于64位封装。 It works on Standalone .exe application only.
它仅适用于Standalone .exe应用程序。
For the FastcodeAddressPatch-function, this version works both in 32-bit and 64-bit when I try. 对于FastcodeAddressPatch函数,当我尝试时,此版本可以在32位和64位上运行。 The key is changing "pointer" to "integer" because the Intel relative jump-instruction ($E9) still use an 32-bit offset in 64-bit mode.
关键是将“指针”更改为“整数”,因为英特尔相对跳转指令($ 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;
I'm not sure what the other function does but I'm guessing it should be like this: 我不确定其他功能是做什么的,但我猜它应该是这样的:
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;
The following code works for both Win32 - Standalone and Package, Win64 - Standalone and Package: 以下代码适用于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;
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.