修补实例类要求基类在同一个单元中?

Dan*_*all 16 delphi delphi-2007

我正在使用以下函数来修补现有对象的实例类.原因是我需要修补第三方类的受保护功能.

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;
Run Code Online (Sandbox Code Playgroud)

但由于某种原因,只有在我自己的单元中定义基类时,代码才有效.为什么?是否有一种解决方法可以让它在没有它的情况下工作?

这不起作用

 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.
Run Code Online (Sandbox Code Playgroud)

这工作(唯一的区别是重新定义TwwDBLookupComboDlg)

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

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

end.
Run Code Online (Sandbox Code Playgroud)

在研究这个例子时,我发现这种现象只发生在TwwDBLookupComboDlg中,而不是TButton.我不知道为什么.不幸的是,wwdbdlg.pas不是免费的.


更新:

我发现:如果我比较TButtonTButtonEx,这两个值是608.

如果我比较wwdlg.TwwDBLookupComboDlgTwwDBLookupComboDlgEx,然后将尺寸940和944.

如果我比较Unit1.TwwDBLookupComboDlgTwwDBLookupComboDlgEx,然后将尺寸944和944.

所以...实际问题是:如果我定义TwwDBLookupComboDlg = class(Wwdbdlg.TwwDBLookupComboDlg);,实例大小增加4个字节!

一个简单的演示.这个程序:

{$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.
Run Code Online (Sandbox Code Playgroud)

发射

188
192
192

用Delphi 2007编译时.然而,使用XE7,输出是:

220
220
220

虽然这个问题发生了TOpenDialog,但它不会发生TCommonDialog.

更新2:最小的例子

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.
Run Code Online (Sandbox Code Playgroud)

Dav*_*nan 10

对于旧版本的编译器,这在编译器行为中似乎是一种奇怪的(可能是一个错误).我把它缩减为以下代码:

{$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.
Run Code Online (Sandbox Code Playgroud)

在Delphi 6上,输出是:

20
24

8
16

8
16

编译器似乎对两个类声明的处理方式不同.该类包含一个具有8字节对齐的double,后跟一个4字节的整数.所以该类实际上应该在末尾有4个字节的填充,使其大小为8的倍数.第一个类没有这个填充,第二个类没有.

这里的代码证明了对字段的偏移没有改变,差别只是在为实现对齐而存在的类型末尾的填充中.

显然你不会得到Delphi 2007编译器的补丁.我怀疑你可以删除检查,NewClass.InstanceSize = Instance.InstanceSize你的修补代码仍然会正常运行.然后,您有责任确保不向补丁类添加任何数据成员.

另一种方法可能是使用不同的机制来修补代码.如果不了解原始问题,我很难说出可能是什么.