TMonitor中是否有针对AV的运行时补丁？ [英] Is there a runtime patch for AV in TMonitor.GetBoundsRect?

问题描述

以下是Delphi 7和2007(可能还有其他版本)中的已知错误

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

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

推荐答案

您可以绕道完成此操作。例如，以下答案中给出的代码：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很好地演示了这种技术。

这篇关于TMonitor中是否有针对AV的运行时补丁？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！