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充分证明了这种技术。

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

1 个答案: