TMonitor.GetBoundsRect 中是否有 AV 的运行时补丁？

Question

以下是 Delphi 7 和 2007（可能还有其他版本）中的一个已知错误

Does TMonitor.GetBoundsRect have an access violation bug in Delphi 2007 triggered by VNC?

有一个关于如何通过重新编译 forms.pas 来修复它的答案，但我宁愿不重新编译 RTL 单元。是否有人为其创建了运行时补丁，例如使用 Andy Hausladen 的 VclFixpack 中也使用的技术？ （如果是，请与我们分享？）

Answer 1

您可以绕道而行。例如，此答案中给出的代码：https://stackoverflow.com/a/8978266/505088 就足够了。或者您可以选择任何其他绕行库。

除此之外，您还需要破解类才能访问私有成员。毕竟，GetBoundsRect 是私有的。您可以使用类助手破解类。同样，我的一个答案显示了如何做到这一点：https://stackoverflow.com/a/10156682/505088

把两者放在一起，你就有答案了。

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 很好地展示了这种技术。