DELPHI FAQ: Как сохранить значние свойства в поток?

Как сохранить значние свойства в поток?

How can I save properties of a TList to a stream? I need the entire list to be saved as a whole and not as individual objects.

A TList doesn't have any intrinsic streaming capability built into it, but it is very easy to stream anything that you want with a little elbow grease. Think about it: a stream is data. Classes have properties, whose values are data. It isn't too hard to write property data to a stream. Here's a simple example to get you going. This is but just one of many possible approaches to saving object property data to a stream:

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.

Tip by Rick Rogers

Answer 2:
The solution above will work, but it forces you to implement streaming support for each of the TStreamableObject objects. Delphi has already implemented this mechanism in for the TPersistent class and the TComponent class, and you can use this mechanism. The class I include here does the job. It holds classes that inherit from TUmbCollectionItem (which in turn inherits from Delphi TCollectionItem), and handles all the streaming of the items. As the items are written with the Delphi mechanism, all published data is streamed.
Notes: This class does not support working within the delphi IDE like TCollection. All objects inheriting from TUmbCollectionItem must be registered using the Classes.RegisterClass function. All objects inheriting from TUmbCollectionItem must implement the assign function. By default, the TUmbCollection owns its items (frees them when the collection is freed), but this functionality can be changed.
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.

Tip by Yoav (Yoav@tsoft-tele.com)

Взято из http://www.lmc-mediaagentur.de/dpool

DELPHI FAQ