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