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.

unit UmbCollection;

interface

uses

 Windows, Messages, SysUtils, Classes, contnrs;



type

 TUmbCollectionItemClass = Class of TUmbCollectionItem;

 TUmbCollectionItem = class(TCollectionItem)

 private

  FPosition: Integer;

 public

  {when overriding this method, you must call the inherited assign.}

  procedure Assign(Source: TPersistent); Override;

 published

  {the position property is used by the streaming mechanism to place the object in the

  right position when reading the items. do not use this property.}

  property Position: Integer read FPosition write FPosition;

 end;

 TUmbCollection = class(TObjectList)

 private

  procedure SetItems(Index: Integer; Value: TUmbCollectionItem);

  function GetItems(Index: Integer): TUmbCollectionItem;

 public

  function Add(AObject: TUmbCollectionItem): Integer;

  function Remove(AObject: TUmbCollectionItem): Integer;

  function IndexOf(AObject: TUmbCollectionItem): Integer;

  function FindInstanceOf(AClass: TUmbCollectionItemClass; AExact: Boolean = True;

  AStartAt: Integer = 0): Integer;

  procedure Insert(Index: Integer; AObject: TUmbCollectionItem);

  procedure WriteToStream(AStream: TStream); virtual;

  procedure ReadFromStream(AStream: TStream); virtual;

  property Items[Index: Integer]: TUmbCollectionItem read GetItems write SetItems; default;

 published

  property OwnsObjects;

 end;

implementation

{ TUmbCollection }

function ItemsCompare(Item1, Item2: Pointer): Integer;

begin

 Result := TUmbCollectionItem(Item1).Position - TUmbCollectionItem(Item2).Position;

end;



function TUmbCollection.Add(AObject: TUmbCollectionItem): Integer;

begin

 Result := inherited Add(AObject);

end;



function TUmbCollection.FindInstanceOf(AClass: TUmbCollectionItemClass;

AExact: Boolean; AStartAt: Integer): Integer;

begin

 Result := inherited FindInstanceOf(AClass, AExact, AStartAt);

end;



function TUmbCollection.GetItems(Index: Integer): TUmbCollectionItem;

begin

 Result := inherited Items[Index] as TUmbCollectionItem;

end;



function TUmbCollection.IndexOf(AObject: TUmbCollectionItem): Integer;

begin

 Result := inherited IndexOf(AObject);

end;



procedure TUmbCollection.Insert(Index: Integer; AObject: TUmbCollectionItem);

begin

 inherited Insert(Index, AObject);

end;



procedure TUmbCollection.ReadFromStream(AStream: TStream);

var

 Reader: TReader;

 Collection: TCollection;

 ItemClassName: string;

 ItemClass: TUmbCollectionItemClass;

 Item: TUmbCollectionItem;

 i: Integer;

begin

 Clear;

 Reader := TReader.Create(AStream, 1024);

 try

  Reader.ReadListBegin;

  while not Reader.EndOfList do

  begin

  ItemClassName := Reader.ReadString;

  ItemClass := TUmbCollectionItemClass(FindClass(ItemClassName));

  Collection := TCollection.Create(ItemClass);

  try

  Reader.ReadValue;

  Reader.ReadCollection(Collection);

  for i := 0 to Collection.Count - 1 do

  begin

  item := ItemClass.Create(nil);

  item.Assign(Collection.Items[i]);

  Add(Item);

  end;

  finally

  Collection.Free;

  end;

  end;

  Sort(ItemsCompare);

  Reader.ReadListEnd;

 finally

  Reader.Free;

 end;

end;



function TUmbCollection.Remove(AObject: TUmbCollectionItem): Integer;

begin

 Result := inherited Remove(AObject);

end;



procedure TUmbCollection.SetItems(Index: Integer; Value: TUmbCollectionItem);

begin

 inherited Items[Index] := Value;

end;



procedure TUmbCollection.WriteToStream(AStream: TStream);

var

 Writer: TWriter;

 CollectionList: TObjectList;

 Collection: TCollection;

 ItemClass: TUmbCollectionItemClass;

 ObjectWritten: array of Boolean;

 i, j: Integer;

begin

 Writer := TWriter.Create(AStream, 1024);

 CollectionList := TObjectList.Create(True);

 try

  Writer.WriteListBegin;

  {init the flag array and the position property of the TCollectionItem objects.}

  SetLength(ObjectWritten, Count);

  for i := 0 to Count - 1 do

  begin

  ObjectWritten[i] := False;

  Items[i].Position := i;

  end;

  {write the TCollectionItem objects. we write first the name of the objects class,

  then write all the object of the same class.}

  for i := 0 to Count - 1 do

  begin

  if ObjectWritten[i] then

  Continue;

  ItemClass := TUmbCollectionItemClass(Items[i].ClassType);

  Collection := TCollection.Create(ItemClass);

  CollectionList.Add(Collection);

  {write the items class name}

  Writer.WriteString(Items[i].ClassName);

  {insert the items to the collection}

  for j := i to Count - 1 do

  if ItemClass = Items[j].ClassType then

  begin

  ObjectWritten[j] := True;

  (Collection.Add as ItemClass).Assign(Items[j]);

  end;

  {write the collection}

  Writer.WriteCollection(Collection);

  end;

 finally

  CollectionList.Free;

  Writer.WriteListEnd;

  Writer.Free;

 end;

end;



{ TUmbCollectionItem }

procedure TUmbCollectionItem.Assign(Source: TPersistent);

begin

 if Source is TUmbCollectionItem then

  Position := (Source as TUmbCollectionItem).Position

 else

  inherited;

end;

end.