amxmodx/editor/studio/UnitACCheck.pas

270 lines
6.2 KiB
ObjectPascal
Raw Normal View History

unit UnitACCheck;
// collection component 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 AfterConstruction; override;
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
FBinary : Boolean;
public
procedure LoadFromStream(aStream: TStream); override;
procedure SaveToStream(aStream: TStream); override;
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;
TACFunction = class(TCollectionItem)
private
FName: String;
FItems: TStringList;
published
property Name: String read FName write FName;
property Items: TStringList read FItems write FItems;
public
constructor Create(ACollection: TCollection); override;
destructor Destroy; override;
end;
var eACList: TmxJsCollection;
implementation
uses TypInfo;
const
iFilerBufferSize = 4096;
FilerSignatureEx: array[1..4] of Char = 'TPF0';
cInvalidName = ' is not a valid CollectionName!';
{ TJsCollection }
procedure TJsCollection.AfterConstruction;
begin
inherited;
FCollectionname := copy(className,2,length(className)-1)
end;
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.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<69>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
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;
if not FBinary then
begin
StreamInner.Position := 0;
format := sofText;
ObjectBinaryToText(StreamInner,aStream,format);
end;
finally
if not FBinary then StreamInner.Free;
end;
end;
{ TACFunction }
constructor TACFunction.Create(ACollection: TCollection);
begin
inherited;
FItems := TStringList.Create;
end;
destructor TACFunction.Destroy;
begin
FItems.Free;
inherited;
end;
end.