我正在尝试在 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 被释放”的情况。到输出(通过单步执行程序来确认) - 使用覆盖的析构函数仅销毁原始内容。
任何人都可以帮我调用被重写的析构函数吗? (或许还可以解释为什么一开始就没有调用它。)谢谢!
最佳答案
您的代码存在一些问题。
您没有将 Clone 变量初始化为零。在我的机器上,这导致了上层 CloneInstance 方法中的访问冲突,因为传入的值非零,所以没有创建克隆。
您没有将 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.
关于Delphi:使用 RTTI 实例化的对象未调用重写方法,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/8654364/