Методы исправления обезьян (функции) в Delphi Win64 - PullRequest
Новая
       8

Методы исправления обезьян (функции) в Delphi Win64

0 голосов
/ 28 ноября 2018

Вдохновленный этим , я успешно исправил строгую приватную (!) Функцию в Delphi 32bit, используя Delphi Detours Library и следующий код: 

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

Хотя в Win32 это работает нормально, в Win64 происходит сбой.Перехват работает, но оператор Result := Trampoline_TFormStyleHook_GetBorderSize(Self) возвращает мусор.Я думаю, это потому, что function (Self: TFormStyleHook) : TRect не эквивалентно function: TRect of object в Win64.У кого-нибудь есть идеи о том, как заставить вышеуказанное работать в Win64.Я использую Delphi Rio, но он работает так же и с Delphi Tokyo.

1 Ответ

0 голосов
/ 28 ноября 2018

Nevermind.Я нашел ответ.Следующее работает как с win32, так и с win64.Подозреваемый function (Self: TFormStyleHook) : TRect не эквивалентен function: TRect of object в Win64.Вам нужно объявить функцию 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);
...