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.