RTTI: generische TObjectList erkennen

[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.