Object copying in delphi

Question

I have a complex object to deep copy (lots of arrays, objects, pointers, layers of layers of inheritance, hundreds of members of various types and more), and re-creating it through Delphi's Assign method is not productive and most likely too complex.

I have been looking at Rtti and it seems like a good option but so far I couldn't cover all possible scenarios. I don't want to waste so much time and hoping to find a good and simple example. Unfortunately, I could not find one yet. What I have been doing so far is, going through all the TRttiField in the object with a loop (TRttiType.GetFields()) and try to assign everything using pointers based on TTypeKind values. (tkPointer, tkClass, tkClassRef...)

I've found a JSON/Marshalling example but it couldn't deep copy my complex object; I got error;

Internal: Type tkPointer is not currently supported

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

Is there anything in Delphi close to C# binary serializing and creating a deep copy using a memory stream. Or is there a good and simple example you know of in Delphi doing deep copy with either RTTI or JSON/Marshalling that would work with the most complex objects?

Answer 1

In a few words you can't use rtti to simplify deep copy (it will be a way more complicated and error prone than using classic assign override)

So you need to look closer to TPersistent and its child objects and properly override Assign, AssignTo methods (there is no simpler way)

Answer 2

Alex I had the same problem as you, I broke his head a little and wrote the following code who answered my problem, hopefully also meet your or others.

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;