Delphi：不为使用 RTTI 实例化的对象调用重写的方法

Question

我正在尝试在 D2010 中使用 RTTI 克隆对象。到目前为止，这是我的尝试：

uses SysUtils, TypInfo, rtti;
type
  TPerson = class(TObject)
  public
    Name: string;
    destructor Destroy(); Override;
  end;
destructor TPerson.Destroy;
begin
  WriteLn('A TPerson was freed.');
  inherited;
end;
procedure CloneInstance(SourceInstance: TObject; DestinationInstance: TObject; Context: TRttiContext); Overload;
var
  rSourceType:      TRttiType;
  rDestinationType: TRttiType;
  rField:           TRttiField;
  rSourceValue:     TValue;
  Destination:      TObject;
  rMethod:          TRttiMethod;
begin
  rSourceType := Context.GetType(SourceInstance.ClassInfo);
  if (DestinationInstance = nil) then begin
    rMethod := rSourceType.GetMethod('Create');
    DestinationInstance := rMethod.Invoke(rSourceType.AsInstance.MetaclassType, []).AsObject;
  end;
  for rField in rSourceType.GetFields do begin
    if (rField.FieldType.TypeKind = tkClass) then begin
      // TODO: Recursive clone
    end else begin
      // Non-class values are copied (NOTE: will cause problems with records etc.)
      rField.SetValue(DestinationInstance, rField.GetValue(SourceInstance));
    end;
  end;
end;
procedure CloneInstance(SourceInstance: TObject; DestinationInstance: TObject); Overload;
var
  rContext:       TRttiContext;
begin
  rContext := TRttiContext.Create();
  CloneInstance(SourceInstance, DestinationInstance, rContext);
  rContext.Free();
end;
var
  Original:     TPerson;
  Clone:        TPerson;
begin
  ReportMemoryLeaksOnShutdown := true;
  Original := TPerson.Create();
  CloneInstance(Original, Clone);
  Clone.Free();
  Original.Free();
  ReadLn;
end.

有点令人失望的是，我没有看到不止一次出现“一个 TPerson 被释放了。”到输出（通过单步执行程序来确认） - 使用重写的析构函数只销毁原始文件。

谁能帮我调用被覆盖的析构函数？ （也许可以解释为什么一开始就没有调用它。）谢谢！

Answer 1

你的代码有几个问题。

您没有将 Clone 变量初始化为 nil。这在我的机器上导致了上层 CloneInstance 方法中的访问冲突，因为没有创建克隆，因为传入的值不是 nil。

您没有将 DestinationInstance 参数声明为 var。这意味着上层 CloneInstance 方法中的实例化不会返回给调用者。在参数中添加var 即可解决问题。您确实需要在从程序的 main 方法调用 CloneInstance 时使用TObject(Clone)，否则 Delphi 会抱怨“没有可以使用这些参数调用的重载方法”。这是因为 var 参数希望将其声明的确切类型传递给它们。

我将您的代码更改为：

uses
  SysUtils,
  TypInfo,
  rtti;

type
  TPerson = class(TObject)
  public
    Name: string;
    constructor Create;
    destructor Destroy(); Override;
  end;

constructor TPerson.Create;
begin
  WriteLn('A TPerson was created');
end;

destructor TPerson.Destroy;
begin
  WriteLn('A TPerson was freed.');
  inherited;
end;

procedure CloneInstance(SourceInstance: TObject; var DestinationInstance: TObject; Context: TRttiContext); Overload;
var
  rSourceType:      TRttiType;
  rDestinationType: TRttiType;
  rField:           TRttiField;
  rSourceValue:     TValue;
  Destination:      TObject;
  rMethod:          TRttiMethod;
begin
  rSourceType := Context.GetType(SourceInstance.ClassInfo);
  if (DestinationInstance = nil) then begin
    rMethod := rSourceType.GetMethod('Create');
    DestinationInstance := rMethod.Invoke(rSourceType.AsInstance.MetaclassType, []).AsObject;
  end;
  for rField in rSourceType.GetFields do begin
    if (rField.FieldType.TypeKind = tkClass) then begin
      // TODO: Recursive clone
    end else begin
      // Non-class values are copied (NOTE: will cause problems with records etc.)
      rField.SetValue(DestinationInstance, rField.GetValue(SourceInstance));
    end;
  end;
end;

procedure CloneInstance(SourceInstance: TObject; var DestinationInstance: TObject); Overload;
var
  rContext:       TRttiContext;
begin
  rContext := TRttiContext.Create();
  CloneInstance(SourceInstance, DestinationInstance, rContext);
  rContext.Free();
end;

var
  Original:     TPerson;
  Clone:        TPerson;
begin
  Clone := nil;
  ReportMemoryLeaksOnShutdown := true;
  Original := TPerson.Create();
  Original.Name := 'Marjan';

  CloneInstance(Original, TObject(Clone));
  Original.Name := 'Original';
  WriteLn('Original name: ', Original.Name);
  WriteLn('Clone name: ', Clone.Name);

  Clone.Free();
  Original.Free();
  ReadLn;
end.

我添加了一个构造函数来查看正在创建的两个实例，并添加了几行代码来检查克隆后的名称。输出内容为：

A TPerson was created
A TPerson was created
Original name: Original
Clone name: Marjan
A TPerson was freed.
A TPerson was freed.

Answer 2

一个示例解决方案（用于构造函数，但在这种情况下基本上也可用）位于

How can I create an Delphi object from a class reference and ensure constructor execution? in this answer

但是它需要知道目标类型...这可能不是一个选项