Есть ли исправление времени выполнения для AV в TMonitor.GetBoundsRect?

Question

Ниже приведена известная ошибка в Delphi 7 и 2007 (и, возможно, в других версиях).

Имеет ли TMonitor.GetBoundsRect ошибку нарушения доступа в Delphi 2007, вызванную VNC?

Есть ответ о том, как это исправить путем перекомпиляции forms.pas, но я бы предпочел не перекомпилировать модули RTL. Кто-нибудь создал для него патч времени выполнения, например, используя технику, также используемую в VclFixpack Энди Хаусладена? (И если да, не могли бы вы поделиться с нами?)

Answer 1

Вы можете сделать это с объездом. Например, код, указанный в этом ответе: /questions/38947443/patch-rutinnogo-vyizova-v-delphi/38947460#38947460 будет достаточным. Или вы можете выбрать любую другую обходную библиотеку.

Кроме того, вам нужно взломать класс, чтобы получить доступ к закрытым членам. В конце концов, GetBoundsRect это личное. Вы можете взломать класс с помощью помощника класса. Опять же, один из моих ответов показывает, как это сделать: /questions/46454572/kak-ya-mogu-ispravit-chastnyij-metod-klassa-delphi/46454585#46454585

Соедините их вместе, и у вас есть ответ.

unit PatchTScreen;

interface

implementation

uses
  Types, MultiMon, Windows, Forms;

type
  TScreenHelper = class helper for TScreen
    function FindMonitorAddress: Pointer;
    function PatchedFindMonitorAddress: Pointer;
    function PatchedFindMonitor(Handle: HMONITOR): TMonitor;
  end;

function TScreenHelper.FindMonitorAddress: Pointer;
var
  MethodPtr: function(Handle: HMONITOR): TMonitor of object;
begin
  MethodPtr := Self.FindMonitor;
  Result := TMethod(MethodPtr).Code;
end;

function TScreenHelper.PatchedFindMonitorAddress: Pointer;
var
  MethodPtr: function(Handle: HMONITOR): TMonitor of object;
begin
  MethodPtr := Self.PatchedFindMonitor;
  Result := TMethod(MethodPtr).Code;
end;

function TScreenHelper.PatchedFindMonitor(Handle: HMONITOR): TMonitor;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to MonitorCount - 1 do
    if Monitors[I].Handle = Handle then
    begin
      Result := Monitors[I];
//      break;
      Exit;
    end;
  //if we get here, the Monitors array has changed, so we need to clear and reinitialize it
  for i := 0 to MonitorCount-1 do
    TMonitor(Monitors[i]).Free;
  fMonitors.Clear;
  EnumDisplayMonitors(0, nil, @EnumMonitorsProc, LongInt(FMonitors));
  for I := 0 to MonitorCount - 1 do
    if Monitors[I].Handle = Handle then
    begin
      Result := Monitors[I];
      Exit;
    end;
end;

procedure PatchCode(Address: Pointer; const NewCode; Size: Integer);
var
  OldProtect: DWORD;
begin
  if VirtualProtect(Address, Size, PAGE_EXECUTE_READWRITE, OldProtect) then
  begin
    Move(NewCode, Address^, Size);
    FlushInstructionCache(GetCurrentProcess, Address, Size);
    VirtualProtect(Address, Size, OldProtect, @OldProtect);
  end;
end;

type
  PInstruction = ^TInstruction;
  TInstruction = packed record
    Opcode: Byte;
    Offset: Integer;
  end;

procedure RedirectProcedure(OldAddress, NewAddress: Pointer);
var
  NewCode: TInstruction;
begin
  NewCode.Opcode := $E9;//jump relative
  NewCode.Offset := NativeInt(NewAddress)-NativeInt(OldAddress)-SizeOf(NewCode);
  PatchCode(OldAddress, NewCode, SizeOf(NewCode));
end;

initialization
  RedirectProcedure(
    TScreen(nil).FindMonitorAddress,       // safe to use nil, don't need to instantiate an object
    TScreen(nil).PatchedFindMonitorAddress // likewise
  );

end.

Без помощников класса, как в случае с Delphi 7, вам лучше всего перекомпилировать рассматриваемый модуль VCL. Это просто и надежно.

Если вы не можете заставить себя сделать это, вам нужно найти адрес функции. Я бы сделал это, разобрав код во время выполнения и следуя по нему известному вызову функции. Эта техника хорошо продемонстрирована MadExcept.