3

I have an old Delphi VCL project build in Rad Studio 2007. This version contains a bug in the TScreen.FindMonitor method. I am trying to fix this using a seperate helper class like stated in Is there a runtime patch for AV in TMonitor.GetBoundsRect?. The only problem is that I can't get this to work. Delphi can't compile and gives error "Cannot access private symbol TScreen.FindMonitor". Also tried using a WITH self DO statement, casting self to TScreen, casting to pointer and using MethodAddress, but nothing seems to work.

My code

unit PatchTScreen;

interface

implementation

uses
  Types, MultiMon, Windows, Forms;

type
  TFindMonitorMethod = function(Handle: HMONITOR): TMonitor of object;
  TScreenHelper = class helper for TScreen
  private
    function FindMonitorAddress: Pointer;
    function PatchedFindMonitorAddress: Pointer;
    function PatchedFindMonitor(Handle: HMONITOR): TMonitor;
  end;

function TScreenHelper.FindMonitorAddress: Pointer;
var
  MethodPtr: TFindMonitorMethod;
begin
  MethodPtr := Self.FindMonitor;
  Result := TMethod(MethodPtr).Code;
end;

function TScreenHelper.PatchedFindMonitorAddress: Pointer;
var
  MethodPtr: TFindMonitorMethod;
begin
  MethodPtr := Self.PatchedFindMonitor;
  Result := TMethod(MethodPtr).Code;
end;

function TScreenHelper.PatchedFindMonitor(Handle: HMONITOR): TMonitor;
  function DoFindMonitor: 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;
      end;
  end;
begin
  Result := DoFindMonitor;
  if Result = nil then
  begin
    // If we didn't find the monitor, rebuild the list (it may have changeed)
    Self.GetMonitors;
    Result := DoFindMonitor;
  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.

The compile error occures in TScreenHelper.FindMonitorAddress.

The only way I have been able to fix this issue is by changing the original Delphi code of TScreen.FindMonitor in Forms.pas and recomipling the unit with my project. But this is not an actual solution I would like to use, because other developers must make the same changes etc.

Remi
  • 1,289
  • 1
  • 18
  • 52
  • 1
    Including a modified `Forms` unit in your project is perfectly viable. You just commit it to your revision control and it's all good. The other way to do this, and I have done this in the past, is to use a disassembler at runtime to find out the address of the method. – David Heffernan Nov 03 '21 at 11:35
  • Maybe you can check the source and find a near method (one before or after the method) that isn't private and take an offset from it? – Remko Nov 03 '21 at 12:35
  • @Remko the order of methods in source code is not guaranteed to be the same order when compiled into ibinaries. – Remy Lebeau Nov 03 '21 at 14:55
  • Which is why you use disassm – David Heffernan Nov 03 '21 at 15:02
  • Is this about the problem that TScreen does not update the monitor list when the monitor configuration changes (e.g. a monitor gets added or removed or the users connects via Remote Desktop? If yes, have a look at https://stackoverflow.com/a/32556860/49925 I used that to fix the AV when a hint is shown. – dummzeuch Nov 03 '21 at 15:29
  • FindMonitor is still private in Berlin and this compiles from a TScreenHelper: ` with self do FindMonitor(0);` – FredS Nov 03 '21 at 16:49
  • @FredS I clearly stated 2007, so that it does compile in Berlin is of no help. – Remi Nov 04 '21 at 12:37
  • I understand, but your code basically works after making that change, nothing to do with WITH.. It is possible that Helpers don't support this in 2007 so look elsewhere. – FredS Nov 04 '21 at 14:27

0 Answers0