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

时间:2018-11-28 03:54:46

标签: delphi monkeypatching

this的启发,我已经使用Delphi Detours Library和以下代码成功修补了Delphi 32位中的严格私有(!)函数:

<?php

public function auctionUpdate(Request $request, MediaSite $mediaSite)
{
    $auction = $mediaSite->auction;

    DB::transaction(function() use ($request, $mediaSite, $auction){
        $auction->fill($request->only([
           'status', 'start_time', 'end_time', 'period_start_date'
        ]));

        if($auction == null)
            $auction = new Auction();

        $auction->save();
   });

   return view('admin.media-site.show', [
       'mediaSite' => $mediaSite,
       'auction' => $auction
   ]);
}

尽管这在Win32中可以正常工作,但在Win64中却失败。侦听有效,但语句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); 返回垃圾。我猜这是因为Result := Trampoline_TFormStyleHook_GetBorderSize(Self)不等同于Win64中的function (Self: TFormStyleHook) : TRect。有谁知道如何使以上工作在Win64中。我正在使用Delphi Rio,但在Delphi Tokyo中也可以使用。

1 个答案:

答案 0 :(得分:2)

没关系。我找到了答案。以下适用于win32和win64。由于怀疑function (Self: TFormStyleHook) : TRect不等同于Win64中的function: TRect of object。您需要将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);