Зачастую надо записать в поток экземпляры наследников классов TPersistent и/или TCollection. К сожалению, прямого пути выполнить это нет, но это легко сделать:

unit ClassIo;

interface

uses Classes;

procedure WritePersistent(S: TStream; Instance: TPersistent);
procedure ReadPersistent(S: TStream; Instance: TPersistent);

procedure WriteCollection(S: TStream; Instance: TCollection);
procedure ReadCollection(S: TStream; Instance: TCollection);

type
  TWriterEx = class(TWriter)
  public
    procedure WriteCollectionEx(Instance: TCollection);
    procedure WritePersistent(Instance: TPersistent);
  end;

  TReaderEx = class(TReader)
  public
    procedure ReadCollectionEx(Instance: TCollection);
    procedure ReadPersistent(Instance: TPersistent);
  end;



implementation

{$IFDEF DUNIT_TESTING}
  uses TestFramework;
{$ENDIF}



{ TWriterEx }

procedure TWriterEx.WriteCollectionEx(Instance: TCollection);
begin
  WriteCollection(Instance);
end;

procedure TWriterEx.WritePersistent(Instance: TPersistent);
begin
  WriteProperties(Instance);
  WriteListEnd;
end;



{ TReaderEx }

procedure TReaderEx.ReadCollectionEx(Instance: TCollection);
var
  Value: TValueType;
begin
  Value := ReadValue;
  if Value <> vaCollection then
    raise EStreamError.Create('vaCollection excepted');
  ReadCollection(Instance);
end;

procedure TReaderEx.ReadPersistent(Instance: TPersistent);
begin
  while not EndOfList do ReadProperty(Instance);
  ReadListEnd;
end;



{ Interface functions }

procedure WriteCollection(S: TStream; Instance: TCollection);
var
  Writer: TWriterEx;
begin
  Writer := TWriterEx.Create(S, 4096);
  try
    Writer.WriteCollectionEx(Instance);
  finally
    Writer.Free;
  end;
end;

procedure ReadCollection(S: TStream; Instance: TCollection);
var
  Reader: TReaderEx;
begin
  Reader := TReaderEx.Create(S, 4096);
  try
    Reader.ReadCollectionEx(Instance);
  finally
    Reader.Free;
  end;
end;

procedure WritePersistent(S: TStream; Instance: TPersistent);
var
  Writer: TWriterEx;
begin
  Writer := TWriterEx.Create(S, 4096);
  try
    Writer.WritePersistent(Instance);
  finally
    Writer.Free;
  end;
end;

procedure ReadPersistent(S: TStream; Instance: TPersistent);
var
  Reader: TReaderEx;
begin
  Reader := TReaderEx.Create(S, 4096);
  try
    Reader.ReadPersistent(Instance);
  finally
    Reader.Free;
  end;
end;



(************
  ** TESTS
************)

{$IFDEF DUNIT_TESTING}

type
  TTestCollection = class;
  TTestCollectionItem = class;

  TClassIoTests = class(TTestCase)
  published
    procedure ReadWriteCollection;
    procedure ReadWritePersistent;
  end;

  TTestCollection = class(TCollection)
  private
    function GetItem(Index: Integer): TTestCollectionItem;
    procedure SetItem(Index: Integer; Value: TTestCollectionItem);
  public
    constructor Create;
    function Add: TTestCollectionItem;
    property Items[Index: Integer]: TTestCollectionItem read GetItem write SetItem; default; 
  end;

  TTestCollectionItem = class(TCollectionItem)
  private
    FTestInt: Integer;
    FTestStr: string;
    FTestLines: TStringList;
    function GetTestLines: TStrings;
    procedure SetTestLines(const Value: TStrings);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
  published
    property TestInt: Integer read FTestInt write FTestInt;
    property TestStr: string read FTestStr write FTestStr;
    property TestLines: TStrings read GetTestLines write SetTestLines;
  end;

  TTestPersistent = class(TPersistent)
  private
    FTestInt: Integer;
    FTestStr: string;
    FTestLines: TStringList;
    function GetTestLines: TStrings;
    procedure SetTestLines(const Value: TStrings);
  public
    constructor Create;
    destructor Destroy; override;
  published
    property TestInt: Integer read FTestInt write FTestInt;
    property TestStr: string read FTestStr write FTestStr;
    property TestLines: TStrings read GetTestLines write SetTestLines;
  end;



{ TClassIoTests }

procedure TClassIoTests.ReadWriteCollection;
var
  A, B: TTestCollection;
  S: TMemoryStream;
  SavedPosition: Integer;
  I, J: Integer;
const
  TestBuf: array [0..9] of Char = 'TestBufXXX';
begin
  A := nil;
  B := nil;
  S := nil;
  try

    // 1. Create collection object
    A := TTestCollection.Create;
    with A.Add do
    begin
      TestInt := 1;
      TestStr := 'TestStr1';
      TestLines.Add('Line1');
      TestLines.Add('Line2');
      TestLines.Add('Line3');
    end;
    with A.Add do
    begin
      TestInt := 2;
      TestStr := 'TestStr2';
      TestLines.Add('Line4');
      TestLines.Add('Line5');
    end;

    // 2. Write and read coolection
    S := TMemoryStream.Create;
    WriteCollection(S, A);
    SavedPosition := S.Position;
    S.Write(TestBuf, SizeOf(TestBuf));
    S.Position := 0;
    B := TTestCollection.Create;
    ReadCollection(S, B);

    // 3. Check instance
    CheckEquals(S.Position, SavedPosition);
    CheckEquals(A.Count, B.Count);
    for I := 0 to A.Count-1 do
    begin
      CheckEquals(A[I].TestInt, B[I].TestInt);
      CheckEquals(A[I].TestStr, B[I].TestStr);
      CheckEquals(A[I].TestLines.Count, B[I].TestLines.Count);
      for J := 0 to A[I].TestLines.Count-1 do
        CheckEquals(A[I].TestLines[J], B[I].TestLines[J]);
    end;

  finally
    A.Free;
    B.Free;
    S.Free;
  end;
end;

procedure TClassIoTests.ReadWritePersistent;
var
  A, B: TTestPersistent;
  S: TMemoryStream;
  SavedPosition: Integer;
  I: Integer;
const
  TestBuf: array [0..9] of Char = 'TestBufXXX';
begin
  A := nil;
  B := nil;
  try
    // 1. Create persistent object
    A := TTestPersistent.Create;
    A.TestInt := 45;
    A.TestStr := 'Test1';
    A.TestLines.Add('Line1');
    A.TestLines.Add('Line2');
    A.TestLines.Add('Line3');

    // 2. Write and read object
    S := TMemoryStream.Create;
    WritePersistent(S, A);
    SavedPosition := S.Position;
    S.Write(TestBuf, SizeOf(TestBuf));
    S.Position := 0;
    B := TTestPersistent.Create;
    ReadPersistent(S, B);

    // 3. Check instance
    CheckEquals(S.Position, SavedPosition);
    CheckEquals(A.TestInt, B.TestInt);
    CheckEquals(A.TestStr, B.TestStr);
    CheckEquals(A.TestLines.Count, B.TestLines.Count);
    for I := 0 to A.TestLines.Count-1 do
      CheckEquals(A.TestLines[I], B.TestLines[I]);

  finally
    A.Free;
    B.Free;
  end;
end;



{ TTestCollection }

constructor TTestCollection.Create;
begin
  inherited Create(TTestCollectionItem);
end;

function TTestCollection.Add: TTestCollectionItem;
begin
  Result := inherited Add as TTestCollectionItem;
end;

function TTestCollection.GetItem(Index: Integer): TTestCollectionItem;
begin
  Result := inherited Items[Index] as TTestCollectionItem;
end;

procedure TTestCollection.SetItem(Index: Integer;
  Value: TTestCollectionItem);
begin
  inherited SetItem(Index, Value);
end;



{ TTestCollectionItem }

constructor TTestCollectionItem.Create(Collection: TCollection);
begin
  inherited;
  FTestLines := TStringList.Create;
end;

destructor TTestCollectionItem.Destroy;
begin
  FTestLines.Free;
  inherited;
end;

function TTestCollectionItem.GetTestLines: TStrings;
begin
  Result := FTestLines;
end;

procedure TTestCollectionItem.SetTestLines(const Value: TStrings);
begin
  FTestLines.Assign(Value);
end;



{ TTestPersistent }

constructor TTestPersistent.Create;
begin
  inherited;
  FTestLines := TStringList.Create;
end;

destructor TTestPersistent.Destroy;
begin
  FTestLines.Free;
  inherited;
end;

function TTestPersistent.GetTestLines: TStrings;
begin
  Result := FTestLines;
end;

procedure TTestPersistent.SetTestLines(const Value: TStrings);
begin
  FTestLines.Assign(Value);
end;



initialization
  RegisterTest(TClassIoTests.Suite);
{$ENDIF}


end.