procedure savetofile(const filename : tfilename); 
procedure savetostream(stream : tstream); virtual; 
procedure loadfromfile(const filename : tfilename); 
procedure loadfromstream(stream : tstream); virtual;

  tmxcustomitem = class(tcollectionitem)
  private
    ...
  published            
    property aboolean : boolean read faboolean  write faboolean;
    property aninteger : integer read faninteger  write faninteger;
    property anotherinteger : integer read fanotherinteger  write fanotherinteger default 0;     
    property anextended : extended read fanextended  write fanextended; 
    property anenum :  tfilerflag read fanenum  write fanenum; 
    property aset : tfilerflags read faset  write faset;     
    property astring : string read fastring write fastring stored false;      
  end;

object mxcustomitems: tmxcollection
  items = <
    item
      aboolean = true
      aninteger = 5
      anotherinteger = 666
      anextended = 1.234560000000000000
      anenum = ffchildpos
      aset = [ffchildpos,ffinline]
    end
    ...
    ...
    ...
    item
      aboolean = false
      aninteger = 3
      anextended = 111.000000000000000000
      anenum = ffinline
      aset = []
    end>
end

mycollection := tmxcollection.create(tmxcustomitem);

mycollection.savetofile('c:/data.dfm');
 ...
mycollection.loadfromfile('c:/data.dfm');

//----------------------------------------------------------------------------- 
// Unit Name       : dpCollection 
// Author          : Jens Schumann und MaxHub (maximov) 
// Copyright       : alle 
// Purpose         : Collection object serialization 
// History         : 19.05.2004, 08:45 - first blue bord version 
// Delphi Version  : D5, D7, D8 
//----------------------------------------------------------------------------- 
// 
//----------------------------------------------------------------------------- 
// Unterschied zwischen D5 und D7 
// 
// Wenn ein TCollectionItem eine TJsCollection oder TmxJsCollection property 
// hat (In diesen Beispiel wäre das die TD7CollectionItem Property Numbers in 
// der unit collectionitems_impl), so werden deren published properties nicht 
// von D5 gestreamt. 
// Es können die Dateien aber von beiden Versionen (D5/D7) gelesen werden. 
// 
//----------------------------------------------------------------------------- 

unit dpcollection; 

interface 

uses sysutils, classes; 

type 

  tjscollection = class(tcollection) 
  private 
    fcollectionname : string; 
    procedure setcollectionname(const value: string); 
    function getcollectionname: 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 
    
  published 
    property collectionname : string read getcollectionname write setcollectionname; 
  end; 

  tmxjscollection = class(tjscollection) 
  private 
    fbinary : boolean; 
  public 
    procedure loadfromstream(astream: tstream); override; 
    procedure savetostream(astream: tstream); override; 
    // binary ist beim laden der indikator ob es ein binär oder text stream war, 
    // und beim speichern welches das ziel-format sein soll. 
    property  binary : boolean read fbinary write fbinary; 
  published 
    property collectionname stored false; 
  end; 
      

  twriterext = class(twriter) 
  public 
    procedure writecollectionproperties(value : tcollection); 
  end; 

  treaderext = class(treader) 
  public 
    procedure readcollectionproperties(value: tcollection); 
  end; 


implementation 

uses typinfo; 

const 
  ifilerbuffersize = 4096; 
  filersignatureex: string = 'TPF0'; 
  cinvalidname = ' is not a valid CollectionName!'; 

{ TJsCollection } 




procedure tjscollection.assign(source: tpersistent); 
begin 
  if source is tjscollection then 
    fcollectionname:=tjscollection(source).collectionname; 
  inherited assign(source); 
end; 

function tjscollection.getcollectionname: string; 
begin 
  if fcollectionname = '' 
  then result := copy(classname,2,length(classname)-1) 
  else result := fcollectionname; 
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.readcollectionproperties(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.writecollectionproperties(self); 
    writer.writelistend; 
  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.writecollectionproperties(value: tcollection); 
begin 
  writeproperties(value); 
  writestr('items'); 
  inherited writecollection(value); 
end; 

{ TReaderExt } 

procedure treaderext.readcollectionproperties(value: tcollection); 
var propname:string; 
    oldpos:integer; 
begin 
  while not endoflist do 
  begin 
    oldpos :=  position; 
    propname := readstr; 
    if propname = 'items' then 
    begin 
      readvalue; 
      inherited readcollection(value); 
    end else  begin 
      position := oldpos; 
      readproperty(value); 
    end; 
  end; 
end; 


{ TmxJsCollection } 

procedure tmxjscollection.loadfromstream(astream: tstream); 
var reader       : treaderext; 
    streaminner  : tstream; 
    format       : tstreamoriginalformat; 
    oldpos       : int64; 
    sigbuffer    : array[1..4] of char; 
begin 
  // automatisch feststellen ob binär oder text 
  oldpos := astream.position; 
  astream.readbuffer(sigbuffer[1],sizeof(sigbuffer)); 
  fbinary := sigbuffer = filersignatureex; 
  astream.position := oldpos; 

  if fbinary 
  then streaminner := astream 
  else streaminner := tmemorystream.create; 
              
  try    
    // DFM-text parsen 
    if not fbinary 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 fbinary then streaminner.free; 
  end; 
end; 


procedure tmxjscollection.savetostream(astream: tstream); 
var writer       : twriterext; 
    streaminner  : tstream; 
    format       : tstreamoriginalformat;          
begin              
  if fbinary 
  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 fbinary then 
    begin 
      streaminner.position := 0; 
      format := softext;                                
      objectbinarytotext(streaminner,astream,format); 
    end;        
  finally 
    if not fbinary then streaminner.free; 
  end; 
end; 

end.