Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Patching instance class requires base class to be in the same unit?

I am using following function to patch an instance class of an existing object. The reason is that I need to patch a protected function of a third party class.

procedure PatchInstanceClass(Instance: TObject; NewClass: TClass);
type
  PClass = ^TClass;
begin
  if Assigned(Instance) and Assigned(NewClass)
    and NewClass.InheritsFrom(Instance.ClassType)
    and (NewClass.InstanceSize = Instance.InstanceSize) then
  begin
    PClass(Instance)^ := NewClass;
  end;
end;

But for some reason, the code only works if the the base class is defined in my own unit. Why's that? Is there a work-around to make it work without it?

This doesn't work

 unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, wwdblook, Wwdbdlg;

type
  TwwDBLookupComboDlg = class(Wwdbdlg.TwwDBLookupComboDlg); // This is necessary
  TForm1 = class(TForm)
    Button1: TButton;
    wwDBLookupComboDlg1: TwwDBLookupComboDlg;
    procedure FormCreate(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TButtonEx = class(TButton)
  end;

  TwwDBLookupComboDlgEx = class(TwwDBLookupComboDlg)
  end;

procedure PatchInstanceClass(Instance: TObject; NewClass: TClass);
type
  PClass = ^TClass;
begin
  if Assigned(Instance) and Assigned(NewClass)
    and NewClass.InheritsFrom(Instance.ClassType)
    and (NewClass.InstanceSize = Instance.InstanceSize) then
  begin
    PClass(Instance)^ := NewClass;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  PatchInstanceClass(Button1, TButtonEx);
  showmessage(Button1.ClassName); // Good: TButtonEx

  PatchInstanceClass(wwDBLookupComboDlg1, TwwDBLookupComboDlgEx);
  showmessage(wwDBLookupComboDlg1.ClassName); // Bad: TwwDBLookupComboDlg (should be TwwDBLookupComboDlgEx)
end;

end.

This works (The only difference is the re-definition of TwwDBLookupComboDlg)

type
  TwwDBLookupComboDlg = class(wwdbdlg.TwwDBLookupComboDlg); // <------ added!

procedure TForm1.FormCreate(Sender: TObject);
begin
  PatchInstanceClass(wwDBLookupComboDlg1, TwwDBLookupComboDlgEx);
  showmessage(wwDBLookupComboDlg1.ClassName); // shows TwwDBLookupComboDlgEx :-)
end;

end.

While working on that example, I found out that this phenomenon only happens with TwwDBLookupComboDlg , but not with TButton . I don't know why. Unfortunately, wwdbdlg.pas is not free.


Update:

I found out: If I compare TButton and TButtonEx, both values are 608.

If I compare wwdlg.TwwDBLookupComboDlg and TwwDBLookupComboDlgEx, then the sizes are 940 and 944.

If I compare Unit1.TwwDBLookupComboDlg and TwwDBLookupComboDlgEx, then the sizes are 944 and 944.

So... the actual problem is: If I define TwwDBLookupComboDlg = class(Wwdbdlg.TwwDBLookupComboDlg); , the instance size grows by 4 byte!

A simple demonstration. This program:

{$APPTYPE CONSOLE}

uses
  Dialogs;

type
  TOpenDialog = class(Vcl.Dialogs.TOpenDialog);
  TOpenDialogEx = class(TOpenDialog);

begin
  Writeln(Vcl.Dialogs.TOpenDialog.InstanceSize);
  Writeln(TOpenDialog.InstanceSize);
  Writeln(TOpenDialogEx.InstanceSize);
  Readln;
end.

emits

188
192
192

when compiled with Delphi 2007. However, with XE7 the output is:

220
220
220

While this issue occurs on TOpenDialog, it does not happen with TCommonDialog.

Update 2: Minimal example

program Project1;

{$APPTYPE CONSOLE}

uses
  Classes, Dialogs;

type
  TOpenDialog = class(TCommonDialog)
  private
    FOptionsEx: TOpenOptionsEx;
  end;

  TOpenDialogEx = class(Project1.TOpenDialog);

begin
  Writeln(Project1.TOpenDialog.InstanceSize); // 100
  Writeln(TOpenDialogEx.InstanceSize); // 104
  Readln;
end.
like image 722
Daniel Marschall Avatar asked Dec 16 '16 10:12

Daniel Marschall


1 Answers

This appears to be an oddity (perhaps a bug) in the compiler behaviour for older versions of the compiler. I've whittled this down to the following code:

{$APPTYPE CONSOLE}

type
  TClass1 = class
    FValue1: Double;
    FValue2: Integer;
  end;

  TClass2 = class(TClass1);

begin
  Writeln(TClass1.InstanceSize);
  Writeln(TClass2.InstanceSize);

  Writeln;
  Writeln(Integer(@TClass1(nil).FValue1));
  Writeln(Integer(@TClass1(nil).FValue2));

  Writeln;
  Writeln(Integer(@TClass2(nil).FValue1));
  Writeln(Integer(@TClass2(nil).FValue2));

  Readln;
end.

On Delphi 6 the output is:

20
24

8
16

8
16

The compiler appears to handle alignment differently for the two class declarations. The class contains a double which has 8 byte alignment, followed by a 4 byte integer. So the class really should have 4 bytes of padding at the end to make its size be a multiple of 8. The first class does not have this padding, the second one does.

The code here proves that the offsets to the fields have not changed, and the difference is just in the padding at the end of the type that exists to achieve alignment.

Obviously you aren't going to get a patch for the Delphi 2007 compiler. My suspicion is that you can remove the check that NewClass.InstanceSize = Instance.InstanceSize and your patching code will still behave correctly. Then the onus is on you to ensure that you don't add any data members to your patching class.

Another approach might be to use a different mechanism to patch the code. Without more knowledge of the original problem it's hard for me to say what that might be.

like image 87
David Heffernan Avatar answered Oct 23 '22 22:10

David Heffernan