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

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?)

Answer 1

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.