TCollection und TCollectionItem

[Jens Schumann]

Hallo,
ich gebe an unserem örtlichen Gymnasium eine Informatik AG. Dort habe
ich gerade den Schülern gezeigt, wie man mit Hilfe von TCollection und
TCollectionItem sehr einfach Listen (auch n-dimensionale Listen) speichern kann.
Ich denke, der Code ist auch für die Code-Library interessant.

Das Verfahren nutzt das Delphi-Streamingsystem. Delphi selbst nutzt dieses Technik
um z.B. die Komponenteneigenschaften, die im OI editiert werden, in die dfm-Datei
zu speichern. Bei TStatusbar ist die Panels-Eigenschaft eine Nachfahre von TCollection.
Ein einzelnes Panel dieser Collection ist vom Type TCollectionItem. Alle published
Eigenschaften eines Panels werden beim speichern vom Streamingsystem erfasst.
Ganz automatisch - ohne unser zu tun. Interessant ist, wenn eine published Eigenschaft
von TCollectionItem eine TCollection ist wird auch diese automatisch gespeichert. Damit
hätten wir praktisch schon ein 2-dimensionales "Array" gespeichert. Das kann man beliebig
fortsetzten. Der Anhang enthält eine Powerpointdatei. Darin habe ich versucht es graphisch
darzustellen.

Aber jetzt zum Beispielprogramm:
Das Programm hat ein TEdit, 2 TListBoxen und 2 TButtons.
Über das TEdit kann man Einträge hinzufügen (auf Enter drücken). Damit werden automatisch zu jedem Eintrag 5 Zahlen hinzugefügt (2. TListBox). Damit haben wir eine 2-dimensionale Struktur.
Zu jedem Eintrag (TAddressItem) gehören 5 Zahlen (TNumber). Die können jetzt gespeichert
und geladen werden.

TAddressItem entspricht einem Eintrag. Jedes TAddressItem hat in seiner published Abschnitt
eine Eigenschaft vom Type TNumbers. TNumbers ist ein Nachfahre von TCollection und verwaltet
die einzelnen TNumber (also die o.g. 5 Zahlen zu jedem Eintrag).

Jetzt kommt ein äußerst interessanter Punkt:
Wenn die published Eigenschaften von einem TCollectionItem (hier TAddressItem und TNumber)
erweitert werden, können die alten Datein immer noch gelesen werden. Die neuen Eigenschaft
dann mit Null initialisiert !!!!!!!!!!!!!
Das entspricht einer Änderung des Dateiformats. Das ist mit typisierten Dateien nicht möglich.

Die unit collection.pas enthält den interessanten Code.

[maximov]

:-D Moin.

Ja mit collection und dem streaming system kann man lustige sachen machen. Hab mich auch mal drann vergriffen, hab aber das 'owner' objekt nur in den stream gefaked und nicht extra als dummi erzeugt und dann direkt mit WriteCollection gearbeitet.

Vielleicht interssiert es dich ja: http://www.delphi-forum.de/viewtopic.php?t=18605

Was ich auch einen sehr interessanten aspekt des streaming systems finde, ist die möglichkeit dynamische binäre properties zu definieren :wink:


PS: Insbesondere wäre für dich vielleicht die möglichkeit von nutzen, den binären DFM-strom in das text-DFM format zu konvertieren, das macht die ganze sache schön lesbar un editierbar...kennt man ja.

[Jens Schumann]

@maximov: GUter Tip - werde ich mir mal reinziehen.

[Jens Schumann]

@maximov: Sehr guter Vorschlag. Wenn man auf die Option verzichtet die Datei im Textformat zu speichern und die Code auf das notwendigste reduziert ist Dein Vorschlag besser als meiner.
Dadurch, dass ich den Umweg über ein TComponent gehe sind die Daten in den Items für eine Schrecksekunde doppelt im Speicher. Einmal in der Collection und über Assigen in der Items property des Dummies. Für das Textformat schreibst Du erst mal alles in einen TMemorystream. In dem Moment sind die Daten ebenfalls doppelt vorhanden.

Wenn man jetzt aber auf TMemoryStream verzichtet und über TWriter/TReader direkt in den Stream schreibt sind die Daten nicht doppelt vorhanden. Wie gesagt, wenn auf das Textformat verzichtet
werden kann finde ich diese Lösung besser.

Vielen Dank für die Anregung !!!

Delphi-Quellcode:

unit CollectionExt;

interface

Uses SysUtils, Classes;

Type

  TExtCollection = class(TCollection)
  private
    function GetFormatSignature: String;
  public
    procedure SaveToFile(const Filename : TFilename);
    procedure SaveToStream(Stream : TStream);
    procedure LoadFromFile(const Filename : TFilename);
    procedure LoadFromStream(Stream : TStream);
  end;

implementation

const
  iFilerBufferSize = 4096;

{ TExtCollection }

function TExtCollection.GetFormatSignature: String;
begin 
  Result := ItemClass.ClassName;
end;

procedure TExtCollection.LoadFromFile(const Filename: TFilename);
var
  FileStream : TFileStream;
begin
  Clear;
  FileStream:=TFileStream.Create(Filename,fmOpenRead);
  Try
    LoadFromStream(FileStream);
  Finally
    FileStream.Free;
    end;
end;

procedure TExtCollection.LoadFromStream(Stream: TStream);
var
  Reader  : TReader;
begin
  Reader:=TReader.Create(Stream,iFilerBufferSize);
  Try
    Reader.ReadValue;
    Reader.ReadCollection(Self);
  Finally
    Reader.Free;
    end;
end;

procedure TExtCollection.SaveToFile(const Filename: TFilename);
var
  FileStream : TFileStream;
begin
  FileStream:=TFileStream.Create(Filename,fmCreate);
  Try
    SaveToStream(FileStream);
  Finally
    FileStream.Free;
    end;
end;

procedure TExtCollection.SaveToStream(Stream: TStream);
var
  Writer       : TWriter;
begin
  Writer:=TWriter.Create(Stream,iFilerBufferSize);
  Try
    Writer.WriteCollection(Self);
  Finally
    Writer.Free;
    end;
end;

end.

[maximov]

Hi.

Mir geht es natürlich nicht um besser oder schlechter (*man kann ja nur von einander lernen*) sondern um einen ideenaustausch *g*

Mir gefällt das mit der dummy-compo eigentlich ganz gut UND du müsstest auch nicht mit assign arbeiten, sondern könntest direkt die referenz zuweisen. Der vorteil wäre dann auch, das man im container noch zusätzliche properties definieren kann, die nicht in jedem item auftauchen dürfen/sollten - quasi globale infos...

Was die text-konvertierung angeht, kann man es sicherlich auch so machen, das beim binären speichern direkt in den ziel-stream gespeichert wird und nur beim text-format ein puffer benutzt wird (was bei mir momentan leider nicht der fall ist). Der grosse vorteil wäre, das man die daten prüfen und editieren kann, solange man entwickelt, und wenn man das programm ausliefert, konvertiert man alles ins binär-format, womit dann jegliche redundanzen verschwinden.

mfg.
max.

[Jens Schumann]

Zitat:

Zitat von maximov

Mir gefällt das mit der dummy-compo eigentlich ganz gut UND du müsstest auch nicht mit assign arbeiten, sondern könntest direkt die referenz zuweisen. Der vorteil wäre dann auch, das man im container noch zusätzliche properties definieren kann, die nicht in jedem item auftauchen dürfen/sollten - quasi globale infos...

:gruebel: Wenn ich es richtig verstehe, sollen
über diesen Weg die published properties der TCollection gespeichert werden. Leider bekomme ich das nicht hin. Wie meinst Du das genau?

Die property Collectionname in TAddressItems wird nicht mitgespeichert :gruebel:

Delphi-Quellcode:

unit Collection;

interface

uses SysUtils, classes;

Type

   {TNumber repräsentiert je einen Eintrag in TNumbers}
   TNumber = class(TCollectionItem)
   private
    FNumber : Integer;
   public
     procedure Assign(Source : TPersistent); override; // muss überschrieben werden
   published
     property Number : Integer read FNumber write FNumber;
   end;

   TNumbers = class(TCollection)
   private
    function GetItem(X: Integer): TNumber;
    procedure SetItem(X: Integer; const Value: TNumber);
   public
     constructor Create;
     function Add : TNumber;
     property Items[X : Integer] : TNumber read GetItem write SetItem; default;
   end;

   {TAddressItem repräsentiert je einen Eintrag in TAddressItems
    Numbers ist hier ebenfalls ein Collection. Numbers wird
    automatisch gespeichert !!!}
   TAddressItem = class(TCollectionItem)
   private
    FFirstname : String;
    FNumbers   : TNumbers;
   public
     constructor Create(Collection: TCollection); override;
     destructor Destroy; override;
     procedure Assign(Source : TPersistent); override; // muss überschrieben werden
   published
     property Firstname : String read FFirstname write FFirstname;
     property Numbers   : TNumbers read FNumbers write FNumbers;
   end;

   {Das ist unsere Basisliste}
   TAddressItems = class(TCollection)
   private
    FCollectionName  : String;
    function GetItem(X: Integer): TAddressItem;
    procedure SetItem(X: Integer; const Value: TAddressItem);
   public
     constructor Create;
     procedure Assign(Source : TPersistent); override;
     function Add : TAddressItem;
     procedure SaveToFile(const Filename : TFilename);
     procedure LoadFromFile(const Filename : TFilename);
     procedure SaveToStream(Stream : TStream);
     procedure LoadFromStream(Stream : TStream);
     property Items[X : Integer] :  TAddressItem read GetItem write SetItem; default;
   published
     property CollectionName : String read FCollectionName write FCollectionName;
   end;

   {TAddressDummy ist ein Dummy, der nur benötigt wird, um
    TAddressItems zu speichern. Siehe TAddressItems.SaveToStream.
    Da das Streamingsystem erst ab TComponent greift brauchen wir
    hier diesen Dummy}
   TAddressDummy = class(TComponent)
   private
     FItems : TAddressItems;
   published
     property Items : TAddressItems read FItems write FItems;
   end;

implementation

{ TAddressItem }

procedure TAddressItem.Assign(Source: TPersistent);
begin
  If Source is TAddressItem then
    begin
    FFirstname:=TAddressItem(Source).Firstname;
    FNumbers.Assign(TAddressItem(Source).Numbers);
    end
      else
        inherited Assign(Source);
end;

constructor TAddressItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FNumbers:=TNumbers.Create;
end;

destructor TAddressItem.Destroy;
begin
  FNumbers.Free;
  inherited Destroy;
end;

{ TAddressItems }

function TAddressItems.Add: TAddressItem;
begin
  Result:=inherited Add as TAddressItem;
end;

constructor TAddressItems.Create;
begin
  inherited Create(TAddressItem);
end;

function TAddressItems.GetItem(X: Integer): TAddressItem;
begin
  Result:=inherited GetItem(X) as TAddressItem;
end;


procedure TAddressItems.SaveToFile(const Filename: TFilename);
var
  FileStream : TFileStream;
begin
  FileStream:=TFileStream.Create(Filename,fmCreate);
  Try
    SaveToStream(FileStream);
  Finally
    FileStream.Free;
    end;
end;

procedure TAddressItems.LoadFromFile(const Filename: TFilename);
var
  FileStream : TFileStream;
begin
  Clear;
  FileStream:=TFileStream.Create(Filename,fmOpenRead);
  Try
    LoadFromStream(FileStream);
  Finally
    FileStream.Free;
    end;
end;

procedure TAddressItems.SaveToStream(Stream: TStream);
var
  AddressDummy : TAddressDummy;
begin
  AddressDummy:=TAddressDummy.Create(Nil);
  Try
    AddressDummy.Items:=Self;
    Stream.WriteComponent(AddressDummy);
  Finally
    AddressDummy.Free;
    end;
end;

procedure TAddressItems.LoadFromStream(Stream: TStream);
var
  AddressDummy : TAddressDummy;
begin
  AddressDummy:=TAddressDummy.Create(Nil);
  Try
    AddressDummy.Items:=Self;
    Stream.ReadComponent(AddressDummy);
  Finally
    AddressDummy.Free;
    end;
end;

procedure TAddressItems.SetItem(X: Integer; const Value: TAddressItem);
begin
  inherited SetItem(X,Value);
end;


procedure TAddressItems.Assign(Source: TPersistent);
begin
  If Source is TAddressItems then
    FCollectionName:=TAddressItems(Source).CollectionName
      else
        inherited Assign(Source);
end;


{ TNumber }

procedure TNumber.Assign(Source: TPersistent);
begin
  If Source is TNumber then
    begin
    FNumber:=TNumber(Source).Number;
    end
      else
        inherited Assign(Source);
end;

{ TNumbers }

function TNumbers.Add: TNumber;
begin
  Result:=inherited Add as TNumber
end;

constructor TNumbers.Create;
begin
  inherited Create(TNumber);
end;

function TNumbers.GetItem(X: Integer): TNumber;
begin
  Result:=inherited GetItem(X) as TNumber;
end;

procedure TNumbers.SetItem(X: Integer; const Value: TNumber);
begin
  inherited SetItem(X,Value);
end;

end.

[Jens Schumann]

Hallo maximov,
die einzige Lösung die mir gerade eingefallen ist wäre folgende:

Delphi-Quellcode:

   TAddressDummy = class(TComponent)
   private
     FItems          : TAddressItems;
     FCollectionname : String;
   public
   published
     property Items : TAddressItems read FItems write FItems;
     property Collectionname : String read FCollectionname write FCollectionname;
   end;

procedure TAddressItems.SaveToStream(Stream: TStream);
var
  AddressDummy : TAddressDummy;
begin
  AddressDummy:=TAddressDummy.Create(Nil);
  Try
    AddressDummy.Items:=Self;
    AddressDummy.Collectionname:=FCollectionname;
    Stream.WriteComponent(AddressDummy);
  Finally
    AddressDummy.Free;
    end;
end;

procedure TAddressItems.LoadFromStream(Stream: TStream);
var
  AddressDummy : TAddressDummy;
begin
  AddressDummy:=TAddressDummy.Create(Nil);
  Try
    AddressDummy.Items:=Self;
    Stream.ReadComponent(AddressDummy);
    FCollectionname:=AddressDummy.Collectionname;
  Finally
    AddressDummy.Free;
    end;
end;

Aber dem Dummy ebenfalls eine Collectionname property zu spendieren finde ich irgendwie doof.

[maximov]

Zitat:

Zitat von Jens Schumann

Zitat:

Zitat von maximov

Mir gefällt das mit der dummy-compo eigentlich ganz gut UND du müsstest auch nicht mit assign arbeiten, sondern könntest direkt die referenz zuweisen. Der vorteil wäre dann auch, das man im container noch zusätzliche properties definieren kann, die nicht in jedem item auftauchen dürfen/sollten - quasi globale infos...

:gruebel: Wenn ich es richtig verstehe, sollen
über diesen Weg die published properties der TCollection gespeichert werden. Leider bekomme ich das nicht hin. Wie meinst Du das genau?

Die property Collectionname in TAddressItems wird nicht mitgespeichert :gruebel:
....

Ja du hast es erfasst! Das ist in der tat ein problem, da das streaming-system die collection-klasse gesondert behandelt und es somit nur als container für items identifiziert :? Aber dazu fällt mir bestimmt noch was ein :stupid: ...wär halt cool weil man damit das klassische array problem aufbrechen könnten und somit nicht nur serielle daten des gleichen typs permanent verfügbar machen könnte! Mann kann natürlich gleich ein TComponent als ausgangspunkt nehmen, was aber nicht halb so elegant wäre, da sich damit ja sowiso hierarchische strukturen streamen lassen :wink: ...mal sehn

[mirage228]

Hi,

wer die Sourcen hat, kann sich die Implementierung von TWebDispatcher in der Unit HTTPApp anschauen. Dort ist es so gelöst, dass a) die Collection im OI angezeigt und b) automatisch mit dem DFM gespeichert wird.

mfG
mirage228

[maximov]

Zitat:

Zitat von mirage228

Hi,

wer die Sourcen hat, kann sich die Implementierung von TWebDispatcher in der Unit HTTPApp anschauen. Dort ist es so gelöst, dass a) die Collection im OI angezeigt und b) automatisch mit dem DFM gespeichert wird.

mfG
mirage228

Dazu muss man kein prophet sein :mrgreen: ...dafür sind collections ja auch da, wir versuchen nur grad zu klären, ob wir sie für unsere eigenen, dunklen zwecke missbrauchen können, bzw. erweitern und das mit möglichst hoher informations-effiziens und service-fähigkeiten. :stupid:

@Jens:Ich seh grad, dass TCollection von TObject abstammt :( womit wir wohl deren published-props vergessen können, da sie keine RTTI besitzen...verdammt wäre ja auch zu schön gewesen!

Wie wäre es mit einem 'streaming-provider' der von TComponent abgeleitet ist und standartmässig die items property hat, wo man dann soviele properties hinzufügen kann, wie man will?

[mirage228]

Hi,

du könntest ja mit dem Compilerschalter {M+} RTTI auch für Objekte, die nicht von TPersistent stammen, aktivieren. Aber eventuell ergibt das zuviel überhang. Da muss man mal abwägen. Oder meintest du jetzt was anderes?

mfG
mirage228

[Jens Schumann]

Zitat:

Zitat von maximov

@Jens:Ich seh grad, dass TCollection von TObject abstammt :( womit wir wohl deren published-props vergessen können, da sie keine RTTI besitzen...verdammt wäre ja auch zu schön gewesen!

Habe ich gerade aus den VCL-Sourcen kopiert:

Delphi-Quellcode:

TCollection = class(TPersistent)

:(

[mirage228]

Zitat:

Zitat von Jens Schumann

Zitat:

Zitat von maximov

@Jens:Ich seh grad, dass TCollection von TObject abstammt :( womit wir wohl deren published-props vergessen können, da sie keine RTTI besitzen...verdammt wäre ja auch zu schön gewesen!

Habe ich gerade aus den VCL-Sourcen kopiert:

Delphi-Quellcode:

TCollection = class(TPersistent)

:(

Also geht RTTI damit ja doch! :?

mfG
mirage228

[Jens Schumann]

Zitat:

Zitat von mirage228

Zitat:

Zitat von Jens Schumann

Zitat:

Zitat von maximov

@Jens:Ich seh grad, dass TCollection von TObject abstammt :( womit wir wohl deren published-props vergessen können, da sie keine RTTI besitzen...verdammt wäre ja auch zu schön gewesen!

Habe ich gerade aus den VCL-Sourcen kopiert:

Delphi-Quellcode:

TCollection = class(TPersistent)

:(

Also geht RTTI damit ja doch! :?

mfG
mirage228

Das Problem ist, dass von TCollection bis auf Items keine published property gestreamt wird. Da sich die Kombination TCollection/TCollectionItem für die Spericherung von n-dimensionalen Listen geradezu anbietet, wäre es klasse wenn man neben der Items property auch andere properties speichern könnte.

[maximov]

JA komando zurück :oops: Hab nur schnell auf ein klassen-diagramm von mir gekuckt, was anscheinend falsch ist. Hatte mich auch extrem gewundert, da ich es für auch als TPersisten-abkömmling gespeichert hatte...und ja man hätte RTTI natürlich auch nachträglich mit $M+ aktivieren können. Naja, das kommt dabei raus wenn man letzte nacht zu viel zu feiern hatte :cheers:

Wenn es von TPersistent ist könnte man ja mit WriteProperties(Instance: TPersistent); des Writers, die properties schreiben - nur leider finde ich mom. kein gegenstück im reader.

Oder habt ihr bessere ideen, bzw. bin ich komplett verrückt?

[Jens Schumann]

@maximov:
Was sagst Du dazu?

Delphi-Quellcode:

unit CollectionExt;

interface

Uses SysUtils, Classes;

Type

  TJsCollection = class(TCollection)
  private
    FCollectionname : String;
    FIntValue       : Integer;
    function GetFormatSignature: String;
  public
    procedure SaveToFile(const Filename : TFilename);
    procedure SaveToStream(Stream : TStream);
    procedure LoadFromFile(const Filename : TFilename);
    procedure LoadFromStream(Stream : TStream);
  published
    property Collectionname : String read FCollectionname write FCollectionname;
    property IntValue        : Integer read FIntValue write FIntValue;
  end;

  TWriterExt = class(TWriter)
  public
    procedure WriteCollection(Value: TCollection);
    procedure WriteCollectionProperties(Value : TCollection);
  end;

  TReaderExt = class(TReader)
  public
    procedure ReadCollection(Value: TCollection);
    procedure ReadCollectionProperties(Value: TCollection);
  end;


implementation

uses TypInfo;

const
  iFilerBufferSize = 4096;

{ TJsCollection }

function TJsCollection.GetFormatSignature: String;
begin                             
  Result := ItemClass.ClassName;
end;

procedure TJsCollection.LoadFromFile(const Filename: TFilename);
var
  FileStream : TFileStream;
begin
  Clear;
  FileStream:=TFileStream.Create(Filename,fmOpenRead);
  Try
    LoadFromStream(FileStream);
  Finally
    FileStream.Free;
    end;
end;

procedure TJsCollection.LoadFromStream(Stream: TStream);
var
  Reader  : TReaderExt;
begin
  Reader:=TReaderExt.Create(Stream,iFilerBufferSize);
  Try
    Reader.ReadCollection(Self);
  Finally
    Reader.Free;
    end;
end;

procedure TJsCollection.SaveToFile(const Filename: TFilename);
var
  FileStream : TFileStream;
begin
  FileStream:=TFileStream.Create(Filename,fmCreate);
  Try
    SaveToStream(FileStream);
  Finally
    FileStream.Free;
    end;
end;

procedure TJsCollection.SaveToStream(Stream: TStream);
var
  Writer       : TWriterExt;
begin
  Writer:=TWriterExt.Create(Stream,iFilerBufferSize);
  Try
    Writer.WriteCollection(Self);
  Finally
    Writer.Free;
    end;
end;

{ TWriterExt }

procedure TWriterExt.WriteCollection(Value: TCollection);
begin
  WriteCollectionProperties(Value);
  inherited WriteCollection(Value);
end;

procedure TWriterExt.WriteCollectionProperties(Value: TCollection);
begin
  WriteProperties(Value);
end;

{ TReaderExt }

procedure TReaderExt.ReadCollection(Value: TCollection);
begin
  ReadCollectionProperties(Value);
  ReadValue;
  inherited ReadCollection(Value);
end;

procedure TReaderExt.ReadCollectionProperties(Value: TCollection);
var
  PropList   : TPropList;
  PropCount  : Integer;
  iCnt       : Integer;
begin
  PropCount:=GetPropList(Value.ClassInfo,tkProperties,@PropList);
  For iCnt:=0 to PropCount-1 do
    ReadProperty(Value);
end;

end.

Entpacke mal die Anlage, starte die EXE, klicke ein paar mal auf Add, dann auf Save und zum Schluss auf Load.

[Edit]Habe gerade noch ein bisschen rumgetestet. Auch die properties von SubCollections (wenn ein TCollectionItem eine TCollection enthält) werden gestreamt[/Edit]

[maximov]

Zitat:

Zitat von Jens Schumann

@maximov:
Was sagst Du dazu?
...

Ich sage: Sehr schön! Das ist genau das was ich meinte, hätte mich grad fast drann gemacht das fast genauso zu implementieren :-D ..wenn wir jetzt noch signatur und header korrekt davor schreiben, dann ist das IMO die perfekte lösung, da wir dann den DFM-parser noch integrieren können. Was mir sehr wichtig ist, wie du merkst :wink: ..ich arbeite schon seit längerem mit einen halb selbst gebauten streaming system, das einen DFM-konformen stream erzeugt und kann nur sagen: es gibt nix besseres um daten zu 'debuggen', ausser vielleicht XML. Aber DFMs arbeiten natürlich wesentlich enger mit delphi zusammen!

Zitat:

[Edit]Habe gerade noch ein bisschen rumgetestet. Auch die properties von SubCollections (wenn ein TCollectionItem eine TCollection enthält) werden gestreamt[/Edit]

bist dir sicher??? die subItems werden doch von einem normalen TWriter geschrieben, wie kann der TWriterExt.WriteCollection benutzen, du hast ja nix 'overrided'? oder hab ich dich falsch verstanden?

zB. FCollection[0].collection.intValue wird geschrieben? ...wäre ja sehr erstaunlich.

[maximov]

Ok...weiss jetzt was du meintest!

Hab mal in einer ableitung besagte konverter-funktionen eingebaut und es kommt dies bei raus:

Delphi-Quellcode:

object TestCollection: TmxJsCollection
  Collectionname = 'TestCollection'
  IntValue = 42
  Items = <
    item
      Firstname = 'Edit1'
      SubItems = <
        item
          Value = 10
        end
        item
          Value = 10
        end
        item
          Value = 19
        end
        item
          Value = 12
        end
        item
          Value = 13
        end
        item
          Value = 17
        end>
    end
    item
      Firstname = 'Edit1'
      SubItems = <
        item
          Value = 10
        end
        item
          Value = 19
        end
        item
          Value = 10
        end
        item
          Value = 13
        end
        item
          Value = 20
        end
        item
          Value = 14
        end>
    end>
end

Schonmal geil ...ich poste den code, wenn er auch läd und von jeglichen redundanzen befreit ist!

[maximov]

SO:

- 100% DFM konform
- Alle redundanzen beseitigt (fürs binäre streaming).
- DFM-konvertierung -> asBinary = false
- automatische erkennung ob binär oder text beim laden.

Delphi-Quellcode:

unit CollectionExt;
//
// written by Jens Schumann and MaxHub (maximov)
//

interface

Uses SysUtils, Classes;

Type

  TJsCollection = class(TCollection)
  private
    FCollectionname : String;
    FIntValue       : Integer;
    function GetFormatSignature: String; 
    procedure SetCollectionname(const Value: String);
    procedure SetIntValue(const Value: Integer);
  public
    procedure SaveToFile(const Filename : TFilename);
    procedure SaveToStream(Stream : TStream);
    procedure LoadFromFile(const Filename : TFilename);
    procedure LoadFromStream(Stream : TStream);

  published
    property Collectionname : String read FCollectionname write SetCollectionname;
    property IntValue        : Integer read FIntValue write SetIntValue;
  end;

  TmxJsCollection = class(TJsCollection)
    procedure LoadFromStreamEx(aStream: TStream);
    procedure SaveToStreamEx(aStream: TStream; asBinary: Boolean);
    procedure LoadFromFileEx(const Filename: TFilename);
    procedure SaveToFileEx(const Filename: TFilename; asBinary: Boolean);
  end;
      

  TWriterExt = class(TWriter)
  public
    
    procedure WriteCollection(Value: TCollection);
    procedure WriteCollectionProperties(Value : TCollection);
  end;

  TReaderExt = class(TReader)
  public
    procedure ReadCollection(Value: TCollection);
    procedure ReadCollectionProperties(Value: TCollection);
  end;


implementation

uses TypInfo;

const
  iFilerBufferSize = 4096;
  FilerSignatureEx: array[1..4] of Char = 'TPF0';

{ TJsCollection }

function TJsCollection.GetFormatSignature: String;
begin                             
  Result := ItemClass.ClassName;
end;

procedure TJsCollection.LoadFromFile(const Filename: TFilename);
var
  FileStream : TFileStream;
begin
  Clear;
  FileStream:=TFileStream.Create(Filename,fmOpenRead);
  Try
    LoadFromStream(FileStream);
  Finally
    FileStream.Free;
    end;
end;

procedure TJsCollection.LoadFromStream(Stream: TStream);
var
  Reader  : TReaderExt;
begin
  Reader:=TReaderExt.Create(Stream,iFilerBufferSize);
  Try
    Reader.ReadCollection(Self);
  Finally
    Reader.Free;
    end;
end;

procedure TJsCollection.SaveToFile(const Filename: TFilename);
var
  FileStream : TFileStream;
begin
  FileStream:=TFileStream.Create(Filename,fmCreate);
  Try
    SaveToStream(FileStream);
  Finally
    FileStream.Free;
    end;
end;

procedure TJsCollection.SaveToStream(Stream: TStream);
var
  Writer       : TWriterExt;
begin
  Writer:=TWriterExt.Create(Stream,iFilerBufferSize);
  Try
    Writer.WriteCollection(Self);
  Finally
    Writer.Free;
    end;
end;

procedure TJsCollection.SetCollectionname(const Value: String);
begin
  FCollectionname := Value;
end;

procedure TJsCollection.SetIntValue(const Value: Integer);
begin
  FIntValue := Value;
end;

{ TWriterExt }

procedure TWriterExt.WriteCollection(Value: TCollection);
begin
  WriteCollectionProperties(Value);
  WriteStr('Items'); // wichtig für DFM-konformität 
  inherited WriteCollection(Value);
end;

procedure TWriterExt.WriteCollectionProperties(Value: TCollection);
begin
  WriteProperties(Value);
end;

{ TReaderExt }

procedure TReaderExt.ReadCollection(Value: TCollection);
begin
  ReadCollectionProperties(Value);  
  ReadStr; // wichtig für DFM-konformität
  ReadValue;  
  inherited ReadCollection(Value);
end;

procedure TReaderExt.ReadCollectionProperties(Value: TCollection);
var
  PropList   : TPropList;
  PropCount  : Integer;
  iCnt       : Integer;
begin
  PropCount:=GetPropList(Value.ClassInfo,tkProperties,@PropList);
  For iCnt:=0 to PropCount-1 do
    ReadProperty(Value);
end;


{ TmxJsCollection }

procedure TmxJsCollection.LoadFromStreamEx(aStream: TStream);
var Reader       : TReaderExt;
    StreamInner  : TStream;
    format       : TStreamOriginalFormat;
    oldPos       : Int64;
    SigBuffer    : array[1..4] of Char;
    isBinary     : boolean;
begin
  // automatisch feststellen ob binär oder text
  oldPos := aStream.Position;
  aStream.ReadBuffer(SigBuffer[1],sizeOf(SigBuffer));
  isBinary := SigBuffer = FilerSignatureEx;
  aStream.Position := oldPos;
  
  if isBinary
  then StreamInner := aStream
  else StreamInner := TMemoryStream.Create;  
              
  try    
    // DFM-text parsen
    if not isBinary then
    begin
      format := sofBinary;                             
      ObjectTextToBinary(aStream,StreamInner,format); 
      StreamInner.Position := 0;
    end;  
                          
    Reader := TReaderExt.Create(StreamInner,iFilerBufferSize);      
    try
      Reader.ReadSignature;  
      Reader.ReadStr; // ClassName            
      Reader.ReadStr; // Collectionname  

      Reader.ReadCollection(self);  

      Reader.ReadListEnd;                             
      Reader.ReadListEnd;            
    finally
      Reader.Free;
    end;
  finally
    if not isBinary then StreamInner.Free;
  end;
end;

procedure TmxJsCollection.SaveToStreamEx(aStream: TStream; asBinary: Boolean);
var Writer       : TWriterExt;
    StreamInner  : TStream;
    format       : TStreamOriginalFormat;          
begin              
  if asBinary
  then StreamInner := aStream
  else StreamInner := TMemoryStream.Create;  
                
  try                                                     
    Writer := TWriterExt.Create(StreamInner,iFilerBufferSize);       
    try         
      Writer.WriteSignature; 
      Writer.WriteStr(ClassName);                    
      Writer.WriteStr(Collectionname);   
               
      Writer.WriteCollection(Self);

      Writer.WriteListEnd;
      Writer.WriteListEnd;                                 
    finally
      Writer.Free;
    end;
    // DFM-text konversion
    if not asBinary then
    begin
      StreamInner.Position := 0;  
      format := sofText;                               
      ObjectBinaryToText(StreamInner,aStream,format); 
    end;       
  finally
    if not asBinary then StreamInner.Free;
  end;
end;


procedure TmxJsCollection.LoadFromFileEx(const Filename: TFilename);
var
  FileStream : TFileStream;
begin
  Clear;
  FileStream:=TFileStream.Create(Filename,fmOpenRead);
  Try
    LoadFromStreamEx(FileStream);
  Finally
    FileStream.Free;
  end;
end;


procedure TmxJsCollection.SaveToFileEx(const Filename: TFilename; asBinary: Boolean);
var
  FileStream : TFileStream;
begin
  FileStream:=TFileStream.Create(Filename,fmCreate);
  Try
    SaveToStreamEx(FileStream, asBinary);
  Finally
    FileStream.Free;
  end;
end;

end.

Wenn willst kannst du das jetzt zu einer klasse zusammenfügen...auf jeden fall ein schönes teil, was der ein oder andere sicher gut gebrauchen kann.

Das einzige das man noch hinzufügen könnte wäre ein format-signatur-abfrage, um besser auf verschiedene datenformate zu reagieren.

:cheers: auf die gute team-arbeit.


PS: Mein vorschlag für den unit namen wäre: 'dpCollection'

[Jens Schumann]

Zitat:

Zitat von maximov

:cheers: auf die gute team-arbeit.

Ist auch meine Meinung.
Ich habe vor ca 3 oder 4 Jahren das Gespann TCollection/TCollectionItem für mich entdeckt.
Seitdem benutzte ich die Kombination regelmäßig. Bislang war ich aber nur in der Lage die Collection über die Dummy-Komponente zu speichern. Deshalb habe mich auch regelmäßig darüber geärgert dass ich die properties von TCollection nicht streamen konnte (bzw. nicht fähig war das alleien herauszufinden). Deshalb hier noch mal vielen Dank an maximov und der DP für das klasse Forum. Writer.WriteProperties war der entscheidene Hinweis :idea: der mir gefehlt hatte.

Zitat:

Zitat von maximov

PS: Mein vorschlag für den unit namen wäre: 'dpCollection'

Bin dafür

P.S. Ich habe hier im Forum schon oft Fragen zum Thema Array und speichern gelesen. Wenn die Leute anfangen in Objekten zu denken und es schaffen sich von Dyn Array's und Records loszusagen, werden Sie erkennen, dass sich alle Fragen der Speicherung in Luft auflösen. Amen

[Jens Schumann]

Hallo maximov,
ich habe an der unit noch etwas herumgefummelt.
Da TJsCollection eine published property einführt muss die Assign-Methode überschrieben werden.
In TmxJsCollection habe ich aus dem Parameter AsBinary eine property gemacht. Dann kann man in TJsCollection SaveToStream und LoadFromStream als virtual deklarieren und in TmxJsCollection überschreiben. Dann spart man sich in TmxJsCollection die Methoden SaveToFileEx und LoadFromFileEx.

Einverstanden ?

Delphi-Quellcode:

unit dpcollection;
// 
// written by Jens Schumann and MaxHub (maximov) 
// 

interface 

Uses SysUtils, Classes;

Type 

  TJsCollection = class(TCollection) 
  private 
    FCollectionname : String; 
    procedure SetCollectionname(const Value: String);
  public
    procedure Assign(Source : TPersistent); override;
    procedure SaveToFile(const Filename : TFilename); 
    procedure SaveToStream(Stream : TStream); virtual;
    procedure LoadFromFile(const Filename : TFilename); 
    procedure LoadFromStream(Stream : TStream); virtual;
  published
    property Collectionname : String read FCollectionname write SetCollectionname; 
  end;

  TmxJsCollection = class(TJsCollection)
  private
    FAsBinary : Boolean;
  public
    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;
    property  AsBinary : Boolean read FAsBinary write FAsBinary;
  end;
      

  TWriterExt = class(TWriter) 
  public 
    
    procedure WriteCollection(Value: TCollection); 
    procedure WriteCollectionProperties(Value : TCollection); 
  end; 

  TReaderExt = class(TReader) 
  public 
    procedure ReadCollection(Value: TCollection); 
    procedure ReadCollectionProperties(Value: TCollection); 
  end; 


implementation 

uses TypInfo; 

const 
  iFilerBufferSize = 4096; 
  FilerSignatureEx: array[1..4] of Char = 'TPF0'; 

{ TJsCollection } 

procedure TJsCollection.Assign(Source: TPersistent);
begin
  If Source is TJsCollection then
    FCollectionname:=TJsCollection(Source).Collectionname;
  inherited Assign(Source);
end;

procedure TJsCollection.LoadFromFile(const Filename: TFilename);
var 
  FileStream : TFileStream; 
begin 
  Clear; 
  FileStream:=TFileStream.Create(Filename,fmOpenRead); 
  Try 
    LoadFromStream(FileStream); 
  Finally 
    FileStream.Free; 
    end; 
end; 

procedure TJsCollection.LoadFromStream(Stream: TStream); 
var 
  Reader  : TReaderExt; 
begin 
  Reader:=TReaderExt.Create(Stream,iFilerBufferSize); 
  Try 
    Reader.ReadCollection(Self); 
  Finally 
    Reader.Free; 
    end; 
end; 

procedure TJsCollection.SaveToFile(const Filename: TFilename); 
var 
  FileStream : TFileStream; 
begin 
  FileStream:=TFileStream.Create(Filename,fmCreate); 
  Try 
    SaveToStream(FileStream); 
  Finally 
    FileStream.Free; 
    end; 
end; 

procedure TJsCollection.SaveToStream(Stream: TStream); 
var 
  Writer       : TWriterExt; 
begin 
  Writer:=TWriterExt.Create(Stream,iFilerBufferSize); 
  Try 
    Writer.WriteCollection(Self); 
  Finally 
    Writer.Free; 
    end; 
end; 

procedure TJsCollection.SetCollectionname(const Value: String); 
begin 
  FCollectionname := Value; 
end;

{ TWriterExt }

procedure TWriterExt.WriteCollection(Value: TCollection); 
begin 
  WriteCollectionProperties(Value); 
  WriteStr('Items'); // wichtig für DFM-konformität
  inherited WriteCollection(Value); 
end; 

procedure TWriterExt.WriteCollectionProperties(Value: TCollection); 
begin 
  WriteProperties(Value); 
end; 

{ TReaderExt } 

procedure TReaderExt.ReadCollection(Value: TCollection); 
begin 
  ReadCollectionProperties(Value);  
  ReadStr; // wichtig für DFM-konformität
  ReadValue;  
  inherited ReadCollection(Value); 
end; 

procedure TReaderExt.ReadCollectionProperties(Value: TCollection); 
var 
  PropList   : TPropList; 
  PropCount  : Integer; 
  iCnt       : Integer; 
begin 
  PropCount:=GetPropList(Value.ClassInfo,tkProperties,@PropList); 
  For iCnt:=0 to PropCount-1 do 
    ReadProperty(Value); 
end; 


{ TmxJsCollection } 

procedure TmxJsCollection.LoadFromStream(aStream: TStream);
var Reader       : TReaderExt; 
    StreamInner  : TStream; 
    format       : TStreamOriginalFormat; 
    oldPos       : Int64; 
    SigBuffer    : array[1..4] of Char; 
    isBinary     : boolean; 
begin 
  // automatisch feststellen ob binär oder text 
  oldPos := aStream.Position; 
  aStream.ReadBuffer(SigBuffer[1],sizeOf(SigBuffer)); 
  isBinary := SigBuffer = FilerSignatureEx; 
  aStream.Position := oldPos; 
  
  if isBinary 
  then StreamInner := aStream 
  else StreamInner := TMemoryStream.Create;  
              
  try    
    // DFM-text parsen 
    if not isBinary then 
    begin 
      format := sofBinary;                              
      ObjectTextToBinary(aStream,StreamInner,format); 
      StreamInner.Position := 0; 
    end;  
                          
    Reader := TReaderExt.Create(StreamInner,iFilerBufferSize);      
    try 
      Reader.ReadSignature;  
      Reader.ReadStr; // ClassName            
      Reader.ReadStr; // Collectionname  

      Reader.ReadCollection(self);  

      Reader.ReadListEnd;                              
      Reader.ReadListEnd;            
    finally 
      Reader.Free; 
    end; 
  finally 
    if not isBinary then StreamInner.Free; 
  end; 
end; 

procedure TmxJsCollection.SaveToStream(aStream: TStream);
var Writer       : TWriterExt; 
    StreamInner  : TStream; 
    format       : TStreamOriginalFormat;          
begin              
  if FAsBinary
  then StreamInner := aStream 
  else StreamInner := TMemoryStream.Create;  
                
  try                                                      
    Writer := TWriterExt.Create(StreamInner,iFilerBufferSize);        
    try          
      Writer.WriteSignature; 
      Writer.WriteStr(ClassName);                    
      Writer.WriteStr(Collectionname);    

      Writer.WriteCollection(Self);

      Writer.WriteListEnd; 
      Writer.WriteListEnd;                                  
    finally 
      Writer.Free; 
    end; 
    // DFM-text konversion 
    if not FAsBinary then 
    begin 
      StreamInner.Position := 0;  
      format := sofText;                                
      ObjectBinaryToText(StreamInner,aStream,format); 
    end;        
  finally 
    if not FAsBinary then StreamInner.Free; 
  end; 
end; 

end.

Achtung: Entwickelt habe ich das ganze mit D7. Jetzt habe ich aber nur D5 zur Verfügung und musste feststellen: Wenn ein TCollectionItem im published Abschnitt eine TCollection property hat, werden deren published properties nicht gestreamt. :shock:
Ich vermute das es an D5 liegt. Ich werde mal über Pfingsten in die VCL-Source abtauchen und nachsehen an welcher Stelle sich D5 und D7 hier unterscheiden.

[Jens Schumann]

Hallo,
tatsächlich - es liegt an D5. Wenn man in der unit classes.pas die
Implementierung von WriteProperty vergleicht kann man erkennen, dass es dort unterschiede
gibt. Diese Unterschiede sorgen dafür dass wenn ein TCollectionItem im published Abschnitt eine TCollection property hat, deren published properties nicht gestreamt werden. Verdammt
Man könnte das Problem lösen wenn man TWriter.WriteProperties überschreibt. Leider handelt es sich hier um eine statische Methode. Das bedeutet aber nicht, dass der Code für D5 unbrachbar ist.

[maximov]

Zitat:

Zitat von Jens Schumann

Hallo,
...
Man könnte das Problem lösen wenn man TWriter.WriteProperties überschreibt. Leider handelt es sich hier um eine statische Methode. Das bedeutet aber nicht, dass der Code für D5 unbrachbar ist.

Ja! das ist allerdings nervig. Leider wurden die filer-klassen nicht polymorphisch konzipiert :( ...hab ich mich auch schon sehr lange und viel drüber geärgert...aber egal so oft braucht auch keine n-dimensionalen collections und wenn, dann muss man halt D7 nehmen.


Ok...es gab noch ein paar kleines probleme, wenn man dynamische properties definieren will (DefineProperties()), da dein reader nur die anzahl der statisch definierten properties berücksichtigt. Hab das mal geändert. Jetzt kann man auch binäre und dynamische daten auf collection-ebene streamen (ich hoffe die funktionalität von TJsCollection wurde dadurch nicht betroffen, kannst ja mal testen und ggf. modifizieren)!

So könnte jetzt ein stream aussehen:

Delphi-Quellcode:

object test1: TmmxCollection
  globalInfo = 'hallo global'
  dynBinProp = {
    000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F
    202122232425262728292A2B2C2D2E2F303132333435363738393A3B3C3D3E3F
    404142434445464748494A4B4C4D4E4F505152535455565758595A5B5C5D5E5F
    606162636465666768696A6B6C6D6E6F707172737475767778797A7B7C7D7E00}
  items = <
    item
      aBoolean = True
      anInteger = 42
      anExtended = 2123.000000000000000000
      anEnum = ffChildPos
      aSet = [ffChildPos, ffInline]
    end
    item
      aBoolean = False
      anInteger = 0
      anEnum = ffInherited
      aSet = []
      anImage.Data = {
        36030000424D3603000000000000360000002800000010000000100000000100
        18000000000000030000120B0000120B00000000000000000000FF00FFFF00FF
        FF00FFFF00FFFF00FFA0756E7443427443427443427443427443427443427443
        42744342744342FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFA0756EFFF8E5F7
        EDD9F7EBD5F4E9D1F4E9D0F4E7CFF6EAD0EEDDC4754443FF00FFFF00FFFF00FF
        FF00FFFF00FFFF00FFA0756EF7EDDCF2D9BFF2D7BBF0D5BAEFD4B5EED3B2EED9
        BFE5D0BA754443FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFA0756EFAEFDEFC
        C591FCC591FCC591FCC591FCC591FCC591E3D1BC754443FF00FFFF00FFA0756E
        744342744342744342A0756EFCF4E7F6D9BAF7D7B6F6D4B5F6D4B2F4D1ADF0DC
        C2E6D3C081524CFF00FFFF00FFA0756EFFF8E5F7EDD9F7EBD5A0756EFEF6EBF8
        DABCF8D9B8F8D8B7F7D5B6F7D4B2F3DEC7E7D7C581524DFF00FFFF00FFA0756E
        F7EDDCF2D9BFF2D7BBA0756EFEFAF2FCC591FCC591FCC591FCC591FCC591FCC5
        91EBDDCF8F5F5AFF00FFFF00FFA0756EFAEFDEFCC591FCC591A0756EFFFCFAFC
        E3CCFBE0C7FADEC6F8DEC4FCE2C6FCF0DEE1D7CE8F5E59FF00FFFF00FFA0756E
        FCF4E7F6D9BAF7D7B6A0756EFFFFFFFEFFFFFBFBFBFAF8F7FAFAF6E5D5D0C6B1
        AFA793959E675AFF00FFFF00FFA0756EFEF6EBF8DABCF8D9B8A0756EFFFFFFFF
        FFFFFFFEFEFFFCF8FFFEFAA0756EA0756EA0756EA0756EFF00FFFF00FFA0756E
        FEFAF2FCC591FCC591A0756EFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFA0756EE5A1
        54B6735DFF00FFFF00FFFF00FFA0756EFFFCFAFCE3CCFBE0C7A0756EA0756EA0
        756EA0756EA0756EA0756EA0756EAA6D68FF00FFFF00FFFF00FFFF00FFA0756E
        FFFFFFFEFFFFFBFBFBFAF8F7FAFAF6E5D5D0C6B1AFA793959E675AFF00FFFF00
        FFFF00FFFF00FFFF00FFFF00FFA0756EFFFFFFFFFFFFFFFEFEFFFCF8FFFEFAA0
        756EA0756EA0756EA0756EFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFA0756E
        FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFA0756EE5A154B6735DFF00FFFF00FFFF00
        FFFF00FFFF00FFFF00FFFF00FFA0756EA0756EA0756EA0756EA0756EA0756EA0
        756EAA6D68FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF}
    end
    item
      aBoolean = False
      anInteger = 42
      anExtended = 23.000000000000000000
      anEnum = ffChildPos
      aSet = []
    end>
end

Wird immer besser :-D und hier der code:

Delphi-Quellcode:

unit dpCollection;
// 
// written by Jens Schumann and MaxHub (maximov) 
// 

interface 

Uses SysUtils, Classes;

Type 

  TJsCollection = class(TCollection) 
  private 
    FCollectionname : String; 
    procedure SetCollectionname(const Value: String); 
  public 
    procedure AfterConstruction; override;
    procedure Assign(Source : TPersistent); override; 
    procedure SaveToFile(const Filename : TFilename); 
    procedure SaveToStream(Stream : TStream); virtual; 
    procedure LoadFromFile(const Filename : TFilename); 
    procedure LoadFromStream(Stream : TStream); virtual;    
  published 
    property Collectionname : String read FCollectionname write SetCollectionname; 
  end; 

  TmxJsCollection = class(TJsCollection) 
  private 
    FAsBinary : Boolean; 
  protected
    procedure DefineProperties(Filer: TFiler); override;      
    procedure ReadItems(Reader: TReader);
    procedure WriteItems(Writer: TWriter);    
  public 
    procedure LoadFromStream(aStream: TStream); override; 
    procedure SaveToStream(aStream: TStream); override; 
    property  AsBinary : Boolean read FAsBinary write FAsBinary; 
  published
    property Collectionname stored false;
  end; 
      

  TWriterExt = class(TWriter) 
  public 
    procedure WriteCollection(Value: TCollection); 
    procedure WriteCollectionProperties(Value : TCollection); 
  end; 

  TReaderExt = class(TReader) 
  public 
    procedure ReadCollection(Value: TCollection); 
    procedure ReadCollectionProperties(Value: TCollection); 
  end; 


implementation 

uses TypInfo; 

const 
  iFilerBufferSize = 4096; 
  FilerSignatureEx: array[1..4] of Char = 'TPF0'; 
  cInvalidName = ' is not a valid CollectionName!';

{ TJsCollection } 

procedure TJsCollection.AfterConstruction;
begin
  inherited;
  FCollectionname := copy(className,2,length(className)-1)
end;

procedure TJsCollection.Assign(Source: TPersistent);
begin 
  If Source is TJsCollection then 
    FCollectionname:=TJsCollection(Source).Collectionname; 
  inherited Assign(Source); 
end; 

procedure TJsCollection.LoadFromFile(const Filename: TFilename); 
var 
  FileStream : TFileStream; 
begin 
  Clear; 
  FileStream:=TFileStream.Create(Filename,fmOpenRead); 
  Try 
    LoadFromStream(FileStream); 
  Finally 
    FileStream.Free; 
    end; 
end; 

procedure TJsCollection.LoadFromStream(Stream: TStream); 
var 
  Reader  : TReaderExt; 
begin 
  Reader:=TReaderExt.Create(Stream,iFilerBufferSize); 
  Try 
    Reader.ReadCollection(Self); 
  Finally 
    Reader.Free; 
    end; 
end; 

procedure TJsCollection.SaveToFile(const Filename: TFilename); 
var 
  FileStream : TFileStream; 
begin 
  FileStream:=TFileStream.Create(Filename,fmCreate); 
  Try 
    SaveToStream(FileStream); 
  Finally 
    FileStream.Free; 
    end; 
end; 

procedure TJsCollection.SaveToStream(Stream: TStream); 
var 
  Writer       : TWriterExt; 
begin 
  Writer:=TWriterExt.Create(Stream,iFilerBufferSize); 
  Try 
    Writer.WriteCollection(Self); 
  Finally 
    Writer.Free; 
    end; 
end; 

procedure TJsCollection.SetCollectionname(const Value: String); 
begin 
  if not IsValidIdent(Value)
  then raise exception.Create(#39+Value+#39+cInValidName)
  else FCollectionname := Value; 
end; 

{ TWriterExt } 

procedure TWriterExt.WriteCollection(Value: TCollection); 
begin 
  WriteCollectionProperties(Value); 
  inherited WriteCollection(Value); 
end; 

procedure TWriterExt.WriteCollectionProperties(Value: TCollection); 
begin 
  WriteProperties(Value); 
end; 

{ TReaderExt } 

procedure TReaderExt.ReadCollection(Value: TCollection); 
begin 
  ReadCollectionProperties(Value);  
  ReadValue;  
  inherited ReadCollection(Value); 
end; 

procedure TReaderExt.ReadCollectionProperties(Value: TCollection); 
begin 
  // das muss hier dynamisch bleiden, da sonst
  // dynamische properties nicht gestreamed werden können
  while not EndOfList do ReadProperty(value);
end; 


{ TmxJsCollection } 

procedure TmxJsCollection.DefineProperties(Filer: TFiler);
begin
  inherited;
  // collection-items standardmässig als dynamische 
  // property definieren!
  Filer.DefineProperty('items',ReadItems,WriteItems,count>0);
end;

procedure TmxJsCollection.ReadItems(Reader: TReader);
begin
  Reader.ReadValue;
  Reader.ReadCollection(self);
end;

procedure TmxJsCollection.WriteItems(Writer: TWriter);
begin
  Writer.WriteCollection(self);
end;

procedure TmxJsCollection.LoadFromStream(aStream: TStream);
var Reader       : TReaderExt; 
    StreamInner  : TStream; 
    format       : TStreamOriginalFormat; 
    oldPos       : Int64; 
    SigBuffer    : array[1..4] of Char; 
    isBinary     : boolean; 
begin 
  // automatisch feststellen ob binär oder text 
  oldPos := aStream.Position; 
  aStream.ReadBuffer(SigBuffer[1],sizeOf(SigBuffer)); 
  isBinary := SigBuffer = FilerSignatureEx; 
  aStream.Position := oldPos; 
  
  if isBinary 
  then StreamInner := aStream 
  else StreamInner := TMemoryStream.Create;  
              
  try    
    // DFM-text parsen 
    if not isBinary then 
    begin 
      format := sofBinary;                              
      ObjectTextToBinary(aStream,StreamInner,format); 
      StreamInner.Position := 0; 
    end;  
                          
    Reader := TReaderExt.Create(StreamInner,iFilerBufferSize);      
    try 
      Reader.ReadSignature;  
      Reader.ReadStr; // ClassName            
      FCollectionname := Reader.ReadStr; // Collectionname  

      Reader.ReadCollectionProperties(self);

      Reader.ReadListEnd;                              
      Reader.ReadListEnd;            
    finally 
      Reader.Free; 
    end; 
  finally 
    if not isBinary then StreamInner.Free; 
  end; 
end; 


procedure TmxJsCollection.SaveToStream(aStream: TStream);
var Writer       : TWriterExt; 
    StreamInner  : TStream; 
    format       : TStreamOriginalFormat;          
begin              
  if FAsBinary 
  then StreamInner := aStream 
  else StreamInner := TMemoryStream.Create;  
                
  try                                                      
    Writer := TWriterExt.Create(StreamInner,iFilerBufferSize);        
    try          
      Writer.WriteSignature; 
      Writer.WriteStr(ClassName);                    
      Writer.WriteStr(Collectionname);    

      Writer.WriteCollectionProperties(self);

      Writer.WriteListEnd; 
      Writer.WriteListEnd;                                  
    finally 
      Writer.Free; 
    end; 
    // DFM-text konversion 
    if not FAsBinary then 
    begin 
      StreamInner.Position := 0;  
      format := sofText;                                
      ObjectBinaryToText(StreamInner,aStream,format); 
    end;        
  finally 
    if not FAsBinary then StreamInner.Free; 
  end; 
end; 

end.

Was meinst du dazu?

[maximov]

Wollt nur mal schnell sagen, dass wir noch nicht fertig sind, wir entwickeln momentan per PN weiter und posten dann das 'endgültige' ergebnis dieser tollen unit :-D

[Jens Schumann]

Zitat:

Zitat von maximov

Wollt nur mal schnell sagen, dass wir noch nicht fertig sind, wir entwickeln momentan per PN weiter und posten dann das 'endgültige' ergebnis dieser tollen unit :-D

Genau

Die D5 unit habe ich fertig und getest.
Mit der D7 unit habe ich das Problem, des mit unterschiedlichen TCollectionItem Nachfahren mal funktioniert und mal nicht :freak:

[maximov]

Zeig mal her. Ich kann ja mal ein härtetest machen :wall: