unit uROSerializer;

{----------------------------------------------------------------------------}
{ 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.Serializer instead' }
{$ENDIF}

interface

uses
  {$IFDEF REMOBJECTS_TRIAL}uROTrial,{$ENDIF}
  Classes, TypInfo, uROTypes;

const RO_ArrayItemName = 'item';
      StreamClsName = 'Binary';

type TROSerializer = class;

     IROCustomStreamableType = interface
     ['{BD8FB0B8-3F7E-4E6E-A9B1-80C3FF39878D}']
       procedure Write(aSerializer: TROSerializer; const aName: string);
       procedure Read(aSerializer: TROSerializer; const aName: string);
     end;

     IROCustomStreamableClass = interface(IROCustomStreamableType)
     ['{10D1288B-D679-42E8-B4C0-5CA772647582}']
       function GetTypeName: string;
       procedure SetTypeName(const aValue:string);
       property TypeName:string read GetTypeName write SetTypeName;

       function CanImplementType(const aName: string):boolean;

       procedure SetNull(aIsNull: boolean);
       function IsNull: boolean;
     end;

     IROCustomStreamableEnum = interface
     ['{5CE37B53-839A-48C4-89D7-8A0FDAFC2C4A}']
       procedure SetValue(aValue: byte);
       function GetValue: byte;
       property Value: byte read GetValue write SetValue;

       procedure Write(aSerializer: TROSerializer; const aName: string);
       procedure Read(aSerializer: TROSerializer; const aName: string);
     end;

     IROCustomStreamableStruct = interface(IROCustomStreamableClass)
     ['{0DAA29FE-2E54-477C-AA4B-996FBFE1F9A6}']
     end;

     IROCustomStreamableArray = interface(IROCustomStreamableClass)
     ['{8B043EB4-F628-4581-884D-C636D9DDED0E}']
       function GetCount: integer;
       procedure SetCount(aElementCount: integer);
       property Count: integer read GetCount write SetCount;

     end;

     IROObjectStreamExtender = interface
     ['{2A73D437-FDFC-4765-BA9A-07FD5F61D991}']
       procedure Write(aSerializer: TROSerializer);
       procedure Read(aSerializer: TROSerializer);
     end;

     TROSerializer = class
     private
       procedure ReadObject(obj: TObject);
       procedure WriteObject(obj: TObject);
     protected
       function GetRecordStrictOrder: Boolean; virtual;
       function IsROCustomStreamable(aClass : TClass):Boolean; 
       procedure BeginWriteObject(const aName: string; aClass : TClass; anObject: TObject; var LevelRef : IUnknown;
                                  var IsValidType : boolean; out IsAssigned:Boolean; ArrayElementId : integer = -1); virtual;
       procedure EndWriteObject(const aName: string; aClass : TClass; anObject: TObject; const LevelRef : IUnknown); virtual;
       procedure CustomWriteObject(const aName : string; aClass : TClass; const Ref; ArrayElementId : integer = -1); virtual;
       procedure CustomReadObject(const aName: string; aClass: TClass;var Ref; ArrayElementId: integer);virtual;
       procedure BeginReadObject(const aName : string; aClass : TClass; var anObject : TObject; var LevelRef : IUnknown;
                                 var IsValidType : boolean; ArrayElementId : integer = -1); virtual;
       procedure EndReadObject(const aName : string; aClass : TClass; var anObject : TObject; const LevelRef : IUnknown); virtual;
       procedure ReadROCustomStreamable(const aName : string; aClass : TClass; var Ref; ArrayElementId : integer = -1);
       procedure WriteROCustomStreamable(const aName : string; aClass : TClass; const Ref; ArrayElementId : integer = -1);
       { Internal }
     public
       { Writers }
       procedure WriteInteger(const aName : string; anOrdType : TOrdType; const Ref; ArrayElementId : integer = -1); virtual; abstract;
       procedure WriteInt64(const aName : string; const Ref; ArrayElementId : integer = -1); virtual; abstract;
       procedure WriteEnumerated(const aName : string; anEnumTypeInfo : PTypeInfo; const Ref; ArrayElementId : integer = -1); virtual; abstract;
       procedure WriteUTF8String(const aName : string; const Ref; ArrayElementId : integer = -1); virtual; abstract;
       procedure WriteWideString(const aName : string; const Ref; ArrayElementId : integer = -1); virtual; abstract;
       procedure WriteDateTime(const aName : string; const Ref; ArrayElementId : integer = -1); virtual; abstract;
       procedure WriteDouble(const aName : string; aFloatType : TFloatType; const Ref; ArrayElementId : integer = -1); virtual; abstract;
       procedure WriteVariant(const aName : string; const Ref; ArrayElementId : integer = -1); virtual; abstract;
       procedure WriteXml(const aName : string; const Ref; ArrayElementId : integer = -1); virtual; abstract;
       procedure WriteGuid(const aName : string; const Ref; ArrayElementId : integer = -1); virtual; abstract;
       procedure WriteDecimal(const aName : string; const Ref; ArrayElementId : integer = -1); virtual; abstract;
       procedure WriteBinary(const aName : string; const Ref; ArrayElementId : integer = -1);virtual; abstract;
       procedure WriteStruct(const aName : string; const Ref; ArrayElementId : integer = -1);virtual; abstract;
       procedure WriteArray(const aName : string; const Ref; ArrayElementId : integer = -1);virtual; abstract;
       procedure WriteException(const aName : string; const Ref; ArrayElementId : integer = -1); virtual; abstract;
       { Readers }
       procedure ReadInteger(const aName : string; anOrdType : TOrdType; var Ref; ArrayElementId : integer = -1); virtual; abstract;
       procedure ReadInt64(const aName : string; var Ref; ArrayElementId : integer = -1); virtual; abstract;
       procedure ReadEnumerated(const aName : string; anEnumTypeInfo : PTypeInfo; var Ref; ArrayElementId : integer = -1); virtual; abstract;
       procedure ReadUTF8String(const aName : string; var Ref; ArrayElementId : integer = -1; iMaxLength:integer=-1); virtual; abstract;
       procedure ReadWideString(const aName : string; var Ref; ArrayElementId : integer = -1; iMaxLength:integer=-1); virtual; abstract;
       procedure ReadDateTime(const aName : string; var Ref; ArrayElementId : integer = -1); virtual; abstract;
       procedure ReadDouble(const aName : string; aFloatType : TFloatType; var Ref; ArrayElementId : integer = -1); virtual; abstract;
       procedure ReadVariant(const aName : string; var Ref; ArrayElementId : integer = -1); virtual; abstract;
       procedure ReadXml(const aName : string; var Ref; ArrayElementId : integer = -1); virtual; abstract;
       procedure ReadGuid(const aName : string; var Ref; ArrayElementId : integer = -1); virtual; abstract;
       procedure ReadDecimal(const aName : string; var Ref; ArrayElementId : integer = -1); virtual; abstract;
       procedure ReadBinary(const aName : string; var Ref; ArrayElementId : integer = -1);virtual; abstract;
       function ReadStruct(const aName : string; aClass : TClass; var Ref; ArrayElementId : integer = -1): Boolean; virtual; abstract;
       function ReadArray(const aName : string; aClass : TClass; var Ref; ArrayElementId : integer = -1): Boolean; virtual; abstract;
       procedure ReadException(const aName : string; var Ref; ArrayElementId : integer = -1); virtual; abstract;
     public
       constructor Create();//aStorageRef: pointer); virtual;
       destructor Destroy; override;

       procedure Write(const aName : string; aTypeInfo : PTypeInfo; const Ref; ArrayElementId : integer = -1);
       procedure Read(const aName : string; aTypeInfo : PTypeInfo; var Ptr; ArrayElementId : integer = -1); {$IFDEF DEBUG_REMOBJECTS}virtual;{$ENDIF}
       function GetArrayElementName(anItemType : PTypeInfo; anItemReference: pointer): string; virtual;
       property RecordStrictOrder: Boolean read GetRecordStrictOrder;
     end;

     TROSerializerClass = class of TROSerializer;

procedure ReadObjectFromSerializer(const ASerializer: TROSerializer; anObject : TObject);
procedure WriteObjectToSerializer(const ASerializer: TROSerializer; anObject: TObject);
implementation

uses
  Variants, RTLConsts,
  uRORes, SysUtils, uROClasses, uROBinaryHelpers, uROClient,
  uROXMLIntf;

function RO_GetIntfProp(Instance: TObject; const PropName: string): IInterface;
{$IFDEF FPC}
var
  lPropInfo: PPropInfo;
{$ENDIF}
begin
  {$IFDEF FPC}
  lPropInfo := GetPropInfo(Instance, PropName);
  if lPropInfo = nil then begin
    Result:=nil;
    exit;
  end;
  Result := IInterface(Pointer(GetOrdProp(Instance, lPropInfo)));
  {$ELSE}
  Result := GetInterfaceProp(Instance, PropName);
  {$ENDIF}
end;


procedure RO_SetIntfProp(Instance: TObject; const PropName: string; const Value: IInterface);
{$IFDEF FPC}
var
  lPropInfo: PPropInfo;
{$ENDIF}
begin
  {$IFDEF FPC}
  lPropInfo := GetPropInfo(Instance, PropName);
  if lPropInfo = nil then Exit;
  if Value <> nil then Value._AddRef;
  SetOrdProp(Instance, lPropInfo, PtrInt(Value));
  {$ELSE}
  SetInterfaceProp(Instance, PropName, Value);
  {$ENDIF}
end;


{ TROSerializer }

procedure TROSerializer.BeginReadObject(const aName: string;
  aClass : TClass; var anObject: TObject; var LevelRef : IUnknown; var IsValidType : boolean; ArrayElementId : integer = -1);
begin
  //IsValidType := Assigned(anObject) or (anObject is TROComplexType);
  IsValidType := aClass.InheritsFrom(TROComplexType) or aClass.InheritsFrom(EROException)
end;

procedure TROSerializer.BeginWriteObject(const aName: string; aClass : TClass; anObject: TObject; var LevelRef : IUnknown; var IsValidType : boolean; out IsAssigned:Boolean; ArrayElementId : integer = -1);
begin
  //IsValidType := Assigned(anObject) or (anObject is TROComplexType);
  IsValidType := aClass.InheritsFrom(TROComplexType) or aClass.InheritsFrom(EROException)
end;

constructor TROSerializer.Create;//(aStorageRef: pointer);
begin
  inherited Create;

   {if (pointer(aStorageRef)<>NIL) and not SetStorageRef(aStorageRef)
    then RaiseError(err_InvalidStorage, []);}
end;

procedure TROSerializer.CustomReadObject(const aName: string; aClass : TClass; var Ref;
  ArrayElementId: integer);
var obj : TObject absolute Ref;
    i, cnt : integer;
    itemref : pointer;
    lCustomObject: IROCustomStreamableType;

begin
  if Assigned(Obj) then begin

    { handle reading of arrays. any other custom types (like Streams) must
      be handled by the base classes. }

    if Obj.GetInterface(IROCustomStreamableType, lCustomObject) then begin
      lCustomObject.Read(Self, aName);
    end
    else if (obj is TROArray) then with TROArray(obj) do begin
      cnt := TROArray(obj).Count;
      if (GetItemClass<>NIL) then begin
        for i := 0 to (cnt-1) do begin
          itemref := NIL;
          Read(RO_ArrayItemName, GetItemType, itemref, i);
          SetItemRef(i, itemref);
        end;
      end
      else begin
        for i := 0 to (cnt-1) do begin
          itemref := GetItemRef(i);
          Read(RO_ArrayItemName, GetItemType, itemref^, i);
        end;
      end;
    end

  end;
end;

procedure TROSerializer.CustomWriteObject(const aName: string; aClass : TClass; const Ref; ArrayElementId : integer = -1);
var obj : TObject absolute Ref;
    i : integer;
    itemref : pointer;
    lCustomObject: IROCustomStreamableType;
begin
  if Assigned(obj) then begin

    { handle reading of arrays. any other custom types (like Streams) must
      be handled by the base classes. }
    if Obj.GetInterface(IROCustomStreamableType, lCustomObject) then begin
      lCustomObject.Write(Self, aName);
    end
    else if (obj is TROArray) then with TROArray(obj) do begin
      if (GetItemClass<>NIL) then begin
        for i := 0 to (Count-1) do begin
          itemref := GetItemRef(i);
          Write(GetArrayElementName(GetItemType, itemref), GetItemType, itemref, i);
          //Write(TObject(itemref).ClassName, GetItemType, itemref, i);
        end;
      end
      else begin
        for i := 0 to (Count-1) do begin
          itemref := GetItemRef(i);
          Write(GetArrayElementName(GetItemType, itemref), GetItemType, itemref^, i);
          //Write(RO_ArrayItemName, GetItemType, itemref^, i);
        end;
      end;
    end;

  end;
end;

destructor TROSerializer.Destroy;
begin
  inherited;
end;

procedure TROSerializer.EndReadObject(const aName: string;
  aClass : TClass; var anObject: TObject; const LevelRef : IUnknown);
begin
end;

procedure TROSerializer.EndWriteObject(const aName: string;
  aClass : TClass; anObject: TObject; const LevelRef : IUnknown);
begin
end;

procedure TROSerializer.ReadROCustomStreamable(const aName: string; aClass : TClass; var Ref; ArrayElementId : integer = -1);
var obj : TObject absolute Ref;
    LevelRef : IUnknown;
    validtype : boolean;
begin
  //obj := nil; { no matter what's passed in, we wanna start fresh }

  BeginReadObject(aName, aClass, obj, levelref, validtype, ArrayElementId);

  //if not Assigned(obj) then Exit; { we got outselves a nil object } // RaiseError(err_ObjectExpectedInStream, []);
  if Assigned(obj) and (not validtype) then
    raise EROUnknownType.CreateFmt(err_TypeNotSupported, [obj.ClassName]);

  if Assigned(obj) then ReadObject(obj);

  CustomReadObject(aName, aClass, obj, ArrayElementId);

  EndReadObject(aName, aClass, obj, levelref);
end;

procedure TROSerializer.Write(const aName: string; aTypeInfo: PTypeInfo;
  const Ref; ArrayElementId : integer = -1);
begin
  case aTypeInfo^.Kind of
    {$IFDEF FPC}tkBool,{$ENDIF}
    tkEnumeration : WriteEnumerated(aName, aTypeInfo, Ref, ArrayElementId);
    tkInteger     : WriteInteger(aName, GetTypeData(aTypeInfo)^.OrdType, Ref, ArrayElementId);

    tkFloat       : if (aTypeInfo=TypeInfo(TDateTime))
                      then WriteDateTime(aName, Ref, ArrayElementId)
                      else WriteDouble(aName, GetTypeData(aTypeInfo)^.FloatType, Ref, ArrayElementId);

    tkWString     : WriteWideString(aName, Ref, ArrayElementId);
    tkLString,
    {$IFDEF FPC}tkAString,{$ENDIF}
    tkString      : if (aTypeInfo=TypeInfo(TGuidString)) then
                      WriteGuid(aName, Ref, ArrayElementId)
                    else
                      WriteUTF8String(aName, Ref, ArrayElementId);
    tkInt64       : WriteInt64(aName, Ref, ArrayElementId);

    tkClass    : if GetTypeData(aTypeInfo).ClassType.InheritsFrom(TROArray) then
                   WriteArray(aName, Ref, ArrayElementId)
                 else if GetTypeData(aTypeInfo).ClassType.InheritsFrom(TROComplexType) then
                   WriteStruct(aName, Ref, ArrayElementId)
                 else if GetTypeData(aTypeInfo).ClassType.InheritsFrom(Binary) then
                   WriteBinary(aName, Ref, ArrayElementId)
                 else if GetTypeData(aTypeInfo).ClassType.InheritsFrom(Exception) then
                   WriteException(aName, Ref, ArrayElementId)
                 else
                   raise EROUnknownType.CreateFmt(err_TypeNotSupported, [GetEnumName(TypeInfo(TTypeKind), Ord(aTypeInfo^.Kind))]);

    tkVariant :   if aTypeInfo = TypeInfo(TDecimalVariant) then
                    WriteDecimal(aName, Ref, ArrayElementId)
                  else
                    WriteVariant(aName, Ref, ArrayElementId);
    tkInterface :
      begin
        if aTypeInfo = TypeInfo(IXmlNode) then begin
          WriteXml(aName, Ref, ArrayElementId);
        end else raise EROUnknownType.CreateFmt(err_TypeNotSupported, [GetEnumName(TypeInfo(TTypeKind), Ord(aTypeInfo^.Kind))]);
      end;

    else raise EROUnknownType.CreateFmt(err_TypeNotSupported, [GetEnumName(TypeInfo(TTypeKind), Ord(aTypeInfo^.Kind))]);
  end;
end;

procedure TROSerializer.Read(const aName: string; aTypeInfo: PTypeInfo;
  var Ptr; ArrayElementId : integer = -1);
begin
  case aTypeInfo^.Kind of
    {$IFDEF FPC}tkBool,{$ENDIF}
    tkEnumeration : ReadEnumerated(aName, aTypeInfo, byte(Ptr), ArrayElementId);
    tkInteger  : ReadInteger(aName, GetTypeData(aTypeInfo)^.OrdType, Ptr, ArrayElementId);
    tkInt64    : ReadInt64(aName, Ptr, ArrayElementId);

    tkFloat    : if (aTypeInfo=TypeInfo(TDateTime))
                   then ReadDateTime(aName, Ptr, ArrayElementId)
                   else ReadDouble(aName, GetTypeData(aTypeInfo)^.FloatType, Ptr, ArrayElementId);

    tkWString  : ReadWideString(aName, Ptr, ArrayElementId);
    tkLString,
    {$IFDEF FPC}tkAString,{$ENDIF}
    tkString   :
                  if aTypeInfo = TypeInfo(TGuidString) then
                    ReadGuid(aName, Ptr, ArrayElementId)
                  else
                    ReadUTF8String(aName, Ptr, ArrayElementId);

    tkClass    : if isROCustomStreamable(GetTypeData(aTypeInfo).ClassType) then
                   ReadROCustomStreamable(aName, GetTypeData(aTypeInfo).ClassType, Ptr, ArrayElementId)
                 else if GetTypeData(aTypeInfo).ClassType.InheritsFrom(TROArray) then
                   ReadArray(aName, GetTypeData(aTypeInfo).ClassType, Ptr, ArrayElementId)
                 else if GetTypeData(aTypeInfo).ClassType.InheritsFrom(TROComplexType) then
                   ReadStruct(aName, GetTypeData(aTypeInfo).ClassType, Ptr, ArrayElementId)
                 else if GetTypeData(aTypeInfo).ClassType.InheritsFrom(Binary) then
                   ReadBinary(aName, Ptr, ArrayElementId)
                 else if GetTypeData(aTypeInfo).ClassType.InheritsFrom(Exception) then
                   ReadException(aName, Ptr, ArrayElementId)
                 else
                   raise EROUnknownType.CreateFmt(err_TypeNotSupported, [GetEnumName(TypeInfo(TTypeKind), Ord(aTypeInfo^.Kind))]);

    tkVariant : if aTypeInfo = TypeInfo(TDecimalVariant) then
                  ReadDecimal(aName, Ptr, ArrayElementId)
                else
                  ReadVariant(aName, Ptr, ArrayElementId);

    tkInterface :
      begin
        if aTypeInfo = TypeInfo(IXmlNode) then begin
          ReadXml(aName, Ptr, ArrayElementId);
        end else raise EROUnknownType.CreateFmt(err_TypeNotSupported, [GetEnumName(TypeInfo(TTypeKind), Ord(aTypeInfo^.Kind))]);
      end;
    else RaiseError(err_TypeNotSupported, [GetEnumName(TypeInfo(TTypeKind), Ord(aTypeInfo^.Kind))]);
  end;
end;

procedure TROSerializer.WriteROCustomStreamable(const aName: string; aClass : TClass; const Ref; ArrayElementId : integer = -1);
var obj : TObject absolute Ref;
    validtype, IsAssigned : boolean;
    LevelRef : IUnknown;
begin
  BeginWriteObject(aName, aClass, obj, levelref, validtype, IsAssigned, ArrayElementId);
  //if (not IsAssigned) or (not Assigned(obj)) then Exit; // no more streaming to do for a nil object.

  if Assigned(obj) and (not validtype) then RaiseError(err_TypeNotSupported, [obj.ClassName]);
  if Assigned(obj) then WriteObject(obj);
  CustomWriteObject(aName, aClass, obj);

  EndWriteObject(aName, aClass, obj, levelref);
end;

function TROSerializer.GetArrayElementName(anItemType: PTypeInfo; anItemReference: pointer): string;
begin
  result := RO_ArrayItemName;
end;

function TROSerializer.GetRecordStrictOrder: Boolean;
begin
  Result := False;
end;

function TROSerializer.IsROCustomStreamable(aClass : TClass): Boolean;
begin
  Result:=Supports(aClass, IROCustomStreamableType);
end;

procedure ReadObjectFromSerializer(const ASerializer: TROSerializer; anObject : TObject);
begin
  ASerializer.ReadObject(anObject);
end;

procedure WriteObjectToSerializer(const ASerializer: TROSerializer; anObject: TObject);
begin
  ASerializer.WriteObject(anObject);
end;

procedure TROSerializer.ReadObject(obj: TObject);
var
    props : PPropList;
    cnt, i : integer;
    propInf: PPropInfo;

    // Temporary variables
    node : IXMLNode;
    int64val : int64;
    intval : integer;
    enuval : byte;
    dblval : double;
    currval : Currency;
    extval : Extended;
    singleval : Single;
    compval : Comp;
    varval : variant;
    datetimeval : TDateTime;
    //extval : extended;
    strval : string;
    {$IFNDEF DELPHI5}wstrval : widestring;{$ENDIF}
    objval : TObject;
    lObjectStreamExtender:IROObjectStreamExtender;
begin
  if Assigned(obj) and (obj.ClassInfo <> nil) then begin
    cnt := GetTypeData(obj.ClassInfo).PropCount;

    if (cnt>0) then begin
      GetMem(props, cnt*SizeOf(PPropInfo));
      try
        cnt := GetPropList(PTypeInfo(obj.ClassInfo), tkProperties, props, not GetRecordStrictOrder);

        for i := 0 to (cnt-1) do begin
          with props^[i]^ do begin

            case PropType^.Kind of
              {$IFDEF FPC}tkBool,{$ENDIF}
              tkEnumeration : begin
                ReadEnumerated(Name, PropType{$IFNDEF FPC}^{$ENDIF}, enuval);
                SetOrdProp(obj, Name, enuval);
              end;

              tkInteger : begin
                ReadInteger(Name, GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF}).OrdType, intval);
                SetOrdProp(obj, Name, intval);
              end;

              tkFloat : begin
                if (PropType{$IFNDEF FPC}^{$ENDIF}=TypeInfo(TDateTime)) then begin
                  ReadDateTime(props^[i]^.Name, datetimeval);//, ArrayElementId);
                  SetPropValue(obj, Name, datetimeval);
                end
                else case GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF})^.FloatType of
                  ftSingle   : begin
                    ReadDouble(props^[i]^.Name, GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF})^.FloatType, singleval);
                    SetFloatProp(obj, Name, singleval);
                  end;
                  ftDouble   : begin
                    ReadDouble(props^[i]^.Name, GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF})^.FloatType, dblval);
                    SetFloatProp(obj, Name, dblval);
                  end;
                  ftExtended : begin
                    ReadDouble(props^[i]^.Name, GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF})^.FloatType, extval);
                    SetFloatProp(obj, Name, extval);
                  end;
                  ftComp     : begin
                    ReadDouble(props^[i]^.Name, GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF})^.FloatType, compval);
                    SetFloatProp(obj, Name, compval);
                  end;
                  ftCurr     : begin
                    ReadDouble(props^[i]^.Name, GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF})^.FloatType, currval);
                    SetFloatProp(obj, Name, currval);
                  end;
                end;
              end;

              tkLString,
              {$IFDEF FPC}tkAString,{$ENDIF}
              tkString : begin
                if PropType{$IFNDEF FPC}^{$ENDIF}=TypeInfo(TGuidString) then
                  ReadGuid(Name, strval)
                else
                  ReadUTF8String(Name, strval);
                SetStrProp(obj, Name, strval);
              end;

              tkInt64 : begin
                ReadInt64(Name, int64val);
                SetInt64Prop(obj, Name, int64val);
              end;

              tkWString : begin
                {$IFDEF DELPHI5}
                //RaiseError(err_TypeNotSupported, ['tkWString']);
                ReadUTF8String(Name, strval);
                SetStrProp(obj, Name, strval);
                {$ELSE}
                ReadWideString(Name, wstrval);
                propInf := GetPropInfo(obj, Name);
                if propInf = nil then
                  raise EPropertyError.CreateResFmt(@SUnknownProperty, [Name]);
                SetWideStrProp(obj, propInf, wstrval);
                {$ENDIF}
              end;

              tkVariant : begin
                if (PropType{$IFNDEF FPC}^{$ENDIF}=TypeInfo(TDecimalVariant)) then
                  ReadDecimal(Name, varval)
                else
                  ReadVariant(Name, varval);
                SetVariantProp(obj, Name, varval);
              end;

              tkClass : begin
                objval := nil;
                Read(Name, PropType{$IFNDEF FPC}^{$ENDIF}, objval);
                SetObjectProp(obj, Name, objval);
              end;

              tkInterface: begin
                if PropType{$IFNDEF FPC}^{$ENDIF}=TypeInfo(IXmlNode) then begin
                  ReadXml(Name, node);
                  RO_SetIntfProp(obj, Name, node);
                end else raise EROUnknownType.CreateFmt(err_TypeNotSupported, [GetEnumName(TypeInfo(TTypeKind), Ord(props^[i].PropType^.Kind))])
              end;
              else raise EROUnknownType.CreateFmt(err_TypeNotSupported, [GetEnumName(TypeInfo(TTypeKind), Ord(props^[i].PropType^.Kind))])
            end; { case }
          end; { with }
        end; { for }
      finally
        FreeMem(props, cnt*SizeOf(PPropInfo));
      end;
    end; { if Count > 0 }
    if Obj.GetInterface(IROObjectStreamExtender, lObjectStreamExtender) then begin
      lObjectStreamExtender.Read(Self);
    end
  end; { if Assigned }
end;

procedure TROSerializer.WriteObject(obj: TObject);
var
    props : PPropList;
    cnt, i : integer;

    // Temporary variables
    int64val : int64;
    intval : integer;
    enuval : byte;
    dblval : double;
    currval : Currency;
    extval : Extended;
    singleval : Single;
    datetimeval : TDateTime;
    compval : Comp;
    strval : string;
    varval : Variant;
    {$IFNDEF DELPHI5}wstrval : widestring;{$ENDIF}
    objval : TObject;
    pdata : PTypeData;
    lObjectStreamExtender:IROObjectStreamExtender;
    node: IXMLNode;
begin
  if (obj<>NIL) and (obj.ClassInfo<>NIL) then begin
    pdata := GetTypeData(obj.ClassInfo);
    if (pdata<>NIL) then begin
      cnt := pdata .PropCount;
      if (cnt>0) then begin
        GetMem(props, cnt*SizeOf(PPropInfo));
        try
          cnt := GetPropList(PTypeInfo(obj.ClassInfo), tkProperties, props, not GetRecordStrictOrder);

          for i := 0 to (cnt-1) do begin
            with props^[i]^ do

              case PropType^.Kind of
                {$IFDEF FPC}tkBool,{$ENDIF}
                tkEnumeration : begin
                  enuval := GetOrdProp(obj, Name);
                  WriteEnumerated(props^[i]^.Name, PropType{$IFNDEF FPC}^{$ENDIF}, enuval);
                end;

                tkInteger : begin
                  intval := GetOrdProp(obj, Name);
                  WriteInteger(props^[i]^.Name, GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF})^.OrdType, intval);
                end;

                tkFloat : begin
                  if (PropType{$IFNDEF FPC}^{$ENDIF}=TypeInfo(TDateTime)) then begin
                    datetimeval := GetPropValue(obj, Name);
                    WriteDateTime(props^[i]^.Name, datetimeval);
                  end
                  else case GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF})^.FloatType of
                    ftSingle   : begin
                      singleval := GetFloatProp(obj, Name);
                      WriteDouble(props^[i]^.Name, GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF})^.FloatType, singleval);
                    end;
                    ftDouble   : begin
                      dblval := GetFloatProp(obj, Name);
                      WriteDouble(props^[i]^.Name, GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF})^.FloatType, dblval);
                    end;
                    ftExtended : begin
                      extval := GetFloatProp(obj, Name);
                      WriteDouble(props^[i]^.Name, GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF})^.FloatType, extval);
                    end;
                    ftComp     : begin
                      compval := GetFloatProp(obj, Name);
                      WriteDouble(props^[i]^.Name, GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF})^.FloatType, compval);
                    end;
                    ftCurr     : begin
                      currval := GetFloatProp(obj, Name);
                      WriteDouble(props^[i]^.Name, GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF})^.FloatType, currval);
                    end;
                  end;
                end;

                tkLString,
                {$IFDEF FPC}tkAString,{$ENDIF}
                tkString : begin
                  strval := GetStrProp(obj, Name);
                  if  (PropType{$IFNDEF FPC}^{$ENDIF}=TypeInfo(TGuidString)) then
                    WriteGuid(name, strval)
                  else
                    WriteUTF8String(Name, strval);
                end;

                tkInt64 : begin
                  int64val := GetInt64Prop(obj, Name);
                  WriteInt64(Name, int64val);
                end;

                tkWString : begin
                  {$IFDEF DELPHI5}
                  //RaiseError(err_TypeNotSupported, ['tkWString']);
                  strval := GetStrProp(obj, Name);
                  WriteUTF8String(Name, strval);
                  {$ELSE}
                  wstrval := GetWideStrProp(obj, Name);
                  WriteWideString(Name, wstrval);
                  {$ENDIF}
                end;

                tkVariant : begin
                  varval := GetVariantProp(obj, Name);
                  if (PropType{$IFNDEF FPC}^{$ENDIF}=TypeInfo(TDecimalVariant)) then
                    WriteDecimal(Name, varval)
                  else
                    WriteVariant(Name, varval);
                end;

                tkClass : begin
                  objval := GetObjectProp(obj, Name);
                  Write(Name, PropType{$IFNDEF FPC}^{$ENDIF}, objval);
                end;
                tkInterface : begin
                  if PropType{$IFNDEF FPC}^{$ENDIF}=TypeInfo(IXmlNode) then begin
                 // if  props^[i] = TypeInfo(IXmlNode) then begin
                    node := RO_GetIntfProp(obj, name) as IXMLNode;
                    WriteXml(Name, node);
                  end else RaiseError(err_TypeNotSupported, [GetEnumName(TypeInfo(TTypeKind), Ord(props^[i].PropType^.Kind))])
                end;

                else RaiseError(err_TypeNotSupported, [GetEnumName(TypeInfo(TTypeKind), Ord(props^[i].PropType^.Kind))])
              end;
          end;
        finally
          FreeMem(props, cnt*SizeOf(PPropInfo));
        end;
      end;
    end;
    if Obj.GetInterface(IROObjectStreamExtender, lObjectStreamExtender) then begin
      lObjectStreamExtender.Write(Self);
    end
  end;
end;

end.