[英]Monkey patching methods (functions) in Delphi Win64
Inspired by this , I have successfully patched a strict private (!) function in Delphi 32bits using the Delphi Detours Library and following code: 灵感来自这个 ,我已经成功地修复了使用Delphi的32位严格的私有函数(!), 德尔福走弯路库和下面的代码:
var
Trampoline_TFormStyleHook_GetBorderSize : function (Self: TFormStyleHook) : TRect;
type
TFormStyleHookFix = class helper for TFormStyleHook
function GetBorderSizeAddr: Pointer;
end;
function TFormStyleHookFix.GetBorderSizeAddr: Pointer;
var
MethodPtr: function: TRect of object;
begin
with Self do MethodPtr := GetBorderSize;
Result := TMethod(MethodPtr).Code;
end;
function Detour_TFormStyleHook_GetBorderSize(Self: TFormStyleHook): TRect;
begin
Result := Trampoline_TFormStyleHook_GetBorderSize(Self);
if (Screen.PixelsPerInch > 96) then
Result.Top := MulDiv(Result.Top, 96, Screen.PixelsPerInch);
end;
initialization
Trampoline_TFormStyleHook_GetBorderSize :=
InterceptCreate(TFormStyleHook(nil).GetBorderSizeAddr,
@Detour_TFormStyleHook_GetBorderSize)
finalization
InterceptRemove(@Trampoline_TFormStyleHook_GetBorderSize);
Whilst this works fine in Win32, it fails in Win64. 尽管这在Win32中可以正常工作,但在Win64中却失败。 The interception works but statement
Result := Trampoline_TFormStyleHook_GetBorderSize(Self)
returns trash. 侦听有效,但语句
Result := Trampoline_TFormStyleHook_GetBorderSize(Self)
返回垃圾。 I guess this is because function (Self: TFormStyleHook) : TRect
is not equivalent to function: TRect of object
in Win64. 我猜这是因为
function (Self: TFormStyleHook) : TRect
与Win64中function: TRect of object
function (Self: TFormStyleHook) : TRect
不等效。 Does anyone have an idea about how to make the above work in Win64. 有谁知道如何使以上工作在Win64中。 I am using Delphi Rio, but it works the same with Delphi Tokyo.
我正在使用Delphi Rio,但在Delphi Tokyo中也可以使用。
Nevermind. 没关系。 I found the answer.
我找到了答案。 The following works with both win32 and win64.
以下适用于win32和win64。 As suspected
function (Self: TFormStyleHook) : TRect
is not equivalent to function: TRect of object
in Win64. 作为可疑
function (Self: TFormStyleHook) : TRect
与Win64中function: TRect of object
function (Self: TFormStyleHook) : TRect
不等效。 You need to declare the Trampoline function as function: TRect of object
and use the cast to TMethod to set/get the code pointer. 您需要将Trampoline函数声明为
function: TRect of object
并使用强制转换为TMethod来设置/获取代码指针。
type
TGetBorderSize = function: TRect of object;
TFormStyleHookFix = class helper for TFormStyleHook
function GetBorderSizeAddr: Pointer;
function Detour_GetBorderSize: TRect;
end;
var
Trampoline_TFormStyleHook_GetBorderSize : TGetBorderSize;
Detour_TFormStyleHook_GetBorderSize : TGetBorderSize;
function TFormStyleHookFix.GetBorderSizeAddr: Pointer;
var
MethodPtr: TGetBorderSize;
begin
with Self do MethodPtr := GetBorderSize;
Result := TMethod(MethodPtr).Code;
end;
function TFormStyleHookFix.Detour_GetBorderSize: TRect;
var
MethodPtr: TGetBorderSize;
begin
TMethod(MethodPtr).Code := TMethod(Trampoline_TFormStyleHook_GetBorderSize).Code;
TMethod(MethodPtr).Data := Pointer(Self);
Result := MethodPtr;
if (Screen.PixelsPerInch > 96) then
Result.Top := MulDiv(Result.Top, 96, Screen.PixelsPerInch);
end;
initialization
Detour_TFormStyleHook_GetBorderSize := TFormStyleHook(nil).Detour_GetBorderSize;
TMethod(Trampoline_TFormStyleHook_GetBorderSize).Code :=
InterceptCreate(TFormStyleHook(nil).GetBorderSizeAddr,
TMethod(Detour_TFormStyleHook_GetBorderSize).Code)
finalization
InterceptRemove(TMethod(Trampoline_TFormStyleHook_GetBorderSize).Code);
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.