procedure Assign2(Source, Destination: TPersistent);

var

  PTI:PTypeInfo;

  List:TPropList;

  PList:PPropList;

  PrInfo:TPropInfo;

  i, Count :integer;

  vIn:variant;

  TpInfo:TTypeinfo;

begin

  if (Source is Destination.ClassType) then

  begin

    PTI:=Source.ClassInfo;

    PList:= @List;

    Count:=GetPropList(PTI,[ tkInteger, tkChar, tkEnumeration, tkFloat,

        tkString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkWString,

        tkVariant, tkArray, tkRecord, tkInterface, tkInt64, tkDynArray],

        PList);

    for i:= 0 to Count-1 do

    begin

      if  assigned(Plist[i]) then

      begin

        PrInfo:= Plist[i]^;

        vIn:=GetPropValue(Source,PrInfo.Name,False);

        TpInfo:=PrInfo.PropType^^;

        if (TpInfo.kind=tkClass)  then

        begin

          if (UpperCase(PrInfo.Name)<>'ITEMS') then

          begin

            if (GetPropInfo(Destination, PrInfo.Name)<>NIL) then

            begin

              SetObjectProp(Destination, PrInfo.Name, GetObjectProp(Source,PrInfo.Name));

            end;

          end;

        end

        else if (TpInfo.kind=tkMethod)  then

        begin

          if (GetPropInfo(Destination, PrInfo.Name)<>NIL) then

          begin

            SetMethodProp(Destination, PrInfo.Name, GetMethodProp(Source,PrInfo.Name));

          end;

        end

        else begin

          if (UpperCase(PrInfo.Name)<>'NAME') then

          begin

            if (GetPropInfo(Destination, PrInfo.Name)<>NIL) then

            begin

              SetPropValue(Destination, PrInfo.Name, vIn);

            end;

          end;

        end;

      end;

    end;

  end;

end;