Here ‘s a sample code of how you can dump the declaration of a TRttiType using the Rtti.
Supports classes, records and interfaces.
Delphi
//Author Rodrigo Ruz V. 2010-10-10 uses Rtti, TypInfo, Classes, Generics.Collections, SysUtils; function DumpTypeDefinition(ATypeInfo: Pointer;OnlyDeclarated:Boolean=False) : string; //add and format a field procedure AddField(List:TStrings;lField : TRttiField); begin if Assigned(lField.FieldType) then List.Add((Format(' %-20s:%s;',[lField.Name,lField.FieldType.Name]))) else List.Add((Format(' %-20s:%s;',[lField.Name,'Unknow']))); end; //add and format a method procedure AddMethod(List:TStrings;lMethod : TRttiMethod); begin List.Add((Format(' %s;',[lMethod.ToString]))); end; //add and format a Property procedure AddProperty(List:TStrings;lProperty : TRttiProperty); begin List.Add((Format(' %s;',[lProperty.ToString]))); end; const sType = 'type'; sIndent = ' '; ArrVisibility : Array[TMemberVisibility] of string = ('private','protected','public','published');//Helper array for Visibility var ctx : TRttiContext; lType : TRttiType; lMethod : TRttiMethod; lProperty : TRttiProperty; lField : TRttiField; Definition: TObjectDictionary<string, TStrings>; i : TMemberVisibility; begin Result:='No Rtti Information'; ctx := TRttiContext.Create; Definition:= TObjectDictionary<string, TStrings>.Create([doOwnsValues]); try if not Assigned(ATypeInfo) then exit; lType:=ctx.GetType(ATypeInfo); if not Assigned(lType) then exit; Definition.Add(sType,TStringList.Create); Definition.Items[sType].Add('type'); //Initialize the buffers to hold the data for i:=Low(TMemberVisibility) to High(TMemberVisibility) do begin Definition.Add(ArrVisibility[i] ,TStringList.Create); Definition.Items[ArrVisibility[i]].Add(sIndent+ArrVisibility[i]); end; case lType.TypeKind of tkUnknown : ; tkInteger : ; tkChar : ; tkEnumeration: ; tkFloat : ; tkString : ; tkSet : ; tkClass : begin //get the main definition if Assigned(lType.BaseType) then Definition.Items[sType].Add(Format('%s%s=class(%s)',[sIndent,lType.Name,lType.BaseType.Name])) else Definition.Items[sType].Add(Format('%s%s=class',[sIndent,lType.Name])); end; tkMethod : ; tkWChar : ; tkLString : ; tkWString : ; tkVariant : ; tkArray : ; tkRecord : begin //get the main definition Definition.Items[sType].Add(Format('%s%s=record',[sIndent,lType.Name])); end; tkInterface : begin //get the main definition if Assigned(lType.BaseType) then Definition.Items[sType].Add(Format('%s%s=Interface(%s)',[sIndent,lType.Name,lType.BaseType.Name])) else Definition.Items[sType].Add(Format('%s%s=Interface',[sIndent,lType.Name])); end; tkInt64 : ; tkDynArray : ; tkUString : ; tkClassRef : ; tkPointer : ; tkProcedure : ; end; //add the fields if OnlyDeclarated then for lField in lType.GetDeclaredFields do AddField(Definition.Items[ArrVisibility[lField.Visibility]],lField) else for lField in lType.GetFields do AddField(Definition.Items[ArrVisibility[lField.Visibility]],lField); //add the methods if OnlyDeclarated then for lMethod in lType.GetDeclaredMethods do AddMethod(Definition.Items[ArrVisibility[lMethod.Visibility]],lMethod) else for lMethod in lType.GetMethods do AddMethod(Definition.Items[ArrVisibility[lMethod.Visibility]],lMethod); //add the Properties if OnlyDeclarated then for lProperty in lType.GetDeclaredProperties do AddProperty(Definition.Items[ArrVisibility[lProperty.Visibility]],lProperty) else for lProperty in lType.GetProperties do AddProperty(Definition.Items[ArrVisibility[lProperty.Visibility]],lProperty); for i:=Low(TMemberVisibility) to High(TMemberVisibility) do if Definition.Items[ArrVisibility[i]].Count>1 then Definition.Items[sType].AddStrings(Definition.Items[ArrVisibility[i]]); Definition.Items[sType].Add(sIndent+'end;'); Result:=Definition.Items[sType].Text; finally Definition.free; ctx.free; end; end;
Use in this way
//to dump a Class DumpTypeDefinition(TypeInfo(TStringList)); //or DumpTypeDefinition(TStringList.ClassInfo);
OutPut
the output is this
type TStringList=class(TStrings) private FList : PStringItemList ; FCount :Integer; FCapacity :Integer; FSorted :Boolean; FDuplicates :TDuplicates; FCaseSensitive :Boolean; FOnChange :TNotifyEvent; FOnChanging :TNotifyEvent; FOwnsObject :Boolean; FEncoding :TEncoding; FDefined :TStringsDefined; FDefaultEncoding :TEncoding; FDelimiter :Char; FLineBreak :string; FQuoteChar :Char; FNameValueSeparator :Char; FStrictDelimiter :Boolean; FUpdateCount :Integer; FAdapter :IStringsAdapter; FWriteBOM :Boolean; public constructor Create; constructor Create(OwnsObjects: Boolean); class destructor Destroy; function Add(const S: string): Integer; function AddObject(const S: string; AObject: TObject): Integer; procedure Assign(Source: TPersistent); procedure Clear; procedure Delete(Index: Integer); procedure Exchange(Index1: Integer; Index2: Integer); function Find(const S: string; var Index: Integer): Boolean; function IndexOf(const S: string): Integer; procedure Insert(Index: Integer; const S: string); procedure InsertObject(Index: Integer; const S: string; AObject: TObject); procedure Sort; procedure CustomSort(Compare: TStringListSortCompare); constructor Create; class destructor Destroy; function Add(const S: string): Integer; function AddObject(const S: string; AObject: TObject): Integer; procedure Append(const S: string); procedure AddStrings(Strings: TStrings); procedure AddStrings(const Strings: TArray); procedure AddStrings(const Strings: TArray; const Objects: TAr ray); procedure Assign(Source: TPersistent); procedure BeginUpdate; procedure Clear; procedure Delete(Index: Integer); procedure EndUpdate; function Equals(Strings: TStrings): Boolean; procedure Exchange(Index1: Integer; Index2: Integer); function GetEnumerator: TStringsEnumerator; function GetText: PWideChar; function IndexOf(const S: string): Integer; function IndexOfName(const Name: string): Integer; function IndexOfObject(AObject: TObject): Integer; procedure Insert(Index: Integer; const S: string); procedure InsertObject(Index: Integer; const S: string; AObject: TObject); procedure LoadFromFile(const FileName: string); procedure LoadFromFile(const FileName: string; Encoding: TEncoding); procedure LoadFromStream(Stream: TStream); procedure LoadFromStream(Stream: TStream; Encoding: TEncoding); procedure Move(CurIndex: Integer; NewIndex: Integer); procedure SaveToFile(const FileName: string); procedure SaveToFile(const FileName: string; Encoding: TEncoding); procedure SaveToStream(Stream: TStream); procedure SaveToStream(Stream: TStream; Encoding: TEncoding); procedure SetText(Text: PWideChar); function ToStringArray: TArray; function ToObjectArray: TArray; class destructor Destroy; procedure Assign(Source: TPersistent); function GetNamePath: string; constructor Create; procedure Free; class function InitInstance(Instance: Pointer): TObject; procedure CleanupInstance; function ClassType: TClass; class function ClassName: string; class function ClassNameIs(const Name: string): Boolean; class function ClassParent: TClass; class function ClassInfo: Pointer; class function InstanceSize: Integer; class function InheritsFrom(AClass: TClass): Boolean; class function MethodAddress(const Name: ShortString): Pointer; class function MethodAddress(const Name: string): Pointer; class function MethodName(Address: Pointer): string; function FieldAddress(const Name: ShortString): Pointer; function FieldAddress(const Name: string): Pointer; function GetInterface(const IID: TGUID; out Obj): Boolean; class function GetInterfaceEntry(const IID: TGUID): PInterfaceEntry; class function GetInterfaceTable: PInterfaceTable; class function UnitName: string; function Equals(Obj: TObject): Boolean; function GetHashCode: Integer; function ToString: string; function SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HRESU LT; procedure AfterConstruction; procedure BeforeDestruction; procedure Dispatch(var Message); procedure DefaultHandler(var Message); class function NewInstance: TObject; procedure FreeInstance; class destructor Destroy; property Duplicates: TDuplicates; property Sorted: Boolean; property CaseSensitive: Boolean; property OnChange: TNotifyEvent; property OnChanging: TNotifyEvent; property OwnsObjects: Boolean; property Capacity: Integer; property CommaText: string; property Count: Integer; property DefaultEncoding: TEncoding; property Delimiter: Char; property DelimitedText: string; property Encoding: TEncoding; property LineBreak: string; property QuoteChar: Char; property NameValueSeparator: Char; property StrictDelimiter: Boolean; property Text: string; property StringsAdapter: IStringsAdapter; property WriteBOM: Boolean; end;
//to dump a Class with only the declarateds fields, methods and properties DumpTypeDefinition(TypeInfo(TStringList),True); //or DumpTypeDefinition(TStringList.ClassInfo,True);
the output
type TStringList=class(TStrings) private FList : PStringItemList; FCount :Integer; FCapacity :Integer; FSorted :Boolean; FDuplicates :TDuplicates; FCaseSensitive :Boolean; FOnChange :TNotifyEvent; FOnChanging :TNotifyEvent; FOwnsObject :Boolean; public constructor Create; constructor Create(OwnsObjects: Boolean); class destructor Destroy; function Add(const S: string): Integer; function AddObject(const S: string; AObject: TObject): Integer; procedure Assign(Source: TPersistent); procedure Clear; procedure Delete(Index: Integer); procedure Exchange(Index1: Integer; Index2: Integer); function Find(const S: string; var Index: Integer): Boolean; function IndexOf(const S: string): Integer; procedure Insert(Index: Integer; const S: string); procedure InsertObject(Index: Integer; const S: string; AObject: TObject); procedure Sort; procedure CustomSort(Compare: TStringListSortCompare); property Duplicates: TDuplicates; property Sorted: Boolean; property CaseSensitive: Boolean; property OnChange: TNotifyEvent; property OnChanging: TNotifyEvent; property OwnsObjects: Boolean; end;
//to dump a record DumpTypeDefinition(TypeInfo(TSysLocale));
the output look like this
type TSysLocale=record public DefaultLCID :Integer; PriLangID :Integer; SubLangID :Integer; FarEast :Boolean; MiddleEast :Boolean; end;
//finally to dump an interface DumpTypeDefinition(TypeInfo(IInterfaceList));
October 11, 2010 at 5:02 am
Seems like the foundation for a reverse engineering tool :)
August 13, 2013 at 8:38 am
big thanx!
October 4, 2014 at 9:42 am
It would be nice if the DumpTypeDefinition could be done for all possible types, and recursively scanned records en classes
April 14, 2015 at 2:11 pm
Recursive dump would be awesome.