Delphi中的对象复制

Question

我有一个复杂的对象需要进行深层复制(包括许多数组、对象、指针，以及多层继承、数百个不同类型的成员等)，而使用Delphi的Assign方法重新创建它不够高效并且可能过于复杂。

我一直在研究Rtti，它似乎是一个很好的选择，但到目前为止，我无法覆盖所有可能的情况。我不想浪费太多时间，希望能找到一个好的简单例子。不幸的是，我还没有找到一个好的例子。到目前为止，我一直在通过循环(TRttiType.GetFields())遍历对象中所有的TRttiField，并尝试根据TTypeKind值使用指针来赋值。(tkPointer、tkClass、tkClassRef...)

我找到了一个JSON/Marshalling的例子，但它无法深度复制我的复杂对象；我得到了错误;

Internal: Type tkPointer is not currently supported

http://www.yanniel.info/2012/02/deep-copy-clone-object-delphi.html

在Delphi中是否有类似于C#二进制序列化和使用内存流创建深层副本的东西。或者在Delphi中是否有一个好的简单例子，使用RTTI或JSON/Marshalling进行深层复制，适用于最复杂的对象？

- Alex

---

Jerry，这个类已经继承了TPersistent并且Assign方法已经被重写了。除非有自动化的方式，否则我必须手动地将数百个对象分配给彼此。(我尝试调用inherited Assign，但它抛出了一个错误，类似于“无法将MyObject分配给MyObject”。即使在调用Assign之前检查了正确的对象类型，这种情况仍然发生。) - Alex

几百名成员？听起来你需要缩减这个庞然大物。就其价值而言，这里有数百个关于持久性问题的SO提问。已经有很多答案了。 - David Heffernan

不，Assign 不是这样工作的。你应该重写AssignTo，提供复制的手段。 - OnTheFly

@user 当您无法控制目标对象时，AssignTo 是您需要重写的内容。如果您控制所有对象，则重写Assign是正常的。然而，这两者都不能让您接近序列化对象。 - David Heffernan

@DavidHeffernan 嗯，有数百个成员，其中许多是对象。但是这些成员对象也非常大，每个对象都包含许多层自己的对象和自己的成员。我正在修复一个相当大的项目（数百万行）。我一直在寻找一个好的解决方案，并将继续这样做。我希望有经验的人可以在这篇文章中提供一个示例或提示，我可以跟随。到目前为止，我发现或编写的内容对于复杂的对象没有帮助。 - Alex

Answer 1

几句话概括，你不能使用RTTI来简化深拷贝（这将比使用经典的赋值重载方法更加复杂且容易出错）。所以你需要仔细研究TPersistent及其子对象，并正确地重写Assign和AssignTo方法（没有更简单的方法）。

- VitaliyG

Answer 2

亲爱的Alex，我和你遇到了同样的问题。经过一番思考，我写了下面的代码来解决我的问题。希望这段代码也能解决你或其他人的问题。

function TModel.Clone(pObj:TObject): TObject;
procedure WriteInField(pField:TRttiField; result, source:Pointer);
var
  Field:TRttiField;
  Val:TValue;
  Len: NativeInt;
  I :Integer;
  tp:TRttiType;
  ctx:TRttiContext;
begin
   if not pField.GetValue(source).IsEmpty then
     case pField.FieldType.TypeKind of
        TTypeKind.tkRecord:  
        begin
          for Field in pField.FieldType.GetFields do
             WriteInField(Field, PByte(result)+pField.Offset, pField.GetValue(source).GetReferenceToRawData);
        end;
        TTypeKind.tkClass:   
        begin
          Val:=Self.Clone(pField.GetValue(source).AsObject);
          if Assigned(TObject(pField.GetValue(result).AsObject)) then
            pField.GetValue(result).AsObject.Free;

          pField.SetValue(result,Val);
        end;
        TTypeKind.tkDynArray:
        begin
          Len := pField.GetValue(source).GetArrayLength;
          for I := 0 to Len -1 do
            case pField.GetValue(source).GetArrayElement(I).Kind of
              TTypeKind.tkRecord:
              begin
                tp:=ctx.GetType(pField.GetValue(source).GetArrayElement(I).TypeInfo);
                for Field in tp.GetFields do
                  WriteInField(Field,PByte(result)+Field.Offset, pField.GetValue(source).GetReferenceToRawData);

              end;
              TTypeKind.tkClass:
              begin
                Val:=Self.Clone(pField.GetValue(source).GetArrayElement(I).AsObject);
                DynArraySetLength(PPointer(PByte(result)+pField.Offset)^,pField.GetValue(source).TypeInfo,1,@Len);
                pField.GetValue(result).SetArrayElement(I,Val);
              end;
            else
              DynArraySetLength(PPointer(PByte(result)+pField.Offset)^,pField.GetValue(source).TypeInfo,1,@Len);
              pField.GetValue(result).SetArrayElement(I, pField.GetValue(source).GetArrayElement(I));
            end;

        end;
     else
        pField.SetValue(result,pField.GetValue(source));
     end;
end;
var
  Context: TRttiContext;
  IsComponent, LookOutForNameProp: Boolean;
  RttiType: TRttiType;
  Method: TRttiMethod;
  MinVisibility: TMemberVisibility;
  Params: TArray<TRttiParameter>;
  PropFild: TRttiField;
  Fild: TRttiField;
  SourceAsPointer, ResultAsPointer: Pointer;
  ObjWithData:TObject;
  Value:TValue;

begin
try
  if Assigned(pObj) then
    ObjWithData := pObj
  else
    ObjWithData := Self;
  RttiType := Context.GetType(ObjWithData.ClassType);
  //find a suitable constructor, though treat components specially
  IsComponent := (ObjWithData is TComponent);
  for Method in RttiType.GetMethods do
    if Method.IsConstructor then
    begin
      Params := Method.GetParameters;
      if Params = nil then Break;
      if (Length(Params) = 1) and IsComponent and
         (Params[0].ParamType is TRttiInstanceType) and
         SameText(Method.Name, 'Create') then Break;
    end;
  if Params = nil then
    Result := Method.Invoke(ObjWithData.ClassType, []).AsObject
  else
    Raise Exception.CreateFmt('Object Invalid to clone : ''%s''', [ObjWithData.ClassName]);
  try

    //loop through the props, copying values across for ones that are read/write
    Move(ObjWithData, SourceAsPointer, SizeOf(Pointer));
    Move(Result, ResultAsPointer, SizeOf(Pointer));
    for PropFild in RttiType.GetFields do
      WriteInField(PropFild,ResultAsPointer,SourceAsPointer);

  except
    Result.Free;
    raise;
  end;
finally
  ObjWithData := nil;
end;

end;

- Marcos Oliveira

---

我为“DyArraySetLength”调用修复了x64位兼容性。 - LU RD