Question

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

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;

但由于某种原因，只有在我自己的单位中定义基类时，代码才有效。为什么？有没有解决办法让它在没有它的情况下工作？

这不起作用

 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.

这个工作（唯一的区别是重新定义了TwwDBLookupComboDlg）

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

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

end.

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

更新

我发现：如果我比较TButton和TButtonEx，则两个值均为608。

如果我比较wwdlg.TwwDBLookupComboDlg和TwwDBLookupComboDlgEx，则尺寸为940和944.

如果我比较Unit1.TwwDBLookupComboDlg和TwwDBLookupComboDlgEx，则尺寸为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.

发射

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.

Answer 1

对于旧版本的编译器，这似乎是编译器行为的一个奇怪的（可能是一个错误）。我将其缩减为以下代码：

{$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.

在Delphi 6上，输出为：

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

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

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

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

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

1 个答案: