Monkey patching methods (functions) in Delphi Win64

Question

Inspired by this, I have successfully patched a strict private (!) function in Delphi 32bits using the Delphi Detours Library and following code:

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. The interception works but statement Result := Trampoline_TFormStyleHook_GetBorderSize(Self) returns trash. I guess this is because function (Self: TFormStyleHook) : TRect is not equivalent to function: TRect of object in Win64. Does anyone have an idea about how to make the above work in Win64. I am using Delphi Rio, but it works the same with Delphi Tokyo.

PyScripter · Answer 1 · 2018-11-28T13:40:28.147

Nevermind. I found the answer. The following works with both win32 and win64. As suspected function (Self: TFormStyleHook) : TRect is not equivalent to function: TRect of object in Win64. You need to declare the Trampoline function as function: TRect of object and use the cast to TMethod to set/get the code pointer.

  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);

The Trampoline and the detour functions are functions of object instead of procedures. As suspected - function (Self: TFormStyleHook) : TRect - is not equivalent to - function: TRect of object - in Win64 — PyScripter, Nov 28 '18 at 13:35
Put that explanation into your answer, not buried in comments. — Ken White, Nov 28 '18 at 13:37

Monkey patching methods (functions) in Delphi Win64

1 Answers1