RTTI: generische TObjectList erkennen

[DeddyH]

Ich erstelle mir gerade einen eigenen JSON-Serializer. Dieser verwendet ein Attribut für die Properties einer Klasse, um diese in ein JSON-Objekt zu parsen und vice versa. Das funktioniert auch schon ziemlich gut, aber nur dann, wenn Listen als Array-Properties veröffentlicht sind. Nun suche ich eine Möglichkeit, per RTTI eine TObjectList<T> zu erkennen und zu durchlaufen. Ich habe ein wenig in REST.JsonReflect gespickt, da wird soweit ich das verstanden habe auf die Felder zugegriffen, der TListHelper gesucht und bei Fund benutzt. Bei meinen eigenen Versuchen, das auch so zu machen (Property -> Liste -> ListHelper) bin ich allerdings kläglich gescheitert, es werden lediglich 2 Felder gefunden, der ListHelper ist nicht dabei. Hat jemand einen Tipp für mich, oder ist mein Ansatz gleich zum Scheitern verurteilt?

Danke fürs Lesen.

[TiGü]

Ohne konkreten Quelltext ist das immer schwer zu beurteilen, aber hast du dir den Rtti-Quelltext aus REST.JsonReflect zum Studium in ein Konsolenprogramm kopiert?

Delphi-Quellcode:

program Project6;

{$APPTYPE CONSOLE}

{$R *.res}


uses
    System.SysUtils,
    System.Generics.Collections,
    System.Rtti;

type
    TMyObject = class(TObject)
    private
        FDateTime: string;
    public
        constructor Create;
    end;

    TMyContainer = class
    private
        FList: TObjectList<TMyObject>;
    public
        constructor Create;
        property List: TObjectList<TMyObject> read FList;
    end;

constructor TMyObject.Create;
begin
    inherited;
    FDateTime := FormatDateTime('YYYY-MM-DD', System.SysUtils.Now);
end;

type
    PListHelperCrack = ^TListHelperCrack;

    TListHelperCrack = record
    private
        FItems: Pointer;
        FCount: Integer;
        FTypeInfo: Pointer;
        [unsafe]
        FListObj: TObject;
    end;

function GetArrayValueFromTListHelperValue(const ACtx: TRttiContext;
    const AListHelperValue: TValue; out ACount: Integer): TValue;
var
    LpListHelper: PListHelperCrack;
begin
    if (AListHelperValue.TypeInfo <> TypeInfo(System.Generics.Collections.TListHelper)) or
        AListHelperValue.IsEmpty then
        raise EInvalidCast.Create('Error');
    LpListHelper := AListHelperValue.GetReferenceToRawData;
    TValue.Make(@LpListHelper^.FItems, LpListHelper^.FTypeInfo, Result);
    ACount := LpListHelper^.FCount;
end;

var
    MyContainer: TMyContainer;
    Data: TObject;
    FRTTICtx: TRttiContext;
    rttiType, rttiType2: TRttiType;
    rttiField: TRttiField;
    Value: TValue;
    valArr, SingleArrayValue: TValue;
    I, Len: Integer;

    { TMyContainer }

constructor TMyContainer.Create;
begin
    FList := TObjectList<TMyObject>.Create;
end;

begin
    try
        MyContainer := TMyContainer.Create;
        MyContainer.List.Add(TMyObject.Create);
        MyContainer.List.Add(TMyObject.Create);
        MyContainer.List.Add(TMyObject.Create);

        Data := MyContainer.List;

        FRTTICtx := TRttiContext.Create;
        rttiType := FRTTICtx.GetType(Data.ClassType);
        for rttiField in rttiType.GetFields do
        begin
            Writeln('I found this Field: ', rttiField.Name);
            if rttiField.Name = 'FListHelper' then
            begin
                Writeln('    That''s the right one: ', rttiField.Name);
                case rttiField.FieldType.TypeKind of
                    TTypeKind.tkRecord, TTypeKind.tkMRecord:
                    begin
                        Writeln('        ' + rttiField.Name, ' is a record!');
                        Value := rttiField.GetValue(Data);
                        case Value.Kind of
                            TTypeKind.tkRecord, TTypeKind.tkMRecord:
                            begin
                                rttiType2 := FRTTICtx.GetType(Value.typeInfo);
                                // Marshal TList<T>.FListHelper as dynamic array using 10.3 layout
                                if rttiType2.Handle = TypeInfo(System.Generics.Collections.TListHelper) then
                                begin
                                    valArr := GetArrayValueFromTListHelperValue(FRTTICtx, Value, Len);
                                    for I := 0 to Len - 1 do
                                    begin
                                        SingleArrayValue := valArr.GetArrayElement(I);
                                        case SingleArrayValue.Kind of
                                        tkClass:
                                        begin
                                        Writeln('               Found single object: ', I, ' ', SingleArrayValue.AsObject.ClassName);
                                        end;
                                        end;
                                    end;
                                end;
                            end
                        end;
                    end;
                end;
            end;
        end;
    except
        on E: Exception do
            Writeln(E.ClassName, ': ', E.Message);
    end;
    Readln;

end.

[DeddyH]

Danke für die Mühe. Zumindest unter Alexandria wird die Bedingung

Zitat:

if rttiField.Name = 'FListHelper' then

niemals wahr, ich komme also nicht an den Helper. Ich werde es aber nochmal unter einer älteren Version versuchen.

[edit] Gerade unter 10.4 versucht, da funktioniert es. Super, wieder etwas kaputt verbessert, ich bin immer wieder begeistert von Delphi. [/edit]

[TiGü]

Ach guck an, wie ist denn TList<T> in Delphi 11 definiert?

In 10.4 geht's so los:

Delphi-Quellcode:

  TList<T> = class(TEnumerable<T>)
  public type
    arrayofT = array of T;
    ParrayofT = ^arrayofT;
  private var
    FListHelper: TListHelper;
    FComparer: IComparer<T>;
    FOnNotify: TCollectionNotifyEvent<T>;
...

[DeddyH]

In Alexandria ist FListHelper kein Feld mehr, sondern eine Funktion.

[Uwe Raabe]

FListHelper war und ist nicht einfach ohne Absicht private. Die Implementierung einer TList<T> hat von Außen einfach nicht zu interessieren. Wenn die Implementierung seitens Embarcadero geändert wird, müssen die natürlich dafür sorgen, dass ihre eigenen Funktionalitäten erhalten bleiben (z.B. JSON serialisieren), aber sie müssen nicht garantieren, dass als private Gekennzeichnetes unverändert bleibt.

[TiGü]

Ach Herrje! Was fummeln die denn da immer dran rum?
Jede Version ist da anders.
Und ob die Änderungen überhaupt einen Vorteil haben, sei mal dahingestellt.

In 10.2.3 sah die Welt noch so aus:

Delphi-Quellcode:

  TList<T> = class(TEnumerable<T>)
  private type
    arrayofT = array of T;
  var
    FListHelper: TListHelper; // FListHelper must always be followed by FItems
    FItems: arrayofT; // FItems must always be preceded by FListHelper
    FComparer: IComparer<T>;
    FOnNotify: TCollectionNotifyEvent<T>;
...

[Stevie]

Die haben daran rumgefummelt, damit man eine TList<T> wieder im Debugger vernünftig inspekten kann und die darin enthaltenen Elemente sehen kann, you're welcome.

[Uwe Raabe]

Ja, das ändert sich nicht zum ersten Mal und eigentlich immer nur weil es entsprechende Beschwerden gab, wie Stefan schon anmerkte.

Allein schon die Kommentare in REST.JsonReflect.pas sprechen für sich:

Zitat:

// Marshal TList<T>.FListHelper as dynamic array using 10.3 layout
...
// Marshal TList<T>.FListHelper as dynamic array using 10.2 layout
...
// Unmarshal TList<T>.FListHelper as dynamic array using 10.3 layout
...
// Unmarshal TList<T>.FListHelper as dynamic array using 10.2 layout

Auch die neue Klasse TListTFieldsEditor um das Ganze irgendwie unter Kontrolle zu halten spricht Bände.

[TiGü]

Ich erinnere mich dunkel, dass in XE8 das auch nicht zu debuggen/inspekten war, oder?

Ich vermag das nicht zu beurteilen, aber bringt das denn überhaupt irgendwelche Vorteile in Sachen Performance oder Speicher(layout)-Dingenskirchen da ständig Hand anzulegen, anstatt einfach ein dynamisches Array (arrayOfT/TArray<T>) als Feld in TList<T> zu hinterlegen?

Egal, kurz über Uwes ersten Post nachgedacht und (wie immer) voller Wahrheit und Sinn befunden.
Private ist private! Also müssen wir uns über die Properties behelfen.
Habe nur 10.4 hier, aber wenn die property List: arrayofT read GetList immer noch da ist, dann müsste das auch in Delphi 11 klappen.

Delphi-Quellcode:

program Project6;

{$APPTYPE CONSOLE}

{$R *.res}


uses
    System.SysUtils,
    System.Generics.Collections,
    System.Rtti;

type
    TMyObject = class(TObject)
    private
        FDateTime: string;
    public
        constructor Create;
    end;

    TMyContainer = class
    private
        FList: TObjectList<TMyObject>;
    public
        constructor Create;
        property List: TObjectList<TMyObject> read FList;
    end;

constructor TMyObject.Create;
begin
    inherited;
    FDateTime := FormatDateTime('YYYY-MM-DD', System.SysUtils.Now);
end;

var
    MyContainer: TMyContainer;
    Data, ArrayObject: TObject;
    FRTTICtx: TRttiContext;
    rttiType: TRttiType;
    rttiProperty: TRttiProperty;
    Value: TValue;
    SingleArrayValue: TValue;
    I, Len: Integer;

    { TMyContainer }

constructor TMyContainer.Create;
begin
    FList := TObjectList<TMyObject>.Create;
end;

begin
    try
        MyContainer := TMyContainer.Create;
        MyContainer.List.Add(TMyObject.Create);
        MyContainer.List.Add(TMyObject.Create);
        MyContainer.List.Add(TMyObject.Create);

        Data := MyContainer.List;

        FRTTICtx := TRttiContext.Create;
        rttiType := FRTTICtx.GetType(Data.ClassType);
        for rttiProperty in rttiType.GetProperties do
        begin

            Writeln('I found this Property: ', rttiProperty.Name);
            if rttiProperty.Name = 'List' then
            begin
                Writeln('..That''s the right one: ', rttiProperty.Name);
                case rttiProperty.PropertyType.TypeKind of
                    TTypeKind.tkDynArray:
                    begin
                        Writeln('....' + rttiProperty.Name, ' is a TTypeKind.tkDynArray!');
                        Value := rttiProperty.GetValue(Data);
                        case Value.Kind of
                            TTypeKind.tkDynArray:
                            begin
                                Len := Value.GetArrayLength;
                                for I := 0 to Len - 1 do
                                begin
                                    SingleArrayValue := Value.GetArrayElement(I);
                                    case SingleArrayValue.Kind of
                                        tkClass:
                                        begin
                                            ArrayObject := SingleArrayValue.AsObject;
                                            // Len ist 3 => vier Elemente (?), so dass beim Zugriff auf das letzte
                                            // Element nil rauskommt! Daher abfangen oder bessere Lösung suchen!
                                            if Assigned(ArrayObject) then
                                            begin
                                                Writeln('.......Found single object: ', I, ' ', ArrayObject.ClassName);
                                            end;
                                        end;
                                    end;
                                end;

                            end
                        end;
                    end;
                end;
            end;
        end;
    except
        on E: Exception do
            Writeln(E.ClassName, ': ', E.Message);
    end;
    Readln;

end.