简体   繁体   English

Delphi Win64中的猴子修补方法(功能)

[英]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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM