#1 30.01.2005 18:00:39

maximov
Member
Ort: Hamburg
Registriert: 25.01.2005
Beiträge: 84

dpCollection.pas - Collection serialisieren

dpCollection - Collection serialisieren

-> Diese klassen sind in zusammenarbeit mit Jens Schuhmann und mir, in der DelphiPraxis entstanden.
-> http://www.delphipraxis.net/topic28945_tcollection+und+tcollectionitem.html
-> Wir erteilen hiermit allen mitgliedern von DelphiDev.de die uneingeschränkte nutzung der dpCollection.pas!

---

Mit der klasse TmxJsCollection und TJsCollection ist es möglich serielle datenstrukturen, jeglicher typen und komplexität, zu streamen. Hierzu wird das Delphi-component-streaming-system benutzt, kombiniert mit einem kleinen fake-trick. Dabei kann im binär format, als auch im text-dfm format gespeichert werden!

Dazu stehen folgende methoden zur verfügung:

Code: delphi

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



Bei verwendung dieser methoden werden alle Items, einer selbst abgeleiteten TCollectionItem klasse automatisch gespeichert oder geladen. Beim laden werden die items automatisch instanziert und deren published properties gesetzt. Beim speichern werden alle published properties verwendet, bei denen der wert vom default-wert abweicht - bzw. nicht stored false ist - bzw. die nicht readOnly sind.

Diese beispiel klasse...

Code: delphi

  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;



...produziert folgenden output:

Code: delphi

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




Das soll aber nicht heissen, dass man keine normalen properties oder binäre daten speichern kann! Denn zu diesem zweck kann, in der item-klasse, die methode DefineProperties überschrieben werden. Mehr dazu in der Delphi hilfe.

Desweiteren werden auch object properties, die von TPersistent abgeleitet sind, mit qualifizierer (.) geschrieben. und TBitmaps sind auch kein problem, dadurch werden die text-DFMs jedoch sehr gross, deshalb sollte bei grösseren bildern die property Binary true benutzt werden. Text-DFM-streaminng steht nur ab der klasse TmxJsCollection zur verfügung.

Beim instanzieren der Collection wird die eigene item klasse übergeben, wie üblich:

Code: delphi

mycollection := tmxcollection.create(tmxcustomitem);



Die benutzung ist sehr einfach und sollte selbsterklärend sein:

Code: delphi

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


Alles weitere in der Delphi hilfe unter TCollection.

Code: delphi

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



viel spass damit.


Attachments:
Attachment Icon dpCollection.pas, Größe: 7,467 bytes, Downloads: 1,122

maximov (aka maDXam or IDKFA)

Offline

 

Brett Fußzeile

Powered by PunBB
© Copyright 2002–2005 Rickard Andersson