RTTI : Endlosschleifen beim rekursiven Auslesen eines Objects

[moelski]

Männers, ich bedanke euch

Und falls mal jemand etwas ähnliches vor hat. So könnte man es machen

Delphi-Quellcode:

unit RTTI_Browser;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls,

  Rtti, TypInfo, Contnrs,

  Chart, Series, TeEngine, TeeProcs, SiAuto;

type
  TForm_RTTI_Browser = class(TForm)
    Panel1: TPanel;
    Splitter1: TSplitter;
    TreeView1: TTreeView;
    Memo: TMemo;
    procedure TreeView1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
    procedure InspectObject(AObject : TObject );
    procedure ListObjects  (AObject : TObject ; ParentNode : TTreeNode);

    Function  ObjectInList(AObject : TObject) : Boolean;
  end;

var
  Form_RTTI_Browser : TForm_RTTI_Browser;
  ObjectsDone       : TObjectList;

implementation

{$R *.dfm}

procedure TForm_RTTI_Browser.FormCreate(Sender: TObject);
begin
  ObjectsDone := TObjectList.Create;
  ObjectsDone.OwnsObjects := False;
end;

procedure TForm_RTTI_Browser.FormDestroy(Sender: TObject);
begin
  ObjectsDone.Free;
end;

Function TForm_RTTI_Browser.ObjectInList(AObject : TObject) : Boolean;
var I: Integer;
begin
  Result := False;
  for I := 0 to ObjectsDone.Count - 1 do
    if ObjectsDone[I] = AObject then begin
      Result := True;
      Exit;
    end;
end;

procedure TForm_RTTI_Browser.ListObjects  (AObject : TObject ; ParentNode : TTreeNode);
var context   : TRttiContext;
    TypInfo   : TRttiType;
    field     : TRttiField;
    value     : TValue;
    Node, SubNode : TTreeNode;

  procedure ListInsideItems(BObject : TObject ; ParentNode : TTreeNode);
  var i : Integer;
  begin
    if BObject.InheritsFrom(TList) then
      for I := 0 to TList(BObject).Count - 1 do begin
        ListObjects(TList(BObject)[I], ParentNode);
      end;
  end;
begin
  if ObjectInList(AObject) then
    Exit;
  ObjectsDone.Add(AObject);

  context := TRttiContext.Create;
  TypInfo := context.GetType(AObject.ClassType);

  Node := TreeView1.Items.AddChild(ParentNode, TypInfo.ToString);
//  SiMain.LogVerbose('TypInfo : ' + TypInfo.ToString);
  Node.Data := AObject;

//  for field in TypInfo.GetDeclaredFields do begin
  for field in TypInfo.GetFields do begin
    value := field.GetValue(AObject);
//    SiMain.LogVerbose(field.ToString + ' ' + Value.ToString);
    // Rekursion für TObjectList
    if value.IsInstanceOf(TList) then begin
//      Simain.LogSeparator;
      SubNode := TreeView1.Items.AddChild(Node, value.ToString); // > TObjectList
//      SiMain.LogVerbose('SubNode ' + value.ToString);
      SubNode.Data := value.AsObject;

      ListInsideItems(value.AsObject, SubNode);

      SubNode.Expand(True);
    end;
  end;

  Node.Expand(True);
  context.Free;
end;

procedure TForm_RTTI_Browser.TreeView1Click(Sender: TObject);
var node : TTreeNode;
begin
  Node := TreeView1.Selected;
  if Node = NIL then Exit;
  if Node.Data = NIL then Exit;

  InspectObject(node.Data);
end;

procedure TForm_RTTI_Browser.InspectObject( AObject : TObject);
var context   : TRttiContext;
    TypInfo   : TRttiType;
    field     : TRttiField;
    methode   : TRttiMethod;
//    prop      : TRttiProperty;
    value     : TValue;
//    I, j      : Integer;
begin
  Memo.Clear;

  context := TRttiContext.Create;
  TypInfo := context.GetType(AObject.ClassType);

  Memo.Lines.Add(TypInfo.ToString + '  UNIT : ' + AObject.UnitName);
  Memo.Lines.Add('> FIELDS ');
//  for field in TypInfo.GetDeclaredFields do begin
  for field in TypInfo.GetFields do begin
    value := field.GetValue(AObject);
    Memo.Lines.Add(Format('%20s', [field.Name]) + ' = ' +
                   Format('%35s', [value.ToString]) + '  [Class: ' + value.TypeInfo.Name + ']');
  end;

//  if CheckBox1.Checked then begin
//    Memo.Lines.Add(#13#10 +'> METHODS ');
//  //  for methode in TypInfo.GetDeclaredMethods do begin
//    for methode in TypInfo.GetMethods do begin
//      memo.Lines.Add( methode.Name + ': ' + methode.ToString )
//    end;
//  end;

  context.Free;
end;

end.