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.