delphimvcframework/sources/RTTIUtilsU.pas

unit RTTIUtilsU;

{ *******************************************************************************
  Copyright 2010-2013 Daniele Teti

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

  http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
  ******************************************************************************** }

interface

uses
  RTTI,
  DB,
  Generics.Collections,
  System.SysUtils;

type
  TRTTIUtils = class sealed
  public
    class var ctx: TRttiContext;
    class var TValueToStringFormatSettings: TFormatSettings;

  public
    class function MethodCall(AObject: TObject; AMethodName: string;
      AParameters: array of TValue; RaiseExceptionIfNotFound: boolean = true): TValue;
    class function GetMethod(AObject: TObject; AMethodName: string): TRttiMethod;
    class procedure SetProperty(Obj: TObject; const PropertyName: string;
      const Value: TValue); overload; static;
    class function GetFieldType(AProp: TRttiProperty): string;
    class function GetPropertyType(AObject: TObject; APropertyName: string): string;
    class procedure ObjectToDataSet(Obj: TObject; Field: TField;
      var Value: Variant);
    class function ExistsProperty(AObject: TObject; const APropertyName: string;
      out AProperty: TRttiProperty): boolean;
    class procedure DatasetToObject(Dataset: TDataset; Obj: TObject);
    class function GetProperty(Obj: TObject;
      const PropertyName: string): TValue;
    class function GetPropertyAsString(Obj: TObject;
      const PropertyName: string): string; overload;

    class function GetPropertyAsString(Obj: TObject; AProperty: TRttiProperty): string; overload;
    class function GetField(Obj: TObject; const PropertyName: string)
      : TValue; overload;
    class procedure SetField(Obj: TObject; const PropertyName: string;
      const Value: TValue); overload;
    class function Clone(Obj: TObject): TObject; static;
    class procedure CopyObject(SourceObj, TargetObj: TObject); static;
{$IF CompilerVersion >= 24.0} // not supported in xe3
    class procedure CopyObjectAS<T: class>(SourceObj, TargetObj: TObject); static;
{$IFEND}
    class function CreateObject(ARttiType: TRttiType): TObject; overload; static;
    class function CreateObject(AQualifiedClassName: string): TObject; overload; static;
    class function GetAttribute<T: TCustomAttribute>(const Obj: TRttiObject)
      : T; overload;
    class function GetAttribute<T: TCustomAttribute>(const Obj: TRttiType)
      : T; overload;

    class function HasAttribute<T: TCustomAttribute>
      (const Obj: TRttiObject): boolean; overload;
    class function HasAttribute<T: TCustomAttribute>
      (const Obj: TRttiObject; out AAttribute: T): boolean; overload;
    class function HasAttribute<T: class>(aObj: TObject; out AAttribute: T)
      : boolean; overload;
    class function HasAttribute<T: class>(ARTTIMember: TRttiMember; out AAttribute: T)
      : boolean; overload;
    class function HasAttribute<T: class>(ARTTIMember: TRttiType; out AAttribute: T)
      : boolean; overload;

    class function TValueAsString(const Value: TValue;
      const PropertyType, CustomFormat: string): string;
    class function EqualValues(source, destination: TValue): boolean;
    class function FindByProperty<T: class>(List: TObjectList<T>; PropertyName: string;
      PropertyValue: TValue): T;
    class procedure ForEachProperty(Clazz: TClass; Proc: TProc<TRttiProperty>);
    class function HasStringValueAttribute<T: class>(ARTTIMember: TRttiMember; out Value: string)
      : boolean;
    class function BuildClass(AQualifiedName: string; Params: array of TValue): TObject;
    class function FindType(QualifiedName: string): TRttiType;
    class function GetGUID<T>: TGUID;

  end;

function FieldFor(const PropertyName: string): string; inline;

implementation

uses
  Classes,
  TypInfo,
  ObjectsMappers,
  DuckListU;

class function TRTTIUtils.MethodCall(AObject: TObject; AMethodName: string;
  AParameters: array of TValue; RaiseExceptionIfNotFound: boolean): TValue;
var
  m: TRttiMethod;
  T: TRttiType;
  Found: boolean;
  ParLen: Integer;
  MethodParamsLen: Integer;
begin
  Found := False;
  T := ctx.GetType(AObject.ClassInfo);
  ParLen := Length(AParameters);
  m := nil;
  for m in T.GetMethods do
  begin
    MethodParamsLen := Length(m.GetParameters);
    if m.Name.Equals(AMethodName) and (MethodParamsLen = ParLen) then
    begin
      Found := true;
      Break;
    end;
  end;

  if Found then
    Result := m.Invoke(AObject, AParameters)
  else
    if RaiseExceptionIfNotFound then
    raise Exception.CreateFmt('Cannot find compatible method "%s" in the object',
      [AMethodName]);
end;

function FieldFor(const PropertyName: string): string; inline;
begin
  Result := 'F' + PropertyName;
end;

class function TRTTIUtils.GetAttribute<T>(const Obj: TRttiObject): T;
var
  Attr: TCustomAttribute;
begin
  Result := nil;
  for Attr in Obj.GetAttributes do
  begin
    if Attr.ClassType.InheritsFrom(T) then
      Exit(T(Attr));
  end;
end;

class function TRTTIUtils.GetAttribute<T>(const Obj: TRttiType): T;
var
  Attr: TCustomAttribute;
begin
  Result := nil;
  for Attr in Obj.GetAttributes do
  begin
    if Attr.ClassType.InheritsFrom(T) then
      Exit(T(Attr));
  end;
end;

class function TRTTIUtils.GetField(Obj: TObject;
  const PropertyName: string): TValue;
var
  Field: TRttiField;
  Prop: TRttiProperty;
  ARttiType: TRttiType;
begin
  ARttiType := ctx.GetType(Obj.ClassType);
  if not Assigned(ARttiType) then
    raise Exception.CreateFmt('Cannot get RTTI for type [%s]',
      [ARttiType.ToString]);
  Field := ARttiType.GetField(FieldFor(PropertyName));
  if Assigned(Field) then
    Result := Field.GetValue(Obj)
  else
  begin
    Prop := ARttiType.GetProperty(PropertyName);
    if not Assigned(Prop) then
      raise Exception.CreateFmt('Cannot get RTTI for property [%s.%s]',
        [ARttiType.ToString, PropertyName]);
    Result := Prop.GetValue(Obj);
  end;
end;

class function TRTTIUtils.GetProperty(Obj: TObject;
  const PropertyName: string): TValue;
var
  Prop: TRttiProperty;
  ARttiType: TRttiType;
begin
  ARttiType := ctx.GetType(Obj.ClassType);
  if not Assigned(ARttiType) then
    raise Exception.CreateFmt('Cannot get RTTI for type [%s]',
      [ARttiType.ToString]);
  Prop := ARttiType.GetProperty(PropertyName);
  if not Assigned(Prop) then
    raise Exception.CreateFmt('Cannot get RTTI for property [%s.%s]',
      [ARttiType.ToString, PropertyName]);
  if Prop.IsReadable then
    Result := Prop.GetValue(Obj)
  else
    raise Exception.CreateFmt('Property is not readable [%s.%s]',
      [ARttiType.ToString, PropertyName]);
end;

class function TRTTIUtils.GetPropertyAsString(Obj: TObject;
  AProperty: TRttiProperty): string;
var
  P: TValue;
  FT: string;
  CustomFormat: string;
begin
  if AProperty.IsReadable then
  begin
    P := AProperty.GetValue(Obj);
    FT := GetFieldType(AProperty);
    HasStringValueAttribute<StringValueAttribute>(AProperty, CustomFormat);
    Result := TValueAsString(P, FT, CustomFormat);
  end
  else
    Result := '';
end;

class function TRTTIUtils.GetPropertyAsString(Obj: TObject;
  const PropertyName: string): string;
var
  Prop: TRttiProperty;
begin
  Prop := ctx.GetType(Obj.ClassType).GetProperty(PropertyName);
  if Assigned(Prop) then
    Result := GetPropertyAsString(Obj, Prop)
  else
    Result := '';
end;

class function TRTTIUtils.GetPropertyType(AObject: TObject;
  APropertyName: string): string;
begin
  Result := GetFieldType(ctx.GetType(AObject.ClassInfo).GetProperty(APropertyName));
end;

class
  function TRTTIUtils.HasAttribute<T>(
  const
  Obj:
  TRttiObject): boolean;
begin
  Result := Assigned(GetAttribute<T>(Obj));
end;

class
  function TRTTIUtils.HasAttribute<T>(ARTTIMember: TRttiMember;
  out AAttribute: T): boolean;
var
  attrs: TArray<TCustomAttribute>;
  Attr: TCustomAttribute;
begin
  AAttribute := nil;
  Result := False;
  attrs := ARTTIMember.GetAttributes;
  for Attr in attrs do
    if Attr is T then
    begin
      AAttribute := T(Attr);
      Exit(true);
    end;
end;

class function TRTTIUtils.HasAttribute<T>(ARTTIMember: TRttiType;
  out AAttribute: T): boolean;
var
  attrs: TArray<TCustomAttribute>;
  Attr: TCustomAttribute;
begin
  AAttribute := nil;
  Result := False;
  attrs := ARTTIMember.GetAttributes;
  for Attr in attrs do
    if Attr is T then
    begin
      AAttribute := T(Attr);
      Exit(true);
    end;

end;

class function TRTTIUtils.HasAttribute<T>(const Obj: TRttiObject;
  out AAttribute: T): boolean;
begin
  AAttribute := GetAttribute<T>(Obj);
  Result := Assigned(AAttribute);
end;

class
  function TRTTIUtils.HasStringValueAttribute<T>(ARTTIMember: TRttiMember;
  out Value: string): boolean;
var
  Attr: T; // StringValueAttribute;
begin
  Result := HasAttribute<T>(ARTTIMember, Attr);
  if Result then
    Value := StringValueAttribute(Attr).Value
  else
    Value := '';
end;

class
  procedure TRTTIUtils.SetField(Obj: TObject;
  const
  PropertyName:
  string;
  const
  Value:
  TValue);
var
  Field: TRttiField;
  Prop: TRttiProperty;
  ARttiType: TRttiType;
begin
  ARttiType := ctx.GetType(Obj.ClassType);
  if not Assigned(ARttiType) then
    raise Exception.CreateFmt('Cannot get RTTI for type [%s]',
      [ARttiType.ToString]);
  Field := ARttiType.GetField(FieldFor(PropertyName));
  if Assigned(Field) then
    Field.SetValue(Obj, Value)
  else
  begin
    Prop := ARttiType.GetProperty(PropertyName);
    if Assigned(Prop) then
    begin
      if Prop.IsWritable then
        Prop.SetValue(Obj, Value)
    end
    else
      raise Exception.CreateFmt('Cannot get RTTI for field or property [%s.%s]',
        [ARttiType.ToString, PropertyName]);
  end;
end;

class
  procedure TRTTIUtils.SetProperty(Obj: TObject;
  const
  PropertyName:
  string;
  const
  Value:
  TValue);
var
  Prop: TRttiProperty;
  ARttiType: TRttiType;
begin
  ARttiType := ctx.GetType(Obj.ClassType);
  if not Assigned(ARttiType) then
    raise Exception.CreateFmt('Cannot get RTTI for type [%s]',
      [ARttiType.ToString]);
  Prop := ARttiType.GetProperty(PropertyName);
  if not Assigned(Prop) then
    raise Exception.CreateFmt('Cannot get RTTI for property [%s.%s]',
      [ARttiType.ToString, PropertyName]);
  if Prop.IsWritable then
    Prop.SetValue(Obj, Value)
  else
    raise Exception.CreateFmt('Property is not writeable [%s.%s]',
      [ARttiType.ToString, PropertyName]);
end;

class
  function TRTTIUtils.TValueAsString(
  const Value: TValue; const PropertyType, CustomFormat: string): string;
begin
  case Value.Kind of
    tkUnknown:
      Result := '';
    tkInteger:
      Result := IntToStr(Value.AsInteger);
    tkChar:
      Result := Value.AsString;
    tkEnumeration:
      if PropertyType = 'boolean' then
        Result := BoolToStr(Value.AsBoolean, true)
      else
        Result := '(enumeration)';
    tkFloat:
      begin
        if PropertyType = 'datetime' then
        begin
          if CustomFormat = '' then
            Exit(DateTimeToStr(Value.AsExtended))
          else
            Exit(FormatDateTime(CustomFormat, Value.AsExtended))
        end
        else if PropertyType = 'date' then
        begin
          if CustomFormat = '' then
            Exit(DateToStr(Value.AsExtended))
          else
            Exit(FormatDateTime(CustomFormat, Trunc(Value.AsExtended)))
        end
        else if PropertyType = 'time' then
        begin
          if CustomFormat = '' then
            Exit(TimeToStr(Value.AsExtended))
          else
            Exit(FormatDateTime(CustomFormat, Frac(Value.AsExtended)))
        end;
        if CustomFormat.IsEmpty then
          Result := FloatToStr(Value.AsExtended)
        else
          Result := FormatFloat(CustomFormat, Value.AsExtended);
      end;
    tkString:
      Result := Value.AsString;
    tkSet:
      ;
    tkClass:
      Result := Value.AsObject.QualifiedClassName;
    tkMethod:
      ;
    tkWChar:
      Result := Value.AsString;

    tkLString:
      Result := Value.AsString;

    tkWString:
      Result := Value.AsString;

    tkVariant:
      Result := string(Value.AsVariant);

    tkArray:
      Result := '(array)'
        ;
    tkRecord:
      Result := '(record)';
    tkInterface:
      Result := '(interface)';

    tkInt64:
      Result := IntToStr(Value.AsInt64);

    tkDynArray:
      Result := '(array)';

    tkUString:
      Result := Value.AsString;
    tkClassRef:
      Result := '(classref)';

    tkPointer:
      Result := '(pointer)';

    tkProcedure:
      Result := '(procedure)';
  end;
end;

class
  function TRTTIUtils.GetFieldType(AProp: TRttiProperty): string;
var
  _PropInfo: PTypeInfo;
begin
  _PropInfo := AProp.PropertyType.Handle;
  if _PropInfo.Kind in [tkString, tkWString, tkChar, tkWChar, tkLString,
    tkUString] then
    Result := 'string'
  else if _PropInfo.Kind in [tkInteger, tkInt64] then
    Result := 'integer'
  else if _PropInfo = TypeInfo(TDate) then
    Result := 'date'
  else if _PropInfo = TypeInfo(TDateTime) then
    Result := 'datetime'
  else if _PropInfo = TypeInfo(Currency) then
    Result := 'decimal'
  else if _PropInfo = TypeInfo(TTime) then
  begin
    Result := 'time'
  end
  else if _PropInfo.Kind = tkFloat then
  begin
    Result := 'float'
  end
  else if (_PropInfo.Kind = tkEnumeration) { and (_PropInfo.Name = 'Boolean') } then
    Result := 'boolean'
  else if AProp.PropertyType.IsInstance and
    AProp.PropertyType.AsInstance.MetaclassType.InheritsFrom(TStream) then
    Result := 'blob'
  else
    Result := EmptyStr;
end;

class function TRTTIUtils.GetGUID<T>: TGUID;
var
  Tp: TRttiType;
begin
  Tp := ctx.GetType(TypeInfo(T));
  if not(Tp.TypeKind = tkInterface) then
    raise Exception.Create('Type is no interface');
  Result := TRttiInterfaceType(Tp).GUID;
end;

class function TRTTIUtils.GetMethod(AObject: TObject;
  AMethodName: string): TRttiMethod;
var
  T: TRttiType;
begin
  T := ctx.GetType(AObject.ClassInfo);
  Result := T.GetMethod(AMethodName);
end;

class
  procedure TRTTIUtils.ObjectToDataSet(Obj: TObject;
  Field:
  TField;
  var
  Value: Variant);
begin
  Value := GetProperty(Obj, Field.FieldName).AsVariant;
end;

class
  procedure TRTTIUtils.DatasetToObject(Dataset: TDataset;
  Obj: TObject);
var
  ARttiType: TRttiType;
  props: TArray<TRttiProperty>;
  Prop: TRttiProperty;
  f: TField;
begin
  ARttiType := ctx.GetType(Obj.ClassType);
  props := ARttiType.GetProperties;
  for Prop in props do
    if not SameText(Prop.Name, 'ID') then
    begin
      f := Dataset.FindField(Prop.Name);
      if Assigned(f) and not f.ReadOnly then
      begin
        if f is TIntegerField then
          SetProperty(Obj, Prop.Name, TIntegerField(f).Value)
        else
          SetProperty(Obj, Prop.Name, TValue.From<Variant>(f.Value))
      end;
    end;
end;

class
  function TRTTIUtils.EqualValues(source, destination: TValue): boolean;
begin
  // Really UniCodeCompareStr (Annoying VCL Name for backwards compatablity)
  Result := AnsiCompareStr(source.ToString, destination.ToString) = 0;
end;

class function TRTTIUtils.ExistsProperty(AObject: TObject;
  const APropertyName: string; out AProperty: TRttiProperty): boolean;
begin
  AProperty := ctx.GetType(AObject.ClassInfo).GetProperty(APropertyName);
  Result := Assigned(AProperty);
end;

class
  function TRTTIUtils.FindByProperty<T>(List: TObjectList<T>;
  PropertyName: string;
  PropertyValue: TValue): T;
var
  elem: T;
  V: TValue;
  Found: boolean;
begin
  Found := False;
  for elem in List do
  begin
    V := GetProperty(elem, PropertyName);
    case V.Kind of
      tkInteger:
        Found := V.AsInteger = PropertyValue.AsInteger;
      tkFloat:
        Found := abs(V.AsExtended - PropertyValue.AsExtended) < 0.001;
      tkString, tkLString, tkWString, tkUString:
        Found := V.AsString = PropertyValue.AsString;
      tkInt64:
        Found := V.AsInt64 = PropertyValue.AsInt64;
    else
      raise Exception.Create('Property type not supported');
    end;
    if Found then
      Exit(elem);
  end;
  Result := nil;
end;

class function TRTTIUtils.FindType(QualifiedName: string): TRttiType;
begin
  Result := ctx.FindType(QualifiedName);
end;

class
  procedure TRTTIUtils.ForEachProperty(Clazz: TClass;
  Proc:
  TProc<TRttiProperty>);
var
  _rtti: TRttiType;
  P: TRttiProperty;
begin
  _rtti := ctx.GetType(Clazz);
  if Assigned(_rtti) then
  begin
    for P in _rtti.GetProperties do
      Proc(P);
  end;
end;

class
  procedure TRTTIUtils.CopyObject(SourceObj, TargetObj: TObject);
var
  _ARttiType: TRttiType;
  Field: TRttiField;
  master, cloned: TObject;
  Src: TObject;
  sourceStream: TStream;
  SavedPosition: Int64;
  targetStream: TStream;
  targetCollection: IWrappedList;
  sourceCollection: IWrappedList;
  I: Integer;
  sourceObject: TObject;
  targetObject: TObject;
  Tar: TObject;
begin
  if not Assigned(TargetObj) then
    Exit;

  _ARttiType := ctx.GetType(SourceObj.ClassType);
  cloned := TargetObj;
  master := SourceObj;
  for Field in _ARttiType.GetFields do
  begin
    if not Field.FieldType.IsInstance then
      Field.SetValue(cloned, Field.GetValue(master))
    else
    begin
      Src := Field.GetValue(SourceObj).AsObject;
      if Src is TStream then
      begin
        sourceStream := TStream(Src);
        SavedPosition := sourceStream.Position;
        sourceStream.Position := 0;
        if Field.GetValue(cloned).IsEmpty then
        begin
          targetStream := TMemoryStream.Create;
          Field.SetValue(cloned, targetStream);
        end
        else
          targetStream := Field.GetValue(cloned).AsObject as TStream;
        targetStream.Position := 0;
        targetStream.CopyFrom(sourceStream, sourceStream.Size);
        targetStream.Position := SavedPosition;
        sourceStream.Position := SavedPosition;
      end
      else if TDuckTypedList.CanBeWrappedAsList(Src) then
      begin
        sourceCollection := WrapAsList(Src);
        Tar := Field.GetValue(cloned).AsObject;
        if Assigned(Tar) then
        begin
          targetCollection := WrapAsList(Tar);
          targetCollection.Clear;
          for I := 0 to sourceCollection.Count - 1 do
            targetCollection.Add(TRTTIUtils.Clone(sourceCollection.GetItem(I)));
        end;
      end
      else
      begin
        sourceObject := Src;

        if Field.GetValue(cloned).IsEmpty then
        begin
          targetObject := TRTTIUtils.Clone(sourceObject);
          Field.SetValue(cloned, targetObject);
        end
        else
        begin
          targetObject := Field.GetValue(cloned).AsObject;
          TRTTIUtils.CopyObject(sourceObject, targetObject);
        end;
      end;
    end;
  end;
end;

{$IF CompilerVersion >= 24.0}


class procedure TRTTIUtils.CopyObjectAS<T>(SourceObj, TargetObj: TObject);
var
  _ARttiType: TRttiType;
  _ARttiTypeTarget: TRttiType;
  Field, FieldDest: TRttiField;
  master, cloned: TObject;
  Src: TObject;
  sourceStream: TStream;
  SavedPosition: Int64;
  targetStream: TStream;
  targetCollection: IWrappedList;
  sourceCollection: IWrappedList;
  I: Integer;
  sourceObject: TObject;
  targetObject: TObject;
  Tar: TObject;
begin
  if not Assigned(TargetObj) then
    Exit;

  _ARttiType := ctx.GetType(SourceObj.ClassType);
  _ARttiTypeTarget := ctx.GetType(T);

  cloned := TargetObj;
  master := SourceObj;
  for Field in _ARttiType.GetFields do
  begin
    FieldDest := _ARttiTypeTarget.GetField(Field.Name);
    if not Assigned(FieldDest) then
      continue;
    if not Field.FieldType.IsInstance then
    begin
      FieldDest.SetValue(cloned, Field.GetValue(master));
    end
    else
    begin
      Src := Field.GetValue(SourceObj).AsObject;
      if not Assigned(Src) then
      begin
        FieldDest.SetValue(cloned, Src);

      end
      else
        if Src is TStream then
      begin
        sourceStream := TStream(Src);
        SavedPosition := sourceStream.Position;
        sourceStream.Position := 0;
        if FieldDest.GetValue(cloned).IsEmpty then
        begin
          targetStream := TMemoryStream.Create;
          FieldDest.SetValue(cloned, targetStream);
        end
        else
          targetStream := FieldDest.GetValue(cloned).AsObject as TStream;
        targetStream.Position := 0;
        targetStream.CopyFrom(sourceStream, sourceStream.Size);
        targetStream.Position := SavedPosition;
        sourceStream.Position := SavedPosition;
      end
      else if TDuckTypedList.CanBeWrappedAsList(Src) then
      begin
        sourceCollection := WrapAsList(Src);
        Tar := FieldDest.GetValue(cloned).AsObject;
        if Assigned(Tar) then
        begin
          targetCollection := WrapAsList(Tar);
          targetCollection.Clear;
          for I := 0 to sourceCollection.Count - 1 do
            targetCollection.Add(TRTTIUtils.Clone(sourceCollection.GetItem(I)));
        end;
      end
      else
      begin
        sourceObject := Src;

        if FieldDest.GetValue(cloned).IsEmpty then
        begin
          targetObject := TRTTIUtils.Clone(sourceObject);
          FieldDest.SetValue(cloned, targetObject);
        end
        else
        begin
          targetObject := FieldDest.GetValue(cloned).AsObject;
          TRTTIUtils.CopyObject(sourceObject, targetObject);
        end;
      end;
    end;
  end;
end;
{$IFEND}


class
  function TRTTIUtils.CreateObject(AQualifiedClassName: string): TObject;
var
  rttitype: TRttiType;
begin
  rttitype := ctx.FindType(AQualifiedClassName);
  if Assigned(rttitype) then
    Result := CreateObject(rttitype)
  else
    raise Exception.Create('Cannot find RTTI for ' + AQualifiedClassName);
end;

class
  function TRTTIUtils.CreateObject(ARttiType: TRttiType): TObject;
var
  Method: TRttiMethod;
  metaClass: TClass;
begin
  { First solution, clear and slow }
  metaClass := nil;
  Method := nil;
  for Method in ARttiType.GetMethods do
    if Method.HasExtendedInfo and Method.IsConstructor then
      if Length(Method.GetParameters) = 0 then
      begin
        metaClass := ARttiType.AsInstance.MetaclassType;
        Break;
      end;
  if Assigned(metaClass) then
    Result := Method.Invoke(metaClass, []).AsObject
  else
    raise Exception.Create('Cannot find a propert constructor for ' +
      ARttiType.ToString);

  { Second solution, dirty and fast }
  // Result := TObject(ARttiType.GetMethod('Create')
  // .Invoke(ARttiType.AsInstance.MetaclassType, []).AsObject);
end;

class function TRTTIUtils.BuildClass(AQualifiedName: string;
  Params: array of TValue): TObject;
var
  T: TRttiType;
  V: TValue;
begin

  T := FindType(AQualifiedName);
  V := T.GetMethod('Create').Invoke(T.AsInstance.MetaclassType, Params);
  Result := V.AsObject;
end;

class
  function TRTTIUtils.Clone(Obj: TObject): TObject;
var
  _ARttiType: TRttiType;
  Field: TRttiField;
  master, cloned: TObject;
  Src: TObject;
  sourceStream: TStream;
  SavedPosition: Int64;
  targetStream: TStream;
  targetCollection: TObjectList<TObject>;
  sourceCollection: TObjectList<TObject>;
  I: Integer;
  sourceObject: TObject;
  targetObject: TObject;
begin
  Result := nil;
  if not Assigned(Obj) then
    Exit;

  _ARttiType := ctx.GetType(Obj.ClassType);
  cloned := CreateObject(_ARttiType);
  master := Obj;
  for Field in _ARttiType.GetFields do
  begin
    if not Field.FieldType.IsInstance then
      Field.SetValue(cloned, Field.GetValue(master))
    else
    begin
      Src := Field.GetValue(Obj).AsObject;
      if Src is TStream then
      begin
        sourceStream := TStream(Src);
        SavedPosition := sourceStream.Position;
        sourceStream.Position := 0;
        if Field.GetValue(cloned).IsEmpty then
        begin
          targetStream := TMemoryStream.Create;
          Field.SetValue(cloned, targetStream);
        end
        else
          targetStream := Field.GetValue(cloned).AsObject as TStream;
        targetStream.Position := 0;
        targetStream.CopyFrom(sourceStream, sourceStream.Size);
        targetStream.Position := SavedPosition;
        sourceStream.Position := SavedPosition;
      end
      else if Src is TObjectList<TObject> then
      begin
        sourceCollection := TObjectList<TObject>(Src);
        if Field.GetValue(cloned).IsEmpty then
        begin
          targetCollection := TObjectList<TObject>.Create;
          Field.SetValue(cloned, targetCollection);
        end
        else
          targetCollection := Field.GetValue(cloned)
            .AsObject as TObjectList<TObject>;
        for I := 0 to sourceCollection.Count - 1 do
        begin
          targetCollection.Add(TRTTIUtils.Clone(sourceCollection[I]));
        end;
      end
      else
      begin
        sourceObject := Src;

        if Field.GetValue(cloned).IsEmpty then
        begin
          targetObject := TRTTIUtils.Clone(sourceObject);
          Field.SetValue(cloned, targetObject);
        end
        else
        begin
          targetObject := Field.GetValue(cloned).AsObject;
          TRTTIUtils.CopyObject(sourceObject, targetObject);
        end;
        Field.SetValue(cloned, targetObject);
      end;
    end;

  end;
  Result := cloned;
end;

{ TListDuckTyping }

class function TRTTIUtils.HasAttribute<T>(aObj: TObject;
  out AAttribute: T): boolean;
begin
  Result := HasAttribute<T>(ctx.GetType(aObj.ClassType), AAttribute)
end;

end.