david
2824855ea7
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 - Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
1051 lines
37 KiB
ObjectPascal
1051 lines
37 KiB
ObjectPascal
unit uROStreamSerializer;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ RemObjects SDK Library - Core Library }
|
|
{ }
|
|
{ compiler: Delphi 5 and up, Kylix 2 and up }
|
|
{ platform: Win32, Linux }
|
|
{ }
|
|
{ (c)opyright RemObjects Software. all rights reserved. }
|
|
{ }
|
|
{ Using this code requires a valid license of the RemObjects SDK }
|
|
{ which can be obtained at http://www.remobjects.com. }
|
|
{----------------------------------------------------------------------------}
|
|
|
|
|
|
{$I RemObjects.inc}
|
|
|
|
{$IFDEF DOTNET}
|
|
{$MESSAGE error 'This unit will not be used in .NET, use RemObjects.SDK.StreamSerializer instead' }
|
|
{$ENDIF}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF REMOBJECTS_TRIAL}uROTrial,{$ENDIF}
|
|
{$IFDEF DEBUG_REMOBJECTS_BINMESSAGE_LOWLEVEL}eDebugServer,{$ENDIF}
|
|
Classes, SysUtils, TypInfo,
|
|
uROTypes, uROSerializer, FMTBcd;
|
|
|
|
|
|
type
|
|
{ TROStreamSerializer }
|
|
TROStreamSerializer = class(TROSerializer)
|
|
private
|
|
fStream : TStream;
|
|
|
|
protected
|
|
procedure BeginWriteObject(const aName: string; aClass : TClass; anObject: TObject; var LevelRef : IUnknown;
|
|
var IsValidType : boolean; out IsAssigned:Boolean; ArrayElementId : integer = -1); override;
|
|
procedure EndWriteObject(const aName: string; aClass : TClass; anObject: TObject; const LevelRef : IUnknown); override;
|
|
procedure CustomWriteObject(const aName : string; aClass : TClass; const Ref; ArrayElementId : integer = -1); override;
|
|
procedure CustomReadObject(const aName: string; aClass: TClass;var Ref; ArrayElementId: integer);override;
|
|
procedure BeginReadObject(const aName : string; aClass : TClass; var anObject : TObject; var LevelRef : IUnknown;
|
|
var IsValidType : boolean; ArrayElementId : integer = -1); override;
|
|
procedure EndReadObject(const aName : string; aClass : TClass; var anObject : TObject; const LevelRef : IUnknown); override;
|
|
Public
|
|
{ Writers }
|
|
procedure WriteInteger(const aName : string; anOrdType : TOrdType; const Ref; ArrayElementId : integer = -1); override;
|
|
procedure WriteInt64(const aName : string; const Ref; ArrayElementId : integer = -1); override;
|
|
procedure WriteEnumerated(const aName : string; anEnumTypeInfo : PTypeInfo; const Ref; ArrayElementId : integer = -1); override;
|
|
procedure WriteUTF8String(const aName : string; const Ref; ArrayElementId : integer = -1); override;
|
|
procedure WriteWideString(const aName : string; const Ref; ArrayElementId : integer = -1); override;
|
|
procedure WriteDateTime(const aName : string; const Ref; ArrayElementId : integer = -1); override;
|
|
procedure WriteDouble(const aName : string; aFloatType : TFloatType; const Ref; ArrayElementId : integer = -1); override;
|
|
procedure WriteVariant(const aName : string; const Ref; ArrayElementId : integer = -1); override;
|
|
procedure WriteXml(const aName : string; const Ref; ArrayElementId : integer = -1); override;
|
|
procedure WriteGuid(const aName: String; const Ref; ArrayElementId: Integer = -1); override;
|
|
procedure WriteDecimal(const aName: String; const Ref; ArrayElementId: Integer = -1); override;
|
|
procedure WriteBinary(const aName : string; const Ref; ArrayElementId : integer = -1); override;
|
|
procedure WriteStruct(const aName : string; const Ref; ArrayElementId : integer = -1); override;
|
|
procedure WriteArray(const aName : string; const Ref; ArrayElementId : integer = -1); override;
|
|
procedure WriteException(const aName : string; const Ref; ArrayElementId : integer = -1); override;
|
|
|
|
{ Readers }
|
|
{$IFDEF DEBUG_REMOBJECTS_BINMESSAGE_LOWLEVEL}
|
|
procedure Read(const aName : string; aTypeInfo : PTypeInfo; var Ptr; ArrayElementId : integer = -1); override;
|
|
{$ENDIF DEBUG_REMOBJECTS_BINMESSAGE_LOWLEVEL}
|
|
procedure ReadInteger(const aName : string; anOrdType : TOrdType; var Ref; ArrayElementId : integer = -1); override;
|
|
procedure ReadInt64(const aName : string; var Ref; ArrayElementId : integer = -1); override;
|
|
procedure ReadEnumerated(const aName : string; anEnumTypeInfo : PTypeInfo; var Ref; ArrayElementId : integer = -1); override;
|
|
procedure ReadUTF8String(const aName : string; var Ref; ArrayElementId : integer = -1; iMaxLength:integer=-1); override;
|
|
procedure ReadWideString(const aName : string; var Ref; ArrayElementId : integer = -1; iMaxLength:integer=-1); override;
|
|
procedure ReadDateTime(const aName : string; var Ref; ArrayElementId : integer = -1); override;
|
|
procedure ReadDouble(const aName : string; aFloatType : TFloatType; var Ref; ArrayElementId : integer = -1); override;
|
|
procedure ReadVariant(const aName : string; var Ref; ArrayElementId : integer = -1); override;
|
|
procedure ReadXml(const aName : string; var Ref; ArrayElementId : integer = -1); override;
|
|
procedure ReadDecimal(const aName: String; var Ref; ArrayElementId: Integer = -1); override;
|
|
procedure ReadGuid(const aName: String; var Ref; ArrayElementId: Integer = -1); override;
|
|
procedure ReadBinary(const aName : string; var Ref; ArrayElementId : integer = -1); override;
|
|
function ReadStruct(const aName : string; aClass : TClass; var Ref; ArrayElementId : integer = -1): Boolean; override;
|
|
function ReadArray(const aName : string; aClass : TClass; var Ref; ArrayElementId : integer = -1): Boolean; override;
|
|
procedure ReadException(const aName : string; var Ref; ArrayElementId : integer = -1); override;
|
|
public
|
|
procedure SetStorageRef(aStorageRef:TStream);
|
|
constructor Create(aStorageRef:TStream); virtual;
|
|
|
|
end;
|
|
|
|
{ binary structuire for streaming DateTime to BinMessage, starting with format version 1.0.7 }
|
|
TDateTimeStructure = packed record
|
|
Year:Word;
|
|
Month:Byte;
|
|
Day:Byte;
|
|
Hour:Byte;
|
|
Minute:Byte;
|
|
Seconds:Byte;
|
|
MiliSeconds:word;
|
|
end;
|
|
|
|
procedure ObjectToStream(anObject : TROComplexType; aStream : TStream);
|
|
function StreamToObject(aStream : TStream) : TROComplexType;
|
|
|
|
function StreamToVariant(Stream: TStream): {$IFDEF FPC}Variant;{$ELSE}OleVariant;{$ENDIF}
|
|
procedure VariantToStream(const Data: {$IFDEF FPC}Variant;{$ELSE}OleVariant;{$ENDIF} Stream: TStream);
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF DEBUG_REMOBJECTS}eDebugServer,{$ENDIF}
|
|
{$IFDEF FPC} Variants, {$ENDIF}
|
|
{$IFDEF VER140UP} {$IFNDEF FPC}Variants,{$ENDIF} DateUtils, {$ENDIF}
|
|
uRORes, uROClient, uROClientIntf, uROBinaryHelpers, uROClasses,
|
|
uROXMLIntf{$IFDEF LINUX}{$IFNDEF FPC}, ComObj{$ENDIF}{$ENDIF};
|
|
|
|
|
|
function StreamToVariant(Stream: TStream): {$IFDEF FPC}Variant{$ELSE}OleVariant{$ENDIF};
|
|
var p: Pointer;
|
|
begin
|
|
Result := VarArrayCreate([0, Stream.Size - 1], varByte);
|
|
p := VarArrayLock(Result);
|
|
try
|
|
Stream.Position := 0; //start from beginning of stream
|
|
Stream.ReadBuffer(p^, Stream.Size);
|
|
finally
|
|
VarArrayUnlock(Result);
|
|
end;
|
|
end;
|
|
|
|
procedure VariantToStream(const Data: {$IFDEF FPC}Variant{$ELSE}OleVariant{$ENDIF}; Stream: TStream);
|
|
var p: Pointer;
|
|
begin
|
|
p := VarArrayLock(Data);
|
|
try
|
|
Stream.Write(p^, VarArrayHighBound(Data, 1) + 1); //assuming low bound = 0
|
|
finally
|
|
VarArrayUnlock(Data);
|
|
end;
|
|
end;
|
|
|
|
procedure ObjectToStream(anObject : TROComplexType; aStream : TStream);
|
|
var clsname : string;
|
|
begin
|
|
with TROStreamSerializer.Create(aStream) do try
|
|
clsname := anObject.ClassName;
|
|
|
|
Write('', TypeInfo(string), clsname);
|
|
Write('', anObject.ClassInfo, anObject);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
function StreamToObject(aStream : TStream) : TROComplexType;
|
|
var clsname : string;
|
|
cls : TROComplexTypeClass;
|
|
begin
|
|
result := nil;
|
|
with TROStreamSerializer.Create(aStream) do try
|
|
Read('', TypeInfo(string), clsname);
|
|
cls := FindROClass(clsname);
|
|
if (cls=NIL) then RaiseError(err_UnknownClass, [clsname]);
|
|
Read('', cls.ClassInfo, result);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
{ TROStreamSerializer }
|
|
|
|
constructor TROStreamSerializer.Create(aStorageRef: TStream);
|
|
begin
|
|
inherited Create();
|
|
SetStorageRef(aStorageRef);
|
|
end;
|
|
|
|
procedure TROStreamSerializer.SetStorageRef(aStorageRef: TStream);
|
|
begin
|
|
//result := TObject(aStorageRef) is TStream;
|
|
//if result then fStream := TStream(aStorageRef);
|
|
fStream := aStorageRef;
|
|
end;
|
|
|
|
procedure TROStreamSerializer.EndReadObject(const aName: string;
|
|
aClass : TClass; var anObject: TObject; const LevelRef : IUnknown);
|
|
begin
|
|
inherited;
|
|
{$IFDEF DEBUG_REMOBJECTS_BINMESSAGE_LOWLEVEL}
|
|
DebugServer.Write('TROStreamSerializer.EndReadObject(name=%s, position before =$%x',[aName, fStream.Position]);
|
|
{$ENDIF DEBUG_REMOBJECTS_BINMESSAGE_LOWLEVEL}
|
|
end;
|
|
|
|
procedure TROStreamSerializer.EndWriteObject(const aName: string;
|
|
aClass : TClass; anObject: TObject; const LevelRef : IUnknown);
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
procedure TROStreamSerializer.ReadDateTime(const aName: string; var Ref; ArrayElementId : integer = -1);
|
|
{var lDateTime:TDateTime absolute Ref;
|
|
lDateTimeStructure:TDateTimeStructure;
|
|
//m,d,h,n,s:Word;}
|
|
begin
|
|
{$IFDEF DEBUG_REMOBJECTS_BINMESSAGE_LOWLEVEL}
|
|
DebugServer.Write('TROStreamSerializer.ReadDateTime(name=%s, position before =$%x, size=$%x',[aName, fStream.Position, SizeOf(TDateTime)]);
|
|
{$ENDIF DEBUG_REMOBJECTS_BINMESSAGE_LOWLEVEL}
|
|
ReadDouble(aName,ftDouble,Ref,-1);
|
|
{fStream.Read(lDateTimeStructure, SizeOf(TDateTimeStructure));
|
|
if not TryEncodeDateTime(lDateTimeStructure.Year, lDateTimeStructure.Month, lDateTimeStructure.Day,
|
|
lDateTimeStructure.Hour, lDateTimeStructure.Minute, lDateTimeStructure.Seconds,
|
|
lDateTimeStructure.MiliSeconds, lDateTime) then
|
|
RaiseError(err_InvalidDateTimeReadFromStream,[]);}
|
|
end;
|
|
|
|
procedure TROStreamSerializer.ReadEnumerated(const aName: string; anEnumTypeInfo: PTypeInfo; var Ref; ArrayElementId : integer = -1);
|
|
var lInteger:Integer;
|
|
begin
|
|
{$IFDEF DEBUG_REMOBJECTS_BINMESSAGE_LOWLEVEL}
|
|
DebugServer.Write('TROStreamSerializer.ReadEnumerated(name=%s, position before =$%x, size=$%x',[aName, fStream.Position, SizeOf(byte)]);
|
|
{$ENDIF DEBUG_REMOBJECTS_BINMESSAGE_LOWLEVEL}
|
|
|
|
fStream.ReadBuffer(lInteger, SizeOf(integer));
|
|
Byte(Ref) := Lo(lInteger);
|
|
end;
|
|
|
|
procedure TROStreamSerializer.ReadDouble(const aName: string;
|
|
aFloatType: TFloatType; var Ref; ArrayElementId : integer = -1);
|
|
var sze : byte;
|
|
src : pointer;
|
|
begin
|
|
src := @Ref;
|
|
sze := 0;
|
|
case aFloatType of
|
|
ftSingle : sze := SizeOf(single);
|
|
ftDouble : sze := SizeOf(double);
|
|
ftExtended : sze := SizeOf(extended);
|
|
ftComp : sze := SizeOf(comp);
|
|
ftCurr :sze := SizeOf(currency);
|
|
end;
|
|
|
|
{$IFDEF DEBUG_REMOBJECTS_BINMESSAGE_LOWLEVEL}
|
|
DebugServer.Write('TROStreamSerializer.ReadFloat(name=%s, position before =$%x, size=$%x',[aName, fStream.Position,sze]);
|
|
{$ENDIF DEBUG_REMOBJECTS_BINMESSAGE_LOWLEVEL}
|
|
|
|
fStream.ReadBuffer(src^, sze);
|
|
end;
|
|
|
|
procedure TROStreamSerializer.ReadInt64(const aName: string; var Ref; ArrayElementId : integer = -1);
|
|
begin
|
|
{$IFDEF DEBUG_REMOBJECTS_BINMESSAGE_LOWLEVEL}
|
|
DebugServer.Write('TROStreamSerializer.ReadInt64(name=%s, position before =$%x, size=$%x',[aName, fStream.Position, SizeOf(Int64)]);
|
|
{$ENDIF DEBUG_REMOBJECTS_BINMESSAGE_LOWLEVEL}
|
|
|
|
fStream.ReadBuffer(Ref, SizeOf(Int64));
|
|
end;
|
|
|
|
procedure TROStreamSerializer.ReadInteger(const aName: string;
|
|
anOrdType: TOrdType; var Ref; ArrayElementId : integer = -1);
|
|
var sze : byte;
|
|
src : pointer;
|
|
begin
|
|
src := @Ref;
|
|
sze := 0;
|
|
case anOrdType of
|
|
otSByte,
|
|
otUByte : sze := SizeOf(byte);
|
|
otSWord,
|
|
otUWord : sze := SizeOf(word);
|
|
otSLong,
|
|
otULong : sze := SizeOf(integer);
|
|
end;
|
|
{$IFDEF DEBUG_REMOBJECTS_BINMESSAGE_LOWLEVEL}
|
|
DebugServer.Write('TROStreamSerializer.ReadInteger(name=%s, position before =$%x, size=$%x',[aName, fStream.Position,sze]);
|
|
{$ENDIF DEBUG_REMOBJECTS_BINMESSAGE_LOWLEVEL}
|
|
fStream.ReadBuffer(src^, sze);
|
|
end;
|
|
|
|
procedure TROStreamSerializer.ReadUTF8String(const aName: string; var Ref; ArrayElementId : integer = -1; iMaxLength:integer=-1);
|
|
var sze : integer;
|
|
begin
|
|
|
|
{$IFDEF DEBUG_REMOBJECTS_BINMESSAGE_LOWLEVEL}
|
|
DebugServer.Write('TROStreamSerializer.ReadString 1(name=%s, position before =$%x',[aName, fStream.Position]);
|
|
{$ENDIF DEBUG_REMOBJECTS_BINMESSAGE_LOWLEVEL}
|
|
|
|
fStream.ReadBuffer(sze, SizeOf(sze));
|
|
//ToDo: we need some code here to avoid hacker attachs with too long strings
|
|
|
|
{$IFDEF DEBUG_REMOBJECTS_BINMESSAGE_LOWLEVEL}
|
|
DebugServer.Write('TROStreamSerializer.ReadString 2(name=%s, position before =$%x, size=$%x',[aName, fStream.Position,sze]);
|
|
{$ENDIF DEBUG_REMOBJECTS_BINMESSAGE_LOWLEVEL}
|
|
|
|
if ((iMaxLength > -1) and (sze > iMaxLength)) or
|
|
(sze > fStream.Size) then
|
|
RaiseError(err_InvalidStringLength,[sze]);
|
|
|
|
if (sze>0) then begin
|
|
SetLength(string(Ref), sze);
|
|
fStream.ReadBuffer(string(Ref)[1], sze);
|
|
end
|
|
else string(Ref) := '';
|
|
end;
|
|
|
|
procedure TROStreamSerializer.ReadWideString(const aName: string; var Ref; ArrayElementId : integer = -1; iMaxLength:integer=-1);
|
|
var sze : integer;
|
|
begin
|
|
{$IFDEF DEBUG_REMOBJECTS_BINMESSAGE_LOWLEVEL}
|
|
DebugServer.Write('TROStreamSerializer.ReadWideString 1(name=%s, position before =$%x',[aName, fStream.Position]);
|
|
{$ENDIF DEBUG_REMOBJECTS_BINMESSAGE_LOWLEVEL}
|
|
|
|
fStream.ReadBuffer(sze, SizeOf(sze));
|
|
|
|
if ((iMaxLength > -1) and (sze > iMaxLength)) or
|
|
(sze*2 > fStream.Size) then
|
|
RaiseError(err_InvalidStringLength,[sze]);
|
|
|
|
{$IFDEF DEBUG_REMOBJECTS_BINMESSAGE_LOWLEVEL}
|
|
DebugServer.Write('TROStreamSerializer.ReadWideString 2(name=%s, position before =$%x, size=$%x, length=$%x',[aName, fStream.Position,sze,sze*2]);
|
|
{$ENDIF DEBUG_REMOBJECTS_BINMESSAGE_LOWLEVEL}
|
|
|
|
if (sze>0) then begin
|
|
SetLength(widestring(Ref), sze);
|
|
fStream.ReadBuffer(widestring(Ref)[1], sze*2);
|
|
end
|
|
else widestring(Ref) := '';
|
|
end;
|
|
|
|
procedure TROStreamSerializer.WriteDateTime(const aName: string; const Ref; ArrayElementId : integer = -1);
|
|
{var lDateTime:TDateTime absolute Ref;
|
|
lDateTimeStructure:TDateTimeStructure;
|
|
m,d,h,n,s:Word;}
|
|
begin
|
|
WriteDouble(aName,ftDouble,Ref,-1);
|
|
{DecodeDateTime(lDateTime,lDateTimeStructure.Year,m,d,h,n,s,lDateTimeStructure.MiliSeconds);
|
|
lDateTimeStructure.Month := m;
|
|
lDateTimeStructure.Day := d;
|
|
lDateTimeStructure.Hour := h;
|
|
lDateTimeStructure.Minute := n;
|
|
lDateTimeStructure.Seconds := s;
|
|
fStream.Write(lDateTimeStructure, SizeOf(TDateTimeStructure));}
|
|
end;
|
|
|
|
procedure TROStreamSerializer.WriteEnumerated(const aName: string; anEnumTypeInfo: PTypeInfo; const Ref; ArrayElementId : integer = -1);
|
|
var lInteger:Integer;
|
|
begin
|
|
lInteger := Byte(Ref);
|
|
fStream.Write(lInteger, SizeOf(integer)); // TODO: check enums bigger than a byte!
|
|
end;
|
|
|
|
procedure TROStreamSerializer.WriteDouble(const aName: string;
|
|
aFloatType: TFloatType; const Ref; ArrayElementId : integer = -1);
|
|
var sze : byte;
|
|
src : pointer;
|
|
begin
|
|
{ ToDo: make sure a double is always marshaled in some .NET compatible format (IEEE).
|
|
Only differentiate between Double and Currency, convert all the rest to double.
|
|
Handle Currency as Int64. Also adjust WriteFloat appropriately. }
|
|
|
|
src := @Ref;
|
|
sze := 0;
|
|
case aFloatType of
|
|
ftSingle : sze := SizeOf(single);
|
|
ftDouble : sze := SizeOf(double);
|
|
ftExtended : sze := SizeOf(extended);
|
|
ftComp : sze := SizeOf(comp);
|
|
ftCurr : sze := SizeOf(currency);
|
|
end;
|
|
|
|
fStream.Write(src^, sze);
|
|
end;
|
|
|
|
procedure TROStreamSerializer.WriteInt64(const aName: string; const Ref; ArrayElementId : integer = -1);
|
|
begin
|
|
fStream.Write(Ref, SizeOf(Int64));
|
|
end;
|
|
|
|
procedure TROStreamSerializer.WriteInteger(const aName: string;
|
|
anOrdType: TOrdType; const Ref; ArrayElementId : integer = -1);
|
|
var sze : byte;
|
|
src : pointer;
|
|
begin
|
|
{ ToDo: make sure a Integer is always marshaled as Int32 }
|
|
|
|
src := @Ref;
|
|
sze := 0;
|
|
case anOrdType of
|
|
otSByte,
|
|
otUByte : sze := SizeOf(byte);
|
|
otSWord,
|
|
otUWord : sze := SizeOf(word);
|
|
otSLong,
|
|
otULong : sze := SizeOf(integer);
|
|
end;
|
|
|
|
fStream.Write(src^, sze);
|
|
end;
|
|
|
|
procedure TROStreamSerializer.WriteUTF8String(const aName: string; const Ref; ArrayElementId : integer = -1);
|
|
var sze : integer;
|
|
begin
|
|
sze := Length(string(Ref));
|
|
fStream.Write(sze, SizeOf(sze));
|
|
if (sze>0) then fStream.Write(string(Ref)[1], sze);
|
|
end;
|
|
|
|
procedure TROStreamSerializer.WriteWideString(const aName: string;
|
|
const Ref; ArrayElementId : integer = -1);
|
|
var sze : integer;
|
|
begin
|
|
sze := Length(widestring(Ref));
|
|
fStream.Write(sze, SizeOf(sze));
|
|
if (sze>0) then fStream.Write(widestring(Ref)[1], sze*2);
|
|
end;
|
|
|
|
procedure TROStreamSerializer.BeginReadObject(const aName: string; aClass : TClass; var anObject: TObject; var LevelRef : IUnknown; var IsValidType : boolean; ArrayElementId : integer = -1);
|
|
var IsAssigned : ByteBool;
|
|
clsnme : string;
|
|
cnt : integer;
|
|
|
|
lActualClass:TROComplexTypeClass;
|
|
struct: IROCustomStreamableClass;
|
|
|
|
begin
|
|
//IsValidType := false; check if we need to init this!?
|
|
|
|
inherited;
|
|
|
|
//fStream.Read(IsAssigned, SizeOf(IsAssigned));
|
|
|
|
|
|
{ ToDo -omh: provide a hook here so the app can cleanly provide custom complx types to be used, instead of
|
|
relying on them being assigned by the caller (which is bad))
|
|
|
|
FindROClass should be ablt to provide this capability. }
|
|
|
|
{ ToDo -omh: MUCH this should be moved into common code in TROSerializer so ALL messages benbefit from it? }
|
|
|
|
if Assigned(anObject) and (anObject.GetInterfaceEntry(IROCustomStreamableType) <> nil) then begin
|
|
if anObject.GetInterface(IROCustomStreamableArray, struct) then begin
|
|
fStream.ReadBuffer(IsAssigned, SizeOf(IsAssigned));
|
|
if IsAssigned then begin
|
|
ReadInteger('', otULong, cnt);
|
|
Struct.SetNull(false);
|
|
IROCustomStreamableArray(pointer(Struct)).Count := cnt;
|
|
end
|
|
else begin
|
|
struct.SetNull(true);
|
|
end;
|
|
IsValidType := True;
|
|
end
|
|
else if anObject.GetInterface(IROCustomStreamableStruct, struct) then begin
|
|
fStream.ReadBuffer(IsAssigned, SizeOf(IsAssigned));
|
|
if IsAssigned then begin
|
|
ReadUTF8String('', clsnme,-1,MAX_ITEM_NAME);
|
|
if not struct.CanImplementType(clsnme) then RaiseError(err_UnknownClassInStream,[clsnme,aClass.ClassName]);
|
|
Struct.SetNull(false);
|
|
Struct.TypeName := clsnme;
|
|
end
|
|
else begin
|
|
struct.SetNull(true);
|
|
end;
|
|
IsValidType := True;
|
|
end
|
|
else if anObject.GetInterface(IROCustomStreamableEnum, struct) then begin
|
|
IsValidType := True;
|
|
end;
|
|
end
|
|
else if aClass.InheritsFrom(TROArray) then begin
|
|
fStream.ReadBuffer(IsAssigned, SizeOf(IsAssigned));
|
|
if IsAssigned then begin
|
|
anObject := aClass.Create();
|
|
ReadInteger('', otULong, cnt);
|
|
TROArray(anObject).Resize(cnt);
|
|
end;
|
|
IsValidType := true;
|
|
end
|
|
else if aClass.InheritsFrom(TStream) then begin
|
|
fStream.ReadBuffer(IsAssigned, SizeOf(IsAssigned));
|
|
if not Assigned (anObject) then begin
|
|
if IsAssigned then
|
|
anObject := TROBinaryMemoryStream.Create;
|
|
end
|
|
else begin
|
|
if IsAssigned then begin
|
|
(anObject as TStream).Seek(0, soFromBeginning);
|
|
(anObject as TStream).Size := 0;
|
|
end
|
|
else begin
|
|
anObject := nil;
|
|
end;
|
|
end;
|
|
IsValidType := TRUE;
|
|
end
|
|
else if Assigned(anObject) and aClass.InheritsFrom(EROException) then begin
|
|
// Doesn't need anything here. Just take the type as valid
|
|
IsValidType := TRUE;
|
|
end
|
|
else begin
|
|
fStream.ReadBuffer(IsAssigned, SizeOf(IsAssigned));
|
|
if IsAssigned then begin
|
|
{$IFDEF DEBUG_REMOBJECTS}
|
|
DebugServer.Write('fStream.Position before reading classname: $%x',[fStream.Position]);
|
|
{$ENDIF DEBUG_REMOBJECTS}
|
|
|
|
if IsValidType then begin
|
|
ReadUTF8String('', clsnme,-1,MAX_ITEM_NAME);
|
|
|
|
lActualClass := FindROClass(clsnme);
|
|
if not Assigned(lActualClass) then RaiseError(err_UnknownClassInStream,[clsnme,aClass.ClassName]);
|
|
if not lActualClass.InheritsFrom(aClass) then RaiseError(err_UnexpectedClassInStream,[clsnme,aClass.ClassName]);
|
|
anObject := lActualClass.Create;
|
|
|
|
end
|
|
else begin
|
|
RaiseError(str_InvalidClassTypeInStream,[clsnme]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF DEBUG_REMOBJECTS}
|
|
DebugServer.Write('fStream.Position: %d',[fStream.Position]);
|
|
if anObject = nil then DebugServer.Write('anObject is nil') else DebugServer.Write('anObject is assigned');
|
|
{$ENDIF DEBUG_REMOBJECTS}
|
|
|
|
end;
|
|
|
|
procedure TROStreamSerializer.BeginWriteObject(const aName: string; aClass : TClass; anObject: TObject;
|
|
var LevelRef : IUnknown; var IsValidType : boolean; out IsAssigned:Boolean; ArrayElementId : integer = -1);
|
|
//var IsNIL : ByteBool;
|
|
var clsnme : string;
|
|
cnt : integer;
|
|
struct: IROCustomStreamableClass;
|
|
|
|
begin
|
|
inherited;
|
|
|
|
if Assigned(anObject) and (aClass.GetInterfaceEntry(IROCustomStreamableType) <> nil) then begin
|
|
if anObject.GetInterface(IROCustomStreamableClass, struct) then
|
|
IsAssigned := not struct.IsNull
|
|
else
|
|
IsAssigned := true; { non-class-based types, like enums, are always assigned }
|
|
end
|
|
else begin
|
|
IsAssigned := Assigned(anObject);
|
|
end;
|
|
|
|
if IsAssigned then begin
|
|
if Assigned(anObject) and (anObject.GetInterfaceEntry(IROCustomStreamableType) <> nil) then begin
|
|
if anObject.GetInterface(IROCustomStreamableArray, struct) then begin
|
|
fStream.Write(IsAssigned, SizeOf(IsAssigned));
|
|
cnt := IROCustomStreamableArray(pointer(Struct)).Count;
|
|
WriteInteger('', otULong, cnt);
|
|
IsValidType := true; // Adds Custom Arrays as supported type
|
|
end
|
|
else if anObject.GetInterface(IROCustomStreamableStruct, struct) then begin
|
|
fStream.Write(IsAssigned, SizeOf(IsAssigned));
|
|
clsnme := struct.TypeName;
|
|
WriteUTF8String('', clsnme);
|
|
IsValidType := true; // Adds Custom structs as supported type
|
|
end
|
|
else if (anObject.GetInterfaceEntry(IROCustomStreamableEnum) <> nil) then begin
|
|
IsValidType := true; // Adds custom Enums as supported type. no header required.
|
|
end
|
|
end
|
|
else if aClass.InheritsFrom(TStream) then begin
|
|
fStream.Write(IsAssigned, SizeOf(IsAssigned));
|
|
clsnme := StreamClsName;
|
|
IsValidType := true; // Adds TStream as supported type
|
|
end
|
|
else if (anObject is TROArray) then begin
|
|
fStream.Write(IsAssigned, SizeOf(IsAssigned));
|
|
cnt := TROArray(anObject).Count;
|
|
WriteInteger('', otULong, cnt);
|
|
IsValidType := TRUE; // Adds Array as supported type
|
|
end
|
|
else if (anObject is EROException) then begin
|
|
// Doesn't need anything here. Just take the type as valid
|
|
IsValidType := TRUE;
|
|
end
|
|
else if IsValidType then begin
|
|
fStream.Write(IsAssigned, SizeOf(IsAssigned));
|
|
clsnme := anObject.ClassName;
|
|
WriteUTF8String('', clsnme);
|
|
end;
|
|
end
|
|
else begin
|
|
fStream.Write(IsAssigned, SizeOf(IsAssigned));
|
|
end;
|
|
end;
|
|
|
|
procedure TROStreamSerializer.CustomReadObject(const aName: string; aClass : TClass; var Ref; ArrayElementId: integer);
|
|
var obj : TObject absolute Ref;
|
|
lSize:integer;
|
|
begin
|
|
inherited;
|
|
if Assigned(Obj) then begin
|
|
|
|
if (obj is TMemoryStream) then begin
|
|
with TMemoryStream(obj) do begin // Created as TMemoryStream in BeginReadObject
|
|
ReadInteger('', otULong, lSize);
|
|
if lSize > 0 then begin
|
|
|
|
if (lSize > fStream.Size) then
|
|
RaiseError(err_InvalidStringLength,[lSize]);
|
|
|
|
SetSize(lSize); { don't set this until we have confirmed the stream size }
|
|
|
|
if CopyFrom(fStream, lSize) <> lSize then
|
|
RaiseError(err_InvalidStringLength,[lSize]);
|
|
|
|
Position := 0;
|
|
end
|
|
else begin
|
|
SetSize(0);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
|
|
procedure TROStreamSerializer.CustomWriteObject(const aName: string; aClass : TClass; const Ref; ArrayElementId : integer = -1);
|
|
var obj : TObject absolute Ref;
|
|
lSize:integer;
|
|
begin
|
|
inherited;
|
|
if Assigned(obj) then begin
|
|
|
|
if (obj is TStream) then begin
|
|
with TStream(obj) do begin
|
|
lSize := Size;
|
|
fStream.Write(lSize, SizeOf(lSize));
|
|
if lSize > 0 then begin
|
|
Position := 0;
|
|
fStream.CopyFrom(TStream(obj), lSize);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF DEBUG_REMOBJECTS_BINMESSAGE_LOWLEVEL}
|
|
procedure TROStreamSerializer.Read(const aName: string;aTypeInfo: PTypeInfo; var Ptr; ArrayElementId: integer);
|
|
begin
|
|
DebugServer.EnterMethod('TROStreamSerializer.Read("%s")',[aName]);
|
|
try try
|
|
DebugServer.WriteHexDump('Reading "'+aName+'" from message',fStream);
|
|
inherited;
|
|
except DebugServer.WriteException(); raise; end;
|
|
finally
|
|
DebugServer.ExitMethod('TROStreamSerializer.Read()');
|
|
end;
|
|
end;
|
|
{$ENDIF DEBUG_REMOBJECTS_BINMESSAGE_LOWLEVEL}
|
|
|
|
procedure TROStreamSerializer.ReadVariant(const aName: string; var Ref; ArrayElementId: integer);
|
|
var vtype, stringlen : integer;
|
|
|
|
lIntegerValue:integer;
|
|
{$IFNDEF DELPHI5}
|
|
lShortInt:shortint;
|
|
lSmallIntValue: smallint;
|
|
lInt64Value:Int64;
|
|
{$ENDIF DELPHI5}
|
|
lByteValue:byte;
|
|
lDoubleValue:double;
|
|
lSingleValue:single;
|
|
lCurrencyValue:currency;
|
|
lString: string;
|
|
begin
|
|
fStream.ReadBuffer(vtype, SizeOf(integer));
|
|
|
|
{ Array types }
|
|
if ((vtype and $2000)=$2000) then begin
|
|
case vtype of
|
|
$2011: Variant(Ref) := VariantBinaryFromBinary(fStream);
|
|
else Variant(Ref) := VariantArrayFromBinary(fStream, (vtype and $FFF));
|
|
end;
|
|
Exit; // Done!
|
|
end;
|
|
|
|
{ Plain Types }
|
|
case vtype of
|
|
varEmpty:Variant(Ref) := Unassigned;
|
|
varNull:Variant(Ref) := Null;
|
|
varError:Variant(Ref) := EmptyParam;
|
|
{$IFNDEF DELPHI5}
|
|
varShortInt:begin
|
|
fStream.ReadBuffer(lShortInt, SizeOf(shortint));
|
|
Variant(Ref) := lShortInt;
|
|
end;
|
|
varSmallInt,varWord : begin
|
|
fStream.ReadBuffer(lSmallIntValue, SizeOf(lSmallIntValue));
|
|
Variant(Ref) := lSmallIntValue;
|
|
end;
|
|
{$ENDIF DELPHI5}
|
|
{$IFNDEF DELPHI5}
|
|
varLongWord,
|
|
{$ENDIF DELPHI5}
|
|
varInteger:begin
|
|
fStream.ReadBuffer(lIntegerValue, SizeOf(integer));
|
|
Variant(Ref) := lIntegerValue;
|
|
end;
|
|
varSingle:begin
|
|
fStream.ReadBuffer(lSingleValue, SizeOf(single));
|
|
Variant(Ref) := lSingleValue;
|
|
end;
|
|
varDouble:begin
|
|
fStream.ReadBuffer(lDoubleValue, SizeOf(double));
|
|
Variant(Ref) := lDoubleValue;
|
|
end;
|
|
varCurrency:begin
|
|
fStream.ReadBuffer(lCurrencyValue, SizeOf(currency));
|
|
Variant(Ref) := lcurrencyValue;
|
|
end;
|
|
varDate:begin
|
|
fStream.ReadBuffer(lDoubleValue, SizeOf(double));
|
|
Variant(Ref) := TDateTime(lDoubleValue);
|
|
end;
|
|
varBoolean:begin
|
|
fStream.ReadBuffer(lByteValue, SizeOf(integer));
|
|
Variant(Ref) := (lByteValue <> 0);
|
|
end;
|
|
varByte:begin
|
|
fStream.ReadBuffer(lByteValue, SizeOf(byte));
|
|
Variant(Ref) := lByteValue;
|
|
end;
|
|
{$IFNDEF DELPHI5}
|
|
varInt64:begin
|
|
fStream.ReadBuffer(lInt64Value, SizeOf(Int64));
|
|
Variant(Ref) := lInt64Value;
|
|
end;
|
|
{$ENDIF DELPHI5}
|
|
varString: begin
|
|
fStream.ReadBuffer(stringlen, SizeOf(integer));
|
|
SetLength(lString, stringlen);
|
|
if (stringlen>0)
|
|
then fStream.ReadBuffer(lString[1], stringlen);
|
|
Variant(Ref) := lString;
|
|
end;
|
|
varOleStr: begin
|
|
fStream.ReadBuffer(stringlen, SizeOf(integer));
|
|
SetLength(lString, stringlen);
|
|
if (stringlen>0)
|
|
then fStream.ReadBuffer(lString[1], stringlen);
|
|
Variant(Ref) := Utf8Decode(lString);
|
|
end;
|
|
else NotSupported(Format(err_UnsupportedVariantType, [VarType(vtype)]));
|
|
end; { case }
|
|
end;
|
|
|
|
procedure TROStreamSerializer.WriteVariant(const aName: string; const Ref;
|
|
ArrayElementId: integer);
|
|
var vtype : integer;
|
|
varvalue : Variant;
|
|
|
|
lIntegerValue:integer;
|
|
{$IFNDEF DELPHI5}
|
|
lShortIntValue:shortint;
|
|
lSmallIntValue: Smallint;
|
|
lInt64Value:Int64;
|
|
{$ENDIF DELPHI5}
|
|
lByteValue:byte;
|
|
lDoubleValue:double;
|
|
lSingleValue:single;
|
|
lCurrencyValue:currency;
|
|
lStringValue:string;
|
|
begin
|
|
varvalue := Variant(Ref);
|
|
vtype := VarType(Variant(Ref));
|
|
|
|
{ Array types }
|
|
if ((vtype and $2000)=$2000) then begin
|
|
case vtype of
|
|
$2011: WriteVariantBinaryToBinary(varvalue, fStream); {8209; handle Array of Byte special. for now. }
|
|
else WriteVariantArrayToBinary(varvalue, fStream);
|
|
end;
|
|
Exit; // Done!
|
|
end;
|
|
|
|
{ Simple types }
|
|
case vtype of
|
|
varEmpty,varNull,varError:begin { 0, 1, A }
|
|
fStream.Write(vtype, SizeOf(integer));
|
|
end;
|
|
{$IFNDEF DELPHI5}
|
|
varShortInt:begin { 2, 10, 12 }
|
|
lShortIntValue := varvalue;
|
|
fStream.Write(vtype, SizeOf(integer));
|
|
fStream.Write(lShortIntValue, SizeOf(shortint));
|
|
end;
|
|
varSmallInt,varWord : begin
|
|
lSmallIntValue := varvalue;
|
|
fStream.Write(vtype, SizeOf(integer));
|
|
fStream.Write(lSmallIntValue, SizeOf(lSmallIntValue));
|
|
end;
|
|
{$ENDIF DELPHI5}
|
|
{$IFNDEF DELPHI5}varLongWord,{$ENDIF DELPHI5}
|
|
varInteger:begin { 3, 13 }
|
|
lIntegerValue := varvalue;
|
|
fStream.Write(vtype, SizeOf(integer));
|
|
fStream.Write(lIntegerValue, SizeOf(integer));
|
|
end;
|
|
varSingle:begin { 4 }
|
|
lSingleValue := varvalue;
|
|
fStream.Write(vtype, SizeOf(integer));
|
|
fStream.Write(lSingleValue, SizeOf(single));
|
|
end;
|
|
varDouble, varDate:begin { 5, 7 }
|
|
lDoubleValue := varvalue;
|
|
fStream.Write(vtype, SizeOf(integer));
|
|
fStream.Write(lDoubleValue, SizeOf(double));
|
|
end;
|
|
varCurrency:begin { 6 }
|
|
lCurrencyValue := varvalue;
|
|
fStream.Write(vtype, SizeOf(integer));
|
|
fStream.Write(lCurrencyValue, SizeOf(currency));
|
|
end;
|
|
varBoolean:begin { B }
|
|
if varvalue then lByteValue := 1 else lByteValue := 0;
|
|
fStream.Write(vtype, SizeOf(integer));
|
|
fStream.Write(lByteValue, SizeOf(integer));
|
|
end;
|
|
varByte:begin { 11 }
|
|
lByteValue := varvalue;
|
|
fStream.Write(vtype, SizeOf(integer));
|
|
fStream.Write(lByteValue, SizeOf(byte));
|
|
end;
|
|
{$IFNDEF DELPHI5}
|
|
varInt64:begin { 14 }
|
|
lInt64Value := varvalue;
|
|
fStream.Write(vtype, SizeOf(integer));
|
|
fStream.Write(lInt64Value, SizeOf(Int64));
|
|
end;
|
|
{$ENDIF DELPHI5}
|
|
varString:begin { 100 }
|
|
lStringValue := varvalue;
|
|
lIntegerValue := Length(lStringValue);
|
|
fStream.Write(vtype, SizeOf(integer));
|
|
fStream.Write(lIntegerValue, SizeOf(integer));
|
|
if (lIntegerValue>0)
|
|
then fStream.Write(lStringValue[1],lIntegerValue)
|
|
end;
|
|
varOleStr:begin { 8 }
|
|
lStringValue := Utf8Encode(varvalue);
|
|
lIntegerValue := Length(lStringValue);
|
|
fStream.Write(vtype, SizeOf(integer));
|
|
fStream.Write(lIntegerValue, SizeOf(integer));
|
|
if (lIntegerValue>0)
|
|
then fStream.Write(lStringValue[1],lIntegerValue)
|
|
end;
|
|
else NotSupported(Format(err_UnsupportedVariantType, [VarType(varvalue)]));
|
|
end;
|
|
end;
|
|
|
|
procedure TROStreamSerializer.WriteXml(const aName : string; const Ref; ArrayElementId : integer = -1);
|
|
var
|
|
w: Utf8String;
|
|
begin
|
|
if IXmlNode(Ref) = nil then
|
|
W := ''
|
|
else
|
|
W := UTF8Encode(IXmlNode(Ref).XML);
|
|
WriteUTF8String(aname, w, ArrayElementId);
|
|
end;
|
|
|
|
procedure TROStreamSerializer.ReadXml(const aName : string; var Ref; ArrayElementId : integer = -1);
|
|
var
|
|
w: Utf8String;
|
|
doc: IXMLDocument;
|
|
begin
|
|
ReadUTF8String(aName, w, ArrayElementID);
|
|
if w = '' then
|
|
IXMLNode(Ref) := nil
|
|
else begin
|
|
doc := NewROXmlDocument;
|
|
doc.New;
|
|
Doc.XML := w;
|
|
IXMLNode(Ref) := doc.DocumentNode;
|
|
end;
|
|
end;
|
|
|
|
procedure TROStreamSerializer.WriteGuid(const aName: String; const Ref; ArrayElementId: Integer = -1);
|
|
var
|
|
g: TGuid;
|
|
begin
|
|
g := StringToGUID(TGuidString(Ref));
|
|
fStream.Write(g, sizeof(g));
|
|
end;
|
|
|
|
procedure TROStreamSerializer.WriteDecimal(const aName: String; const Ref; ArrayElementId: Integer = -1);
|
|
var
|
|
dec: TDecimal;
|
|
begin
|
|
dec := VariantToDecimal(Variant(Ref));
|
|
fStream.Write(dec, Sizeof(Dec));
|
|
end;
|
|
|
|
procedure TROStreamSerializer.ReadDecimal(const aName: String; var Ref; ArrayElementId: Integer = -1);
|
|
var
|
|
d: TDecimal;
|
|
begin
|
|
if fStream.Read(d, sizeof(d)) <> sizeof(d) then RaiseError(err_UnexpectedEndOfStream);
|
|
Variant(Ref) := DecimalToVariant(d);
|
|
end;
|
|
|
|
procedure TROStreamSerializer.ReadGuid(const aName: String; var Ref; ArrayElementId: Integer = -1);
|
|
var
|
|
g: TGuid;
|
|
begin
|
|
if fStream.Read(g, sizeof(g)) <> sizeof(g) then RaiseError(err_UnexpectedEndOfStream);
|
|
string(Ref) := GUIDToString(g);
|
|
end;
|
|
|
|
procedure TROStreamSerializer.WriteBinary(const aName: string; const Ref;
|
|
ArrayElementId: integer);
|
|
var
|
|
obj: Binary absolute Ref;
|
|
lSize: cardinal;
|
|
isAssigned: Byte;
|
|
begin
|
|
if Assigned(Obj) then IsAssigned := 1 else IsAssigned := 0;
|
|
fStream.WriteBuffer(isAssigned, SizeOf(IsAssigned));
|
|
if isAssigned <> 0 then begin
|
|
lSize := obj.Size;
|
|
WriteInteger('',otULong, lSize);
|
|
if lSize > 0 then begin
|
|
obj.Position := 0;
|
|
fStream.CopyFrom(obj, lSize);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TROStreamSerializer.ReadBinary(const aName: string; var Ref;
|
|
ArrayElementId: integer);
|
|
var
|
|
obj: Binary absolute Ref;
|
|
lSize: cardinal;
|
|
IsAssigned : ByteBool;
|
|
begin
|
|
fStream.ReadBuffer(IsAssigned, SizeOf(IsAssigned));
|
|
if IsAssigned then begin
|
|
if not Assigned(obj) then obj := Binary.Create
|
|
else begin
|
|
obj.Seek(0, soFromBeginning);
|
|
obj.Size := 0;
|
|
end;
|
|
ReadInteger('', otULong, lSize);
|
|
if (lSize > fStream.Size) then RaiseError(err_InvalidStringLength,[lSize]);
|
|
obj.SetSize(lSize); { don't set this until we have confirmed the stream size }
|
|
if lSize > 0 then begin
|
|
if obj.CopyFrom(fStream, lSize) <> lSize then RaiseError(err_InvalidStringLength,[lSize]);
|
|
obj.Position := 0;
|
|
end;
|
|
end
|
|
else
|
|
obj:=nil;
|
|
end;
|
|
|
|
function TROStreamSerializer.ReadArray(const aName: string; aClass: TClass;
|
|
var Ref; ArrayElementId: integer): Boolean;
|
|
var
|
|
obj: TROArray absolute Ref;
|
|
IsAssigned : ByteBool;
|
|
cnt : integer;
|
|
begin
|
|
fStream.ReadBuffer(IsAssigned, SizeOf(IsAssigned));
|
|
Result:=IsAssigned;
|
|
if Result then begin
|
|
obj := TROArray(aClass.Create);
|
|
ReadInteger('', otULong, cnt);
|
|
obj.Resize(cnt);
|
|
obj.ReadComplex(self);
|
|
end
|
|
else
|
|
Obj:=nil;
|
|
end;
|
|
|
|
function TROStreamSerializer.ReadStruct(const aName: string;
|
|
aClass: TClass; var Ref; ArrayElementId: integer): Boolean;
|
|
var
|
|
obj : TROComplexType absolute Ref;
|
|
IsAssigned : ByteBool;
|
|
clsnme : string;
|
|
lActualClass:TROComplexTypeClass;
|
|
begin
|
|
fStream.ReadBuffer(IsAssigned, SizeOf(IsAssigned));
|
|
Result := IsAssigned;
|
|
if Result then begin
|
|
ReadUTF8String('', clsnme,-1,MAX_ITEM_NAME);
|
|
lActualClass := FindROClass(clsnme);
|
|
if not Assigned(lActualClass) then RaiseError(err_UnknownClassInStream,[clsnme,aClass.ClassName]);
|
|
if not lActualClass.InheritsFrom(aClass) then RaiseError(err_UnexpectedClassInStream,[clsnme,aClass.ClassName]);
|
|
obj := lActualClass.Create;
|
|
obj.ReadComplex(self);
|
|
end
|
|
else
|
|
Obj:=nil;
|
|
end;
|
|
|
|
procedure TROStreamSerializer.WriteArray(const aName: string; const Ref;
|
|
ArrayElementId: integer);
|
|
//var IsNIL : ByteBool;
|
|
var
|
|
obj : TROArray absolute Ref;
|
|
cnt : integer;
|
|
IsAssigned: Byte;
|
|
begin
|
|
if Assigned(Obj) then IsAssigned := 1 else IsAssigned := 0;
|
|
fStream.Write(IsAssigned, SizeOf(IsAssigned));
|
|
if isAssigned <> 0 then begin
|
|
cnt := obj.Count;
|
|
WriteInteger('', otULong, cnt);
|
|
obj.WriteComplex(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TROStreamSerializer.WriteStruct(const aName: string; const Ref;
|
|
ArrayElementId: integer);
|
|
var
|
|
obj : TROComplexType absolute Ref;
|
|
clsnme : string;
|
|
IsAssigned: byte;
|
|
begin
|
|
if Assigned(Obj) then IsAssigned := 1 else IsAssigned := 0;
|
|
fStream.Write(IsAssigned, SizeOf(IsAssigned));
|
|
if isAssigned <> 0 then begin
|
|
clsnme := obj.ClassName;
|
|
WriteUTF8String('', clsnme);
|
|
obj.WriteComplex(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TROStreamSerializer.ReadException(const aName: string;
|
|
var Ref; ArrayElementId: integer);
|
|
var
|
|
obj: EROException absolute Ref;
|
|
begin
|
|
if Assigned(obj) then EROException(obj).ReadException(Self);
|
|
end;
|
|
|
|
procedure TROStreamSerializer.WriteException(const aName: string;
|
|
const Ref; ArrayElementId: integer);
|
|
var
|
|
obj: EROException absolute Ref;
|
|
begin
|
|
if Assigned(obj) then EROException(obj).WriteException(Self);
|
|
end;
|
|
|
|
end.
|