unit uStreamableExample;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Contnrs;

type
TStreamableObject = class(TPersistent)
protected
function ReadString(Stream: TStream): string;
function ReadLongInt(Stream: TStream): LongInt;
function ReadDateTime(Stream: TStream): TDateTime;
function ReadCurrency(Stream: TStream): Currency;
function ReadClassName(Stream: TStream): ShortString;
procedure WriteString(Stream: TStream; const Value: string);
procedure WriteLongInt(Stream: TStream; const Value: LongInt);
procedure WriteDateTime(Stream: TStream; const Value: TDateTime);
procedure WriteCurrency(Stream: TStream; const Value: Currency);
procedure WriteClassName(Stream: TStream; const Value: ShortString);
public
constructor CreateFromStream(Stream: TStream);
procedure LoadFromStream(Stream: TStream); virtual; abstract;
procedure SaveToStream(Stream: TStream); virtual; abstract;
end;

TStreamableObjectClass = class of TStreamableObject;

TPerson = class(TStreamableObject)
private
FName: string;
FBirthDate: TDateTime;
public
constructor Create(const AName: string; ABirthDate: TDateTime);
procedure LoadFromStream(Stream: TStream); override;
procedure SaveToStream(Stream: TStream); override;
property Name: string read FName write FName;
property BirthDate: TDateTime read FBirthDate write FBirthDate;
end;

TCompany = class(TStreamableObject)
private
FName: string;
FRevenues: Currency;
FEmployeeCount: LongInt;
public
constructor Create(const AName: string; ARevenues: Currency; AEmployeeCount:
LongInt);
procedure LoadFromStream(Stream: TStream); override;
procedure SaveToStream(Stream: TStream); override;
property Name: string read FName write FName;
property Revenues: Currency read FRevenues write FRevenues;
property EmployeeCount: LongInt read FEmployeeCount write FEmployeeCount;
end;

TStreamableList = class(TStreamableObject)
private
FItems: TObjectList;
function Get_Count: LongInt;
function Get_Objects(Index: LongInt): TStreamableObject;
public
constructor Create;
destructor Destroy; override;
function FindClass(const AClassName: string): TStreamableObjectClass;
procedure Add(Item: TStreamableObject);
procedure Delete(Index: LongInt);
procedure Clear;
procedure LoadFromStream(Stream: TStream); override;
procedure SaveToStream(Stream: TStream); override;
property Objects[Index: LongInt]: TStreamableObject read Get_Objects;
default;
property Count: LongInt read Get_Count;
end;

TForm1 = class(TForm)
SaveButton: TButton;
LoadButton: TButton;
procedure SaveButtonClick(Sender: TObject);
procedure LoadButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
Path: string;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

resourcestring
DEFAULT_FILENAME = 'test.dat';

procedure TForm1.SaveButtonClick(Sender: TObject);
var
List: TStreamableList;
Stream: TStream;
begin
List := TStreamableList.Create;
try
List.Add(TPerson.Create('Rick Rogers', StrToDate('05/20/68')));
List.Add(TCompany.Create('Fenestra', 1000000, 7));
Stream := TFileStream.Create(Path + DEFAULT_FILENAME, fmCreate);
try
List.SaveToStream(Stream);
finally
Stream.Free;
end;
finally
List.Free;
end;
end;

{ TPerson }

constructor TPerson.Create(const AName: string; ABirthDate: TDateTime);
begin
inherited Create;
FName := AName;
FBirthDate := ABirthDate;
end;

procedure TPerson.LoadFromStream(Stream: TStream);
begin
FName := ReadString(Stream);
FBirthDate := ReadDateTime(Stream);
end;

procedure TPerson.SaveToStream(Stream: TStream);
begin
WriteString(Stream, FName);
WriteDateTime(Stream, FBirthDate);
end;

{ TStreamableList }

procedure TStreamableList.Add(Item: TStreamableObject);
begin
FItems.Add(Item);
end;

procedure TStreamableList.Clear;
begin
FItems.Clear;
end;

constructor TStreamableList.Create;
begin
FItems := TObjectList.Create;
end;

procedure TStreamableList.Delete(Index: LongInt);
begin
FItems.Delete(Index);
end;

destructor TStreamableList.Destroy;
begin
FItems.Free;
inherited;
end;

function TStreamableList.FindClass(const AClassName: string):
TStreamableObjectClass;
begin
Result := TStreamableObjectClass(Classes.FindClass(AClassName));
end;

function TStreamableList.Get_Count: LongInt;
begin
Result := FItems.Count;
end;

function TStreamableList.Get_Objects(Index: LongInt): TStreamableObject;
begin
Result := FItems[Index] as TStreamableObject;
end;

procedure TStreamableList.LoadFromStream(Stream: TStream);
var
StreamCount: LongInt;
I: Integer;
S: string;
ClassRef: TStreamableObjectClass;
begin
StreamCount := ReadLongInt(Stream);
for I := 0 to StreamCount - 1 do
begin
S := ReadClassName(Stream);
ClassRef := FindClass(S);
Add(ClassRef.CreateFromStream(Stream));
end;
end;

procedure TStreamableList.SaveToStream(Stream: TStream);
var
I: Integer;
begin
WriteLongInt(Stream, Count);
for I := 0 to Count - 1 do
begin
WriteClassName(Stream, Objects[I].ClassName);
Objects[I].SaveToStream(Stream);
end;
end;

{ TStreamableObject }

constructor TStreamableObject.CreateFromStream(Stream: TStream);
begin
inherited Create;
LoadFromStream(Stream);
end;

function TStreamableObject.ReadClassName(Stream: TStream): ShortString;
begin
Result := ReadString(Stream);
end;

function TStreamableObject.ReadCurrency(Stream: TStream): Currency;
begin
Stream.Read(Result, SizeOf(Currency));
end;

function TStreamableObject.ReadDateTime(Stream: TStream): TDateTime;
begin
Stream.Read(Result, SizeOf(TDateTime));
end;

function TStreamableObject.ReadLongInt(Stream: TStream): LongInt;
begin
Stream.Read(Result, SizeOf(LongInt));
end;

function TStreamableObject.ReadString(Stream: TStream): string;
var
L: LongInt;
begin
L := ReadLongInt(Stream);
SetLength(Result, L);
Stream.Read(Result[1], L);
end;

procedure TStreamableObject.WriteClassName(Stream: TStream; const Value:
ShortString);
begin
WriteString(Stream, Value);
end;

procedure TStreamableObject.WriteCurrency(Stream: TStream; const Value:
Currency);
begin
Stream.Write(Value, SizeOf(Currency));
end;

procedure TStreamableObject.WriteDateTime(Stream: TStream; const Value:
TDateTime);
begin
Stream.Write(Value, SizeOf(TDateTime));
end;

procedure TStreamableObject.WriteLongInt(Stream: TStream; const Value: LongInt);
begin
Stream.Write(Value, SizeOf(LongInt));
end;

procedure TStreamableObject.WriteString(Stream: TStream; const Value: string);
var
L: LongInt;
begin
L := Length(Value);
WriteLongInt(Stream, L);
Stream.Write(Value[1], L);
end;

{ TCompany }

constructor TCompany.Create(const AName: string; ARevenues: Currency;
AEmployeeCount: Integer);
begin
FName := AName;
FRevenues := ARevenues;
FEmployeeCount := AEmployeeCount;
end;

procedure TCompany.LoadFromStream(Stream: TStream);
begin
FName := ReadString(Stream);
FRevenues := ReadCurrency(Stream);
FEmployeeCount := ReadLongInt(Stream);
end;

procedure TCompany.SaveToStream(Stream: TStream);
begin
WriteString(Stream, FName);
WriteCurrency(Stream, FRevenues);
WriteLongInt(Stream, FEmployeeCount);
end;

procedure TForm1.LoadButtonClick(Sender: TObject);
var
List: TStreamableList;
Stream: TStream;
Instance: TStreamableObject;
I: Integer;
begin
Stream := TFileStream.Create(Path + DEFAULT_FILENAME, fmOpenRead);
try
List := TStreamableList.Create;
try
List.LoadFromStream(Stream);
for I := 0 to List.Count - 1 do
begin
Instance := List[I];
if Instance is TPerson then
ShowMessage(TPerson(Instance).Name);
if Instance is TCompany then
ShowMessage(TCompany(Instance).Name);
end;
finally
List.Free;
end;
finally
Stream.Free;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Path := ExtractFilePath(Application.ExeName);
end;

initialization
RegisterClasses([TPerson, TCompany]);

end.