Is there a runtime patch for AV in TMonitor.GetBoundsRect?

Question

The following is a known bug in Delphi 7 and 2007 (and possibly other versions)

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

There is an answer on how to fix it by recompiling forms.pas but I'd rather not recompile RTL units. Has anybody created a runtime patch for it e.g. using the technique also used in Andy Hausladen's VclFixpack? (And if yes, would you please share it with us?)

Fix it with a detour is one way. That's been covered here many times. Or simply write your own function and call it instead of the defective version. Or are you using third party code that relies of the defective function. — David Heffernan, Oct 02 '15 at 12:09
I've removed my answer because Stefan pointed out that you specifically ask for a patch that uses the same techniques as Andy uses. So, whilst I could give you code that would apply the fix, at least for D2007, it doesn't implement the fix with the required technique and so does not fit your question. — David Heffernan, Oct 02 '15 at 13:44
@DavidHeffernan I didn't see your answer before you removed it. What technique did it use? I didn't mean to explicitly require the same technique as in VclFixpack, that was just the first option that came into mind. (I cannot simply call my own function because that function is called inside the VCL e.g. for displaying hints.) — dummzeuch, Oct 02 '15 at 15:27
I've got an answer that works for D2007, but not for D7, because it relies on class helpers. Are you interested in it? I can simply undelete it if you are. It would help if the question made it clear that you are interested in answers that work just on D2007. — David Heffernan, Oct 02 '15 at 15:36
And i know how to make the patch in the same way that VclFixpack does. — Jens Borrisholt, Oct 02 '15 at 16:46
How about posting your answers DavidHeffernan and Jens Borrisholt ? — dummzeuch, Oct 04 '15 at 14:29

score 0 · Answer 1 · edited May 23 '17 at 12:06

You can do this with a detour. For instance, the code given in this answer: https://stackoverflow.com/a/8978266/505088 will suffice. Or you could opt for any other detouring library.

Beyond that, you need to crack the class to gain access to the private members. After all, GetBoundsRect is private. You can crack the class with a class helper. Again, one of my answers shows how to do that: https://stackoverflow.com/a/10156682/505088

Put the two together, and you have your answer.

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.

Without class helpers, as is the case in Delphi 7, you might be best recompiling the VCL unit in question. That is simple and robust.

If you can't bring yourself to do that then you need to find the function address. I'd do that by disassembling the code at runtime and following it to a known call to the function. This technique is well demonstrated by madExcept.

@Stefan Delphi 2007 did. Without class helpers you would have to recompile the VCL unit, or reverse engineer. — David Heffernan, Oct 02 '15 at 13:17
@StefanGlienke Well, I took a broader view and opted to offer an alternative way to solve the problem. — David Heffernan, Oct 02 '15 at 13:21
In the question I wrote "e.g. using the technique also used in Andy Hausladen's VclFixpack". I always thought that "e.g." means "for example", not "only in that way". Is my understanding of what "e.g." means wrong? — dummzeuch, Mar 17 '23 at 08:40

Is there a runtime patch for AV in TMonitor.GetBoundsRect?

1 Answers1

Linked