TCollection und TCollectionItem

[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 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: TCollection = class(TPersistent)

[mirage228]

Zitat von Jens Schumann:

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: TCollection = class(TPersistent)

Also geht RTTI damit ja doch!

mfG
mirage228

[Jens Schumann]

Zitat von mirage228:

Zitat von Jens Schumann:

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: 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 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

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 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 ..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 ..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.

auf die gute team-arbeit.


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

[Jens Schumann]

Zitat von maximov:

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 der mir gefehlt hatte.

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