unit uROXMLSerializer;

{----------------------------------------------------------------------------}
{ 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}

interface

uses
  {$IFDEF REMOBJECTS_TRIAL}uROTrial,{$ENDIF}
  Classes, uROSerializer, TypInfo, uROXMLIntf, uROTypes, SysUtils, FMTBcd;

const
  // SOAP specifics
  tag_Envelope = 'Envelope';
  tag_Body     = 'Body';
  tag_Header   = 'Header';
  tag_Fault    = 'Fault';

  ns_Envelope = 'SOAP-ENV';
  ns_Standard = 'xs';
  ns_Custom   = 'ro';
  ns_xsi      = 'xsi';
  ns_xsd      = 'xsd';

  tag_HRef = 'href';
  tag_Nil  = 'xsi:nil';
  tag_NilValue  = 'true';
  tag_Id   = 'id';

  // Misc
  SOAP_DecimalSeperator  = '.';
  SOAP_BoolValues: array [Boolean] of  string = ('false', 'true');

  SOAP_DateFormat       = 'yyyy-mm-dd';
  SOAP_DateFormatLength = 10;

  SOAP_DateTimeFormat       = 'yyyy-mm-dd"T"hh":"nn":"ss';
  SOAP_DateTimeFormatLength = 19;

  SOAP_TimeFormat       = 'hh":"nn":"ss';
  SOAP_TimeFormatLength = 8;

  // Data types signatures
  dts_Array        = 'SOAP-ENC:Array';
  dts_Array2        = 'soapenc:Array';
  dts_base64Binary = 'base64Binary';


type
  { Misc }
  TROXMLSerializationOption = (
    xsoWriteMultiRefArray, // for literal, use false
    xsoWriteMultiRefObject,  // for literal, use false
    xsoSendUntyped,  // for literal, use true
    xsoStrictStructureFieldOrder,
    xsoIgnoreStructureType,
    xsoEncodedXML, // for literal, use false
    xsoClientIdInWsdl,
    xsoDocument, // for document, use true; if both doc & literal are true it uses wrapped arguments
    xsoSplitServiceWsdls,
    xsoExternalTypesAsReferences // This will emit "import" references to external resources in the wsdl and namespace references in the body of messages.
    );

  TROXMLSerializationOptions = set of TROXMLSerializationOption;

  TXMLSerializationOption = TROXMLSerializationOption {$IFDEF DELPHI10UP}deprecated{$ENDIF};
  TXMLSerializationOptions = TROXMLSerializationOptions {$IFDEF DELPHI10UP}deprecated{$ENDIF};

  { TROXMLSerializer }
  TROXMLSerializer = class(TROSerializer)
  private
    fNode: IXMLNode;
    fPrefixMap: TStrings;
    fPrefix: string;
    fCurrentNamespace: string;
    fSerializationOptions: TROXMLSerializationOptions;

    fBodyNode : IXMLNode;
    fMaxRef : integer;
    fRespNode : IXMLNode;

    function BodyNode : IXMLNode;
    function FindNode(const aName: string; ArrayElementId : integer): boolean;
    function GetObject(const aName: string; ArrayElementId : integer): IXMLNode;
    function FindSoapReference(subnode: IXMLNode): IXMLNode;
    function AddNode(aCurrent: IXmlNode; const aName: string): IXMLNode;
    procedure SetCurrentNamespace(const Value: string);
  protected
    { Internal }
    function GetRecordStrictOrder: Boolean; override;
       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 WriteDecimal(const aName: String; const Ref; ArrayElementId: Integer = -1); override;
    procedure WriteGuid(const aName: String; const Ref; ArrayElementId: Integer = -1); override;
    procedure WriteXml(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 }
    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 ReadDecimal(const aName: String; var Ref; ArrayElementId: Integer = -1); override;
    procedure ReadGuid(const aName: String; var Ref; ArrayElementId: Integer = -1); override;
    procedure ReadXml(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
    constructor Create(aStorageRef:pointer);
    destructor Destroy; override;

    property CurrentNamespace: string read fCurrentNamespace write SetCurrentNamespace;
    property Prefix: string read fPrefix;
    property PrefixMap: TStrings read fPrefixMap;

    procedure SetStorageRef(aStorageRef:pointer);
    function GetArrayElementName(anItemType : PTypeInfo; anItemReference: pointer): string; override;

    property SerializationOptions : TROXMLSerializationOptions read fSerializationOptions write fSerializationOptions;
  end;

const
  RESERVED_WORD_PREFIX = '___';

function  Unprefix(const AStr: String; const APrefix: String = RESERVED_WORD_PREFIX): String;

function XMLToObject(const someXML : string) : TROComplexType;
function ObjectToXML(anObject : TROComplexType;
                     const anObjectName : string = '') : string;

procedure SplitNodeName(const aNode : IXMLNode; out aNameSpace, aLocalName : string);

function SOAPDateTimeToDateTime(const aSOAPDate  : string) : TDateTime;
function DateTimeToSOAPDateTime(aDateTime : TDateTime) : string;

function ExtractServerURL(const aFullURL : string) : string;

function SOAPStrToFloat(const aString: string): Extended;

//function AddXMLChildNode(aParent : IXMLNode; const aName : string; const aNamespace: WideString = '') : IXMLNode;
function AddXMLAttribute(aNode : IXMLNode; const aName: string; const aValue : WideString) : IXMLNode;
procedure AddXMLTextValue(aNode : IXMLNode; const aValue : WideString);

function FindChildNode(aParent : IXMLNode; const aName : string; StartFrom : integer; IsOnlyLocalName : boolean = FALSE) : IXMLNode;
function FindChildNodeByAttribute(aParent : IXMLNode; const anAttributeName, anAttributeValue : string) : IXMLNode;
function FindParentNode(aNode : IXMLNode; const aName : string; IsOnlyLocalName : boolean = FALSE) : IXMLNode;
function FindAttribute(aNode : IXMLNode; const aName : string; IsOnlyLocalName : boolean = FALSE) : IXMLNode;
function GetXMLTextValue(aNode : IXMLNode) : widestring;

{$IFDEF DELPHI7UP}
const SOAPLocale = 1033;
var SOAPFormatSettings : TFormatSettings;
{$ENDIF DELPHI7}

implementation

uses
  {$IFDEF DELPHI5}Windows, {$ENDIF}
  Math, uRORes, uROCompression, uROClasses, Variants, uROBinaryHelpers;


function ObjectToXML(anObject : TROComplexType;
                     const anObjectName : string = '') : string;
var objname : string;
    doc : IXMLDocument;
begin
  result := '';

  if (anObjectName='') then objname := 'Object'
                       else objname := anObjectName;

  doc := NewROXmlDocument;
  doc.New(anObject.ClassName);

  with TROXMLSerializer.Create(pointer(doc.DocumentNode)) do try
  //with TROXMLSerializer.Create(doc.DocumentNode) do try
    SerializationOptions := [xsoSendUntyped];
    Write(anObject.ClassName, anObject.ClassInfo, anObject);

   {$IFDEF RemObjects_OpenXML}
    result := doc.XML;   //mej - OpenXML seems to not behave the same way as MSDOM
   {$ELSE}
    result := doc.DocumentNode.XML;
   {$ENDIF}

  finally
    Free;
  end;
end;

function XMLToObject(const someXML : string) : TROComplexType;
var clsname : string;
    cls : TROComplexTypeClass;
    doc : IXMLDocument;
    ss : TStringStream;
begin
  ss := TStringStream.Create(someXML);
  ss.Position := 0;
  try
    doc := NewROXmlDocument;
    doc.New;
    doc.LoadFromStream(ss);
  finally
    ss.Free;
  end;
  clsname := doc.DocumentNode.Name;
  cls := FindROClass(clsname);

  if (cls=NIL) then RaiseError(err_UnknownClass, [clsname]);

  with TROXMLSerializer.Create(pointer(doc.DocumentNode)) do try
  //with TROXMLSerializer.Create(doc.DocumentNode) do try
    Read(clsname, cls.ClassInfo, result);
  finally
    Free;
  end;
end;

procedure SplitName(const aName : string; out aNameSpace, aLocalName : string);
var idx : integer;
begin
  aNameSpace := '';
  if (aName='') then begin
    aLocalName := '';
    Exit;
  end
  else aLocalName := aName;

  idx := Pos(':', aName);
  if (idx>0) then begin
    aNameSpace := Copy(aName, 1, idx-1);
    aLocalName := Copy(aName, idx+1, Length(aName)-idx);
  end;
end;

// Required for a bug in OpenXML which never assigns correctly LocalName
procedure SplitNodeName(const aNode : IXMLNode; out aNameSpace, aLocalName : string);
begin
//  SplitName(aNode.nodeName, aNameSpace, aLocalName)
  SplitName(aNode.Name, aNameSpace, aLocalName)
end;

function SOAPStrToFloat(const aString: string): Extended;
begin
  {$IFDEF DELPHI7UP}
  Result := StrToFloat(aString,SOAPFormatSettings);// then
  {$ELSE}
  Result := StrToFloat(StringReplace(aString, '.', DecimalSeparator, []));
  {$ENDIF}
    //RaiseError(err_ErrorConvertingFloat, [aString]);
  //Val(aString, Result, e);
  //if (e<>0) then RaiseError(err_ErrorConvertingFloat, [aString, e]);
end;

function SOAPDateTimeToDateTime(const aSOAPDate : string) : TDateTime;
var year, month, day, hour, min, sec : word;
  msec: double;
  ldummy, i: Integer;
  s: string;
begin
  // This probabily will all change. See W3C specs for date/time
  case Length(aSOAPDate) of
    SOAP_DateFormatLength : begin {yyyy-mm-dd}
      year  := StrToInt(Copy(aSOAPDate,1,4));
      month := StrToInt(Copy(aSOAPDate,6,2));
      day   := StrToInt(Copy(aSOAPDate,9,2));
      result := EncodeDate(year, month, day);
    end;
    SOAP_TimeFormatLength : begin {hh:nn:ss}
      hour  := StrToInt(Copy(aSOAPDate,1,2));
      min   := StrToInt(Copy(aSOAPDate,4,2));
      sec   := StrToInt(Copy(aSOAPDate,7,2));
      result := EncodeTime(hour, min, sec, 0);
    end;
    else {SOAP_DateTimeFormatLength : } begin {yyyy-mm-ddThh:nn:ss}
      year  := StrToInt(Copy(aSOAPDate,1,4));
      month := StrToInt(Copy(aSOAPDate,6,2));
      day   := StrToInt(Copy(aSOAPDate,9,2));
      hour  := StrToInt(Copy(aSOAPDate,12,2));
      min   := StrToInt(Copy(aSOAPDate,15,2));
      sec   := StrToInt(Copy(aSOAPDate,18,2));
      s := copy(aSOAPDate, 20, MaxInt);
      if (Length(s) > 1) and (s[1] = '.') then begin
        i := LastDelimiter('+-Z', s);
        if i > 0 then begin
          Val(Copy(s, 1, i -1), msec, ldummy);
          delete(s, 1, i-1);
        end else begin
          Val(s, msec, ldummy);
          s := '';
        end;
        msec := msec * (1.0 / 60.0 / 60.0 / 24);
      end else
        msec := 0;

      result := EncodeDate(year, month, day);
      // The code below is required! Do not adjust
      if (result<0) then begin
        result := result-EncodeTime(hour, min, sec, 0);
        result := result - msec;
      end else begin
        result := result+EncodeTime(hour, min, sec, 0);
        result := result + msec;
      end;
      if (Length(s) > 0) and ((s[1] = '+') or (s[1] = '-')) then begin
        if s[1] = '-' then i := -1 else i := 1;
        Delete(s,1,1);
        if pos(':', s) > 0 then begin
          hour := StrToInt(copy(s,1,Pos(':', s)-1));
          delete(s,1,pos(':', s));
          min := StrToInt(s);
        end else begin
          hour := StrToInt(s);
          min := 0;
        end;
        if i = 1 then
          Result := Result - (1.0 / 86400.0) * (min + 60 * hour) * 60
        else
          Result := Result + (1.0 / 86400.0) * (min + 60 * hour) * 60;
      end;
    end;
  end;
end;

function DateTimeToSOAPDateTime(aDateTime : TDateTime) : string;
begin
  result := FormatDateTime(SOAP_DateTimeFormat, aDateTime);
end;

function ExtractServerURL(const aFullURL : string) : string;
const ProtocolID = 'http://';
var p : integer;
begin
  result := Trim(StringReplace(aFullURL, ProtocolID, '', [rfReplaceAll, rfIgnoreCase]));
  p := LastDelimiter('/', result);
  if (p>0)
    then result := ProtocolID+Copy(result, 1, p)
    else result := ProtocolID+result;
end;

(*function AddXMLChildNode(aParent : IXMLNode; const aName : string; const aNamespace: WideString = '') : IXMLNode;
begin
  {result := aParent.ownerDocument.createElement(aName);
  aParent.appendChild(result);}
  result := aParent.Add(aName, aNamespace)
end;*)

function AddXMLAttribute(aNode : IXMLNode; const aName: string; const aValue : WideString) : IXMLNode;
begin
  {result := aNode.ownerDocument.createAttribute(aName);
  result.nodeValue := aValue;
  aNode.attributes.setNamedItem(result);}
  result := aNode.AddAttribute(aName, aValue);
end;

procedure AddXMLTextValue(aNode : IXMLNode; const aValue : widestring);
begin
  //aNode.appendChild(aNode.ownerDocument.createTextNode(aValue));
  aNode.Value := aValue
end;

function FindParentNode(aNode : IXMLNode; const aName : string; IsOnlyLocalName : boolean = FALSE) : IXMLNode;
var ns, locname : string;
    parent : IXMLNode;
begin
  result := NIL;
  while (aNode.Parent<>NIL) do begin
    parent := aNode.Parent;

    if IsOnlyLocalName then begin
      SplitNodeName(parent, ns, locname);
      if (CompareText(locname, aName)=0) then begin
        result := parent;
        Exit;
      end;
    end
    else if (parent.Name=aName) then begin
      result := parent;
      Exit;
    end;

    aNode := parent;
  end;
end;

function FindChildNode(aParent : IXMLNode; const aName : string; StartFrom : integer; IsOnlyLocalName : boolean = FALSE) : IXMLNode;
var i, startidx  : integer;
    locname, ns : string;
    item : IXMLNode;
begin
  result := NIL;

  with aParent do begin
    // fix for arrays. I was always using the first item...
    if (StartFrom>=0) then startidx := StartFrom
                      else startidx := 0;
                      
    for i := startidx to (childrenCount-1) do begin
      item := Children[i];
                         
      if IsOnlyLocalName then begin
        SplitNodeName(item, ns, locname);

        if (CompareText(locname, aName)=0) then begin // I am ignoring XML case sensitivity here...
          result := item;
          Exit;
        end;

        // Moved down by AleF. This "patch" actually breaks regular webservices
        // processing. Let's keep it here as an extreme measure for Amazon alike web services
        {if (ns = '') and SameText(locname, 'return') then begin
          Result := FindChildNode(item, aName, StartFrom, IsOnlyLocalName);
          Exit;
        end;}
      end
      else begin
        if (item.Name=aName) then begin
          result := item;
          Exit;
        end;
      end
    end
  end;
end;

function FindChildNodeByAttribute(aParent : IXMLNode; const anAttributeName, anAttributeValue : string) : IXMLNode;
var i : integer;
    //attr : IXMLNode;
    item, item2 : IXMLNode;
    //list : IXMLNodeList;
begin
  result := NIL;

  with aParent do
    for i := 0 to (ChildrenCount-1) do begin
      item := Children[i];
      item2 := item.GetNodeByAttribute(anAttributeName, anAttributeValue);

      if (item2<>NIL) then begin
        result := item;
        Exit;
      end;
    end
end;

function FindAttribute(aNode : IXMLNode; const aName : string; IsOnlyLocalName : boolean = FALSE) : IXMLNode;
//var i : integer;
    //locname, ns : string;
begin
  result := NIL;
  result := aNode.GetAttributeByName(aName);

  {with aNode do
    for i := 0 to (AttributeCount-1) do begin
      if IsOnlyLocalName then begin
        SplitNodeName(attributes.item(i), ns, locname);
        if (locname=aName) then begin
          result := attributes.item(i);
          Exit;
        end;
      end
      else begin
        if (attributes.item(i).nodeName=aName) then begin
          result := attributes.item(i);
          Exit;
        end;
      end
    end}
end;

function GetXMLTextValue(aNode : IXMLNode) : WideString;
//var textnode : IXMLNode;
begin
  //textnode := aNode.childNodes.item(0);
  {if Assigned(textnode) and (textnode.hasChildNodes) and (textnode.nodeName='#text')
    then result := textnode.textContent
    else result := '';}
  result := aNode.Value
end;

function SameText(A, B : string) : boolean;
begin
  result := CompareText(a,b)=0
end;

function TypeInfoNameToSOAPType(aTypeInfo : PTypeInfo) : string;
begin
  case aTypeInfo^.Kind of
    tkEnumeration : begin
      if (aTypeInfo=TypeInfo(boolean))
        then result := ns_xsd+':boolean'
        else result := ns_Custom+':'+aTypeInfo^.Name;
    end;
    tkInteger  : begin
      case GetTypeData(aTypeInfo)^.OrdType of
        otSByte : result := ns_xsd+':byte';
        otUByte : result := ns_xsd+':unsignedByte';
        otSWord : result := ns_xsd+':short';
        otUWord : result := ns_xsd+':unsignedShort';
        otSLong : result := ns_xsd+':int';
        otULong : result := ns_xsd+':unsignedInt';
      end;
    end;
    tkInt64    : result := ns_xsd+':long';
                 // TODO: this wont work for DateTime's inside records or arrays
    tkFloat    : if (aTypeInfo=TypeInfo(TDateTime)) then result := ns_xsd+':dateTime'
                 else begin
                    case GetTypeData(aTypeInfo)^.FloatType of
                      ftSingle   : result := ns_xsd+':float';
                      ftDouble   : result := ns_xsd+':double';
                      ftExtended : result := ns_xsd+':double';
                      ftComp     : result := ns_xsd+':double';
                      ftCurr     : result := ns_xsd+':double';
                    end;
                 end;
    tkWString,
    tkLString,
    tkString   : result := ns_xsd+':string';

    tkClass    :
      begin
        if aTypeInfo = typeinfo(Binary) then
          result := ns_xsd+':'+dts_base64Binary
        else
          result := ns_Custom+':'+aTypeInfo^.Name;
      end;
    tkVariant:
      begin
        if aTypeInfo = typeinfo(TDecimalVariant) then result := ns_xsd+':decimal' else
          result := ns_xsd+':anyType';
      end;
    tkInterface:
      result := ns_xsd+':any';
  end;

end;

function VarTypeNameToSOAPType(aVarType : TVarType) : string;
begin
  result := '';
  case aVarType of
    varBoolean  : result := ns_xsd+':boolean';
    varInteger  : result := ns_xsd+':int';
    varWord     : result := ns_xsd+':unsignedShort';
    varSmallInt : result := ns_xsd+':short';
    varByte     : result := ns_xsd+':unsignedByte';
    varShortInt : result := ns_xsd+':byte';
    varSingle   : result := ns_xsd+':float';
    varDouble,
    varCurrency : result := ns_xsd+':double';
    varDate     : result := ns_xsd+':dateTime';
    varOleStr,
    varString   : result := ns_xsd+':string';
    varLongWord : result := ns_xsd+':unsignedInt';
    varInt64    : result := ns_xsd+':long';
    varEmpty,
    varNull: result := ns_xsd+':null';
  else
    if aVarType = VarFMTBcd then
      result := ns_xsd +':decimal'
    else
      result := ns_Custom+':unknown';
  end;
end;

function  Unprefix(const AStr, APrefix: String): String;
var
  L: Integer;
begin
  L := Length(APrefix);
  if StrLIComp(PChar(AStr), PChar(APrefix), Min(Length(AStr), L)) = 0 then
    Result :=Copy(AStr, L + 1, MaxInt)
  else
    Result := AStr;
end;

{ TROXMLSerializer }
constructor TROXMLSerializer.Create(aStorageRef: pointer);
begin
  inherited Create;
  SetStorageRef(aStorageRef);
  fPrefixMap := TStringList.Create;
//  fSerializationOptions := [xsoWriteMultiRefArray, xsoWriteMultiRefObject];
  fSerializationOptions := [xsoSendUntyped, xsoStrictStructureFieldOrder, xsoDocument, xsoSplitServiceWsdls];
end;

{$IFDEF DELPHI5}
function Supports(const Instance: IUnknown; const Intf: TGUID): Boolean; overload;
var lDummyInst:IUnknown;
begin
  result := Supports(Instance, Intf, lDummyInst);
end;
{$ENDIF DELPHI5}

procedure TROXMLSerializer.SetStorageRef(aStorageRef : pointer);
begin
  fNode := nil;
  if Supports(IUnknown(aStorageRef), IXMLNode) then begin
    //RaiseError('TROXMLSerializer: Not a valid IXMLNode reference',[]);
    fBodyNode := NIL;
    fRespNode := NIL;
    fMaxRef := 0;
    fNode := IXMLNode(aStorageRef);
  end;
  {fNode := aStorageRef;}
end;

procedure TROXMLSerializer.EndReadObject(const aName: string;
  aClass : TClass; var anObject: TObject; const LevelRef : IUnknown);
begin
  fNode := IXMLNode(pointer(LevelRef));   
end;

procedure TROXMLSerializer.EndWriteObject(const aName: string;
  aClass : TClass; anObject: TObject; const LevelRef : IUnknown);
begin
  fNode := IXMLNode(pointer(LevelRef));
end;

procedure TROXMLSerializer.ReadDateTime(const aName: string; var Ref; ArrayElementId : integer = -1);
var subnode : IXMLNode;
begin
  subnode := GetObject(aName, ArrayElementId);

  subnode := FindSoapReference(subnode);

  if (subnode<>NIL)
    then TDateTime(Ref) := SOAPDateTimeToDateTime(GetXMLTextValue(subnode))
    else TDateTime(Ref) := 0;
    //else RaiseError(err_ParameterNotFound, [aName]);
end;

procedure TROXMLSerializer.ReadEnumerated(const aName: string;
  anEnumTypeInfo: PTypeInfo; var Ref; ArrayElementId : integer = -1);
var subnode : IXMLNode;
    s, lTypeName : string;
    lIndexInEnum: Integer;
begin
  subnode := GetObject(aName, ArrayElementId);

  subnode := FindSoapReference(subnode);

  if (subnode<>NIL)
    then begin
      s := GetXMLTextValue(subnode);
      lIndexInEnum  := GetEnumValue(anEnumTypeInfo, s);
      if lIndexInEnum = -1 then begin
        lIndexInEnum  := GetEnumValue(anEnumTypeInfo, anEnumTypeInfo.Name+'_'+s);
        if lIndexInEnum = -1 then begin
          lTypeName := anEnumTypeInfo^.Name;
          if anEnumTypeInfo = typeinfo(Boolean) then begin
            if s = '1' then begin
              byte(Ref) := 1;
              exit;
            end
            else if s = '0' then begin
              byte(Ref) := 0;
              exit;
            end;
          end;
          RaiseError(Format('The value "-1" for parameter "%s" of "%s" type is invalid', [aName, lTypeName]));
        end;
      end;
      byte(Ref) := lIndexInEnum;
    end else begin
      byte(Ref) := 0;
    end;
    //else RaiseError(err_ParameterNotFound, [aName]);
end;

procedure TROXMLSerializer.ReadDouble(const aName: string;
  aFloatType: TFloatType; var Ref; ArrayElementId : integer = -1);
var
  subnode : IXMLNode;
  text: string;
begin
  subnode := GetObject(aName, ArrayElementId);

  subnode := FindSoapReference(subnode);

  if (subnode<>NIL) then begin
    text := GetXMLTextValue(subnode);

    {$IFNDEF DELPHI7UP}
      if DecimalSeparator <> '.' then
        ReplaceChar(text, ['.'], DecimalSeparator);
    {$ENDIF}

    case aFloatType of
      ftSingle : single(Ref) := SOAPStrToFloat(text);
      ftDouble : double(Ref) := SOAPStrToFloat(text);
      ftExtended : extended(Ref) := SOAPStrToFloat(text);
      ftComp : comp(Ref) := SOAPStrToFloat(text);
      ftCurr : currency(Ref) := SOAPStrToFloat(text);
    end;
  end else begin
    case aFloatType of
      ftSingle : single(Ref) := 0;
      ftDouble : double(Ref) := 0;
      ftExtended : extended(Ref) := 0;
      ftComp : comp(Ref) := 0;
      ftCurr : currency(Ref) := 0;
    end;
  end;
  //else RaiseError(err_ParameterNotFound, [aName]);
end;

procedure TROXMLSerializer.ReadInt64(const aName: string; var Ref; ArrayElementId : integer = -1);
var subnode : IXMLNode;
begin
  subnode := GetObject(aName, ArrayElementId);

  subnode := FindSoapReference(subnode);

  if (subnode<>NIL)
    then int64(Ref) := StrToInt64(GetXMLTextValue(subnode))
    else int64(Ref) := int64(0);
    //else RaiseError(err_ParameterNotFound, [aName]);
end;

procedure TROXMLSerializer.ReadInteger(const aName: string;
  anOrdType: TOrdType; var Ref; ArrayElementId : integer = -1);
var subnode : IXMLNode;
begin
  subnode := GetObject(aName, ArrayElementId);
  subnode := FindSoapReference(subnode);

  if (subnode<>NIL) then
    case anOrdType of
      otSByte,
      otUByte : byte(Ref) := StrToInt(GetXMLTextValue(subnode));
      otSWord,
      otUWord : word(Ref) := StrToInt(GetXMLTextValue(subnode));
      otSLong,
      otULong : integer(Ref) := StrToInt(GetXMLTextValue(subnode));
    end
  else
    case anOrdType of
      otSByte,
      otUByte : byte(Ref) := 0;
      otSWord,
      otUWord : word(Ref) := 0;
      otSLong,
      otULong : integer(Ref) := 0;
    end
  //else RaiseError(err_ParameterNotFound, [aName]);
end;

procedure TROXMLSerializer.ReadUTF8String(const aName: string; var Ref; ArrayElementId : integer = -1; iMaxLength:integer=-1);
var subnode : IXMLNode;
begin
  subnode := GetObject(aName, ArrayElementId);

  subnode := FindSoapReference(subnode);

  if (subnode<>NIL) then
    string(Ref) := GetXMLTextValue(subnode)
  else
    string(Ref) := '';
    //else RaiseError(err_ParameterNotFound, [aName]);
end;

procedure TROXMLSerializer.ReadWideString(const aName: string; var Ref; ArrayElementId : integer = -1; iMaxLength:integer=-1);
var subnode : IXMLNode;
begin
  subnode := GetObject(aName, ArrayElementId);

  subnode := FindSoapReference(subnode);

  if (subnode<>NIL) then 
    widestring(Ref) := GetXMLTextValue(subnode)
  else 
    widestring(Ref) := '';
    //else RaiseError(err_ParameterNotFound, [aName]);
end;

procedure TROXMLSerializer.WriteDateTime(const aName: string; const Ref; ArrayElementId : integer = -1);
var newnode : IXMLNode;
begin
  newnode := AddNode(fNode, Unprefix(aName));
  if not (xsoSendUntyped in SerializationOptions) then
    AddXMLAttribute(newnode, 'xsi:type', 'xsd:dateTime');
  AddXMLTextValue(newnode, DateTimeToSOAPDateTime(TDateTime(Ref)));
end;

procedure TROXMLSerializer.WriteEnumerated(const aName: string;
  anEnumTypeInfo: PTypeInfo; const Ref; ArrayElementId : integer = -1);
var newnode : IXMLNode;
    isbool : boolean;
    val : string;
    lEnumName: String;
begin
  newnode := AddNode(fNode, Unprefix(aName));
  isbool := (anEnumTypeInfo.Name='Boolean');

  lEnumName := anEnumTypeInfo^.Name;
  if not (xsoSendUntyped in SerializationOptions) then begin
    if isbool
      then AddXMLAttribute(newnode, 'xsi:type', 'xsd:boolean')
      else AddXMLAttribute(newnode, 'xsi:type', ns_Custom+':'+lEnumName);
  end;

  val := GetEnumName(anEnumTypeInfo, Ord(byte(Ref)));
  if (Length(val) > Length(lEnumName) + 2) and
     (Copy(val, 1, Length(lEnumName) + 1) = lEnumName + '_') then begin
    val := Copy(val, Length(lEnumName) + 2, MaxInt);
  end;
  if isbool then val := LowerCase(val);

  AddXMLTextValue(newnode, val); // TODO: check enums bigger than a byte!
end;

procedure TROXMLSerializer.WriteDouble(const aName: string;
  aFloatType: TFloatType; const Ref; ArrayElementId : integer = -1);
var src : pointer;
    text, dtype : string;
    newnode : IXMLNode;
begin
  src := @Ref;
  case aFloatType of
    ftSingle   : begin
      text := FloatToStr(single(src^){$IFDEF DELPHI7UP},SOAPFormatSettings{$ENDIF});
      {$IFNDEF DELPHI7UP}text := StringReplace(text, DecimalSeparator, '.', []);{$ENDIF}
      dtype := 'float';
    end;
    ftDouble   : begin
      text := FloatToStr(double(src^){$IFDEF DELPHI7UP},SOAPFormatSettings{$ENDIF});
      {$IFNDEF DELPHI7UP}text := StringReplace(text, DecimalSeparator, '.', []);{$ENDIF}
      dtype := 'double';
    end;
    ftExtended : begin
      text := FloatToStr(extended(src^){$IFDEF DELPHI7UP},SOAPFormatSettings{$ENDIF});
      {$IFNDEF DELPHI7UP}text := StringReplace(text, DecimalSeparator, '.', []);{$ENDIF}
      dtype := 'double';
    end;
    ftComp     : begin
      text := FloatToStr(comp(src^){$IFDEF DELPHI7UP},SOAPFormatSettings{$ENDIF});
      {$IFNDEF DELPHI7UP}text := StringReplace(text, DecimalSeparator, '.', []);{$ENDIF}
      dtype := 'double';
    end;
    ftCurr     : begin
      text := FloatToStr(currency(src^){$IFDEF DELPHI7UP},SOAPFormatSettings{$ENDIF});
      {$IFNDEF DELPHI7UP}text := StringReplace(text, DecimalSeparator, '.', []);{$ENDIF}
      dtype := 'double';
    end;
  end;

  newnode := AddNode(fNode, Unprefix(aName));
  if not (xsoSendUntyped in SerializationOptions) then
    AddXMLAttribute(newnode, 'xsi:type', 'xsd:'+dtype);
  AddXMLTextValue(newnode, text);
end;

procedure TROXMLSerializer.WriteInt64(const aName: string; const Ref; ArrayElementId : integer = -1);
var src : pointer;
    text : string;
    newnode : IXMLNode;
begin
  src := @Ref;
  text := IntToStr(int64(src^));

  newnode := AddNode(fNode, Unprefix(aName));
  if not (xsoSendUntyped in SerializationOptions) then
    AddXMLAttribute(newnode, 'xsi:type', 'xsd:long');
  AddXMLTextValue(newnode, text);
end;

procedure TROXMLSerializer.WriteInteger(const aName: string;
  anOrdType: TOrdType; const Ref; ArrayElementId : integer = -1);
var src : pointer;
    text, dtype : string;
    newnode : IXMLNode;
begin
  src := @Ref;
  case anOrdType of
    otSByte : begin
      text := IntToStr(shortint(src^));
      dtype := 'byte';
    end;
    otUByte : begin
      text := IntToStr(byte(src^));
      dtype := 'unsignedByte';
    end;
    otSWord : begin
      text := IntToStr(smallint(src^));
      dtype := 'short';
    end;
    otUWord : begin
      text := IntToStr(word(src^));
      dtype := 'unsignedShort';
    end;
    otSLong : begin
      text := IntToStr(integer(src^));
      dtype := 'int';
    end;
    otULong : begin
      text := IntToStr(integer(src^));
      dtype := 'unsignedInt';
    end;
  end;

  newnode := AddNode(fNode, Unprefix(aName));
  if not (xsoSendUntyped in SerializationOptions) then
    AddXMLAttribute(newnode, 'xsi:type', 'xsd:'+dtype);
  AddXMLTextValue(newnode, text);
end;

procedure TROXMLSerializer.WriteUTF8String(const aName: string; const Ref; ArrayElementId : integer = -1);
var newnode : IXMLNode;
begin
  newnode := AddNode(fNode, Unprefix(aName));
  if not (xsoSendUntyped in SerializationOptions) then
    AddXMLAttribute(newnode, 'xsi:type', 'xsd:string');
  AddXMLTextValue(newnode, string(Ref));
end;

procedure TROXMLSerializer.WriteWideString(const aName: string; const Ref; ArrayElementId : integer = -1);
var newnode : IXMLNode;
begin
  newnode := AddNode(fNode, Unprefix(aName));
  if not (xsoSendUntyped in SerializationOptions) then
    AddXMLAttribute(newnode, 'xsi:type', 'xsd:string');
  AddXMLTextValue(newnode, WideString(Ref));

  newnode.Value := newnode.Value;
end;

procedure TROXMLSerializer.BeginReadObject(const aName: string;
  aClass : TClass; var anObject: TObject; var LevelRef : IUnknown; var IsValidType : boolean; ArrayElementId : integer = -1);
var cnt : integer;
    lNilAttr, hrefattr : IXMLNode;
    id : string;
    clsnme, namespc, clstype : string;
    lActualClass : TROComplexTypeClass;
begin
  inherited;

  if fRespNode = nil then
    fRespNode := fNode;

  LevelRef := fNode;

  fnode := GetObject(aName, ArrayElementId);

  fnode := FindSoapReference(fnode);

  if (fNode=NIL) then begin
    // No such node found
    anObject := NIL;
    Exit;
  end;

  lNilAttr := fNode.GetAttributeByName(tag_Nil);
  if Assigned(lNilAttr) and (lNilAttr.Value = tag_NilValue) then begin
    anObject := NIL;
    Exit;
  end;

  hrefattr := fNode.GetAttributeByName(tag_HRef);
  if (hrefattr<>NIL) then begin
    id := Copy(hrefattr.Value, 2, Length(hrefattr.Value)); // Removes the '#'
    fNode := FindChildNodeByAttribute(BodyNode, tag_Id, id);
    if fNode = nil then
      fNode := FindChildNodeByAttribute(fRespNode, tag_Id, id);
  end;

  if aClass.InheritsFrom(TStream) then begin
    anObject := TROBinaryMemoryStream.Create;
    IsValidType := TRUE;
  end

  else if aClass.InheritsFrom(EROException) then begin
    // Does nothing here
    IsValidType := TRUE;
  end

  else if IsValidType then begin
    clstype := VarToStr(fNode.GetAttributeValue('xsi:type', aClass.ClassName));
    if (clstype = dts_Array) or (clstype = dts_Array2) then begin
      //For arrays this attribute does't contain actual class name.
      anObject := TROComplexTypeClass(aClass).Create;
    end else begin
      if xsoIgnoreStructureType in fSerializationOptions then begin
        anObject := TROComplexTypeClass(aClass).Create;
      end
      else begin
        SplitName(clstype, namespc, clsnme);
        lActualClass := FindROClass(clsnme);

        if not Assigned(lActualClass) then RaiseError(err_UnknownClassInStream,[clsnme]);
        if not lActualClass.InheritsFrom(aClass) then RaiseError(err_UnexpectedClassInStream,[clsnme,aClass.ClassName]);
        anObject := lActualClass.Create;
      end;
    end;

    if (anObject is TROArray) then begin
      cnt := fNode.ChildrenCount;
      TROArray(anObject).Resize(cnt);
    end;
  end;
end;

function GetNamespace(aClass: TClass; aInst: Tobject): string;
var
  i: Integer;
begin
  if aInst is TROComplexType then aClass := aInst.ClassType;
  if (aClass <> nil) and (aClass.InheritsFrom(TROComplexType)) or (aClass = TROComplexType) then begin
    for i := TROComplexTypeClass(aClass).GetAttributeCount -1 downto 0 do begin
      if TROComplexTypeClass(aClass).GetAttributeName(i) = 'ImportedFromNamespace' then begin
        result := TROComplexTypeClass(aClass).GetAttributeValue(i);
        exit;
      end;
    end;
  end;
  result := '';
end;

procedure TROXMLSerializer.BeginWriteObject(const aName: string;
  aClass : TClass; anObject: TObject; var LevelRef : IUnknown; var IsValidType : boolean; out IsAssigned:Boolean; ArrayElementId : integer = -1);
var id : string;
    refnode : IXMLNode;
    xsiattr : IXMLNode;
    lName: String;
begin
  lName := Unprefix(aName);

  inherited BeginWriteObject(lName, aClass, anObject, LevelRef, IsValidType, IsAssigned, ArrayElementId);

  if fRespNode = nil then
    fRespNode := fNode;

  IsAssigned := Assigned(anObject);

  if aClass.InheritsFrom(TStream) then begin
    LevelRef := fNode;
    fNode := AddNode(fNode, lName);

    if Assigned(anObject) then begin
      if not (xsoSendUntyped in SerializationOptions) then
        xsiattr := AddXMLAttribute(fNode, 'xsi:type', 'xsd:'+dts_base64Binary);
      IsValidType := TRUE;
    end
    else begin
      AddXMLAttribute(fNode, tag_Nil, tag_NilValue);
    end;
  end
  else if IsValidType then begin // It is then a TROComplexType

    LevelRef := fNode;

    if ((aClass.InheritsFrom(TROArray) and (xsoWriteMultiRefArray in SerializationOptions)) or
      (not aClass.InheritsFrom(TROArray)) and (xsoWriteMultiRefObject in SerializationOptions)) then begin

      if Assigned(anObject) then begin
        id := IntToStr(fMaxRef);
        Inc(fMaxRef);

        {refnode := fNode;

        fNode := AddXMLChildNode(fRespNode, ns_Custom+':'+anObject.ClassName);
        AddXMLAttribute(fNode, tag_Id, id);

        refnode := AddXMLChildNode(refnode, lName);
        AddXMLAttribute(refnode, tag_href, '#'+id);}

        refnode := AddNode(fNode, lName);
        AddXMLAttribute(refnode, tag_href, '#'+id);

        fNode := AddNode(BodyNode, ns_Custom+':'+anObject.ClassName);
        AddXMLAttribute(fNode, tag_Id, id);

        if not (xsoSendUntyped in SerializationOptions) then
          if (anObject is TROArray) then begin
            xsiattr := AddXMLAttribute(fNode, 'xsi:type', dts_Array);
            //id := ns_Custom+':'+anObject.ClassName+'['+IntToStr(TROArray(anObject).Count)+']';
            id :=  TypeInfoNameToSOAPType(TROArray(anObject).GetItemType)+'['+IntToStr(TROArray(anObject).Count)+']';
            AddXMLAttribute(fNode, 'SOAP-ENC:arrayType', id);
          end
          else xsiattr := AddXMLAttribute(fNode, 'xsi:type', ns_Custom+':'+anObject.ClassName);
      end
      else begin
        refnode := AddNode(fNode, lName);
        AddXMLAttribute(refnode, tag_Nil, tag_NilValue);
      end;
    end

    else begin
      fNode := AddNode(fNode, lName);

      if not (xsoSendUntyped in SerializationOptions) then begin
        if (anObject is TROArray) then begin
          xsiattr := AddXMLAttribute(fNode, 'xsi:type', dts_Array);
          //id := ns_Custom+':'+anObject.ClassName+'['+IntToStr(TROArray(anObject).Count)+']';
          id :=  TypeInfoNameToSOAPType(TROArray(anObject).GetItemType)+'['+IntToStr(TROArray(anObject).Count)+']';
          AddXMLAttribute(fNode, 'SOAP-ENC:arrayType', id);
        end
        else xsiattr := AddXMLAttribute(fNode, 'xsi:type', ns_Custom+':'+anObject.ClassName);
      end
    end
  end;

  //if (fNode<>NIL) and not IsAssigned
    //then AddXMLAttribute(fNode, 'xsi:nil', 'true');
end;

procedure TROXMLSerializer.CustomReadObject(const aName: string;
  aClass : TClass; var Ref; ArrayElementId: integer);
var obj : TObject absolute Ref;
    ss : TStringStream;
begin
  inherited;
  if Assigned(obj) then begin

    if (obj is TStream) then begin
      ss := TStringStream.Create(fNode.Value);
      try
        DecodeStream(ss, TMemoryStream(obj));
        TMemoryStream(obj).Position := 0;
      finally
        ss.Free;
      end;
    end;

  end;
end;

procedure TROXMLSerializer.CustomWriteObject(const aName: string;
  aClass : TClass; const Ref; ArrayElementId : integer = -1);
var obj : TObject absolute Ref;
    ss : TStringStream;
begin
  inherited CustomWriteObject(Unprefix(aName), aClass, Ref, ArrayElementId);
  if Assigned(obj) then begin

    if (obj is TStream) then begin
      ss := TStringStream.Create('');
      try
        TStream(obj).Position := 0;
        EncodeStream(TStream(obj), ss);
        AddXMLTextValue(fNode, ss.DataString);
      finally
        ss.Free;
      end;
    end;

  end;
end;

function TROXMLSerializer.BodyNode: IXMLNode;
begin
  if (fBodyNode=NIL) then fBodyNode := FindParentNode(fNode, tag_Body, TRUE);
  result := fBodyNode;
end;

procedure TROXMLSerializer.ReadVariant(const aName: string; var Ref;
  ArrayElementId: integer);
var s,
    vartypestr,
    varnamespcstr : string;
    subnode : IXMLNode;

    lIntegerValue:integer;
    {$IFNDEF DELPHI5}
    lShortIntValue:shortint;
    lSmallIntValue: Smallint;
    //lInt64Value:Int64;
    {$ENDIF DELPHI5}
    lByteValue:byte;
    lBoolValue: boolean;
    lDoubleValue:double;
    lSingleValue:single;
    //lCurrencyValue:currency;
    lWordValue : word;
    lStringValue: widestring;
    lDateTimeValue : TDateTime;
begin
  subnode := GetObject(aName, ArrayElementId);

  subnode := FindSoapReference(subnode);

  if (subnode<>NIL) then begin
    // Determines the type of the value, if specified. Defaults to string.
    s := subnode.GetAttributeValue('xsi:empty', '');
    if s = '1' then begin
      Variant(ref) := Unassigned;
      exit;
    end;
    s := subnode.GetAttributeValue('xsi:null', '');
    if s = '1' then begin
      Variant(ref) := null
    end
    else begin
      s := subnode.GetAttributeValue('xsi:type', 'xsd:string');
      SplitName(s, varnamespcstr, vartypestr);

      // Returns the right type of variant
      if SameText(vartypestr, 'string') then begin
        ReadWideString(aName, lStringValue, ArrayElementId);
        Variant(Ref) := lStringValue;
      end

      else if SameText(vartypestr, 'float') then begin
        ReadDouble(aName, ftSingle, lSingleValue, ArrayElementId);
        Variant(Ref) := lSingleValue;
      end

      else if SameText(vartypestr, 'double') then begin
        ReadDouble(aName, ftDouble, lDoubleValue, ArrayElementId);
        Variant(Ref) := lDoubleValue;
      end

      else if SameText(vartypestr, 'byte') then begin
        ReadInteger(aName, otSByte, lShortIntValue, ArrayElementId);
        Variant(Ref) := lShortIntValue;
      end

      else if SameText(vartypestr, 'unsignedByte') then begin
        ReadInteger(aName, otUByte, lByteValue, ArrayElementId);
        Variant(Ref) := lByteValue;
      end

      else if SameText(vartypestr, 'short') then begin
        ReadInteger(aName, otSWord, lSmallIntValue, ArrayElementId);
        Variant(Ref) := lSmallIntValue;
      end

      else if SameText(vartypestr, 'unsignedShort') then begin
        ReadInteger(aName, otUWord, lWordValue, ArrayElementId);
        Variant(Ref) := lWordValue;
      end

      else if (SameText(vartypestr, 'int') or SameText(vartypestr, 'unsignedInt')) then begin
        ReadInteger(aName, otSLong, lIntegerValue, ArrayElementId);
        Variant(Ref) := lIntegerValue;
      end

      else if SameText(vartypestr, 'boolean') then begin
        ReadEnumerated(aName, TypeInfo(boolean), lBoolValue, ArrayElementId);
        Variant(Ref) := lBoolValue;
      end

      else if SameText(vartypestr, 'dateTime') then begin
        ReadDateTime(aName, lDateTimeValue, ArrayElementId);
        Variant(Ref) := lDateTimeValue;
      end
    end;
  end
  else RaiseError(err_ParameterNotFound, [aName]);
end;

procedure TROXMLSerializer.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;
    lBoolValue: boolean;
    lDoubleValue:double;
    lSingleValue:single;
    lCurrencyValue:currency;
    lWideString: widestring;
    newnode: IXMLNode;
begin
  varvalue := Variant(Ref);
  vtype := VarType(Variant(Ref));

  { Simple types }
  case vtype of
    varEmpty:
      begin
        newnode := AddNode(fNode, Unprefix(aName));
        AddXMLAttribute(newnode, 'xsi:empty', '1');
      end;
    varNull,varError:begin
      newnode := AddNode(fNode, Unprefix(aName));
      AddXMLAttribute(newnode, 'xsi:null', '1');
    end;
    {$IFNDEF DELPHI5}
    varShortInt:begin { 2, 10, 12 }
      lShortIntValue := varvalue;
      WriteInteger(aName, otSByte, lShortIntValue, ArrayElementId);
    end;
    varSmallInt,
    varWord : begin
      lSmallIntValue := varvalue;
      WriteInteger(aName, otSWord, lSmallIntValue, ArrayElementId); // Suspicious... This might be wrong
    end;
    {$ENDIF DELPHI5}
    {$IFNDEF DELPHI5}varLongWord,{$ENDIF DELPHI5}
    varInteger:begin { 3, 13 }
      lIntegerValue := varvalue;
      WriteInteger(aName, otSLong, lIntegerValue, ArrayElementId);
    end;
    varSingle:begin { 4 }
      lSingleValue := varvalue;
      WriteDouble(aName, ftSingle, lSingleValue, ArrayElementId);
    end;
    varDouble:begin { 5 }
      lDoubleValue := varvalue;
      WriteDouble(aName, ftDouble, lDoubleValue, ArrayElementId);
    end;
    varDate:begin { 7 } // This must be handled differently in SOAP!
      lDoubleValue := varvalue;
      WriteDateTime(aName, lDoubleValue, ArrayElementId);
    end;
    varCurrency:begin { 6 }
      lCurrencyValue := varvalue;
      WriteDouble(aName, ftCurr, lCurrencyValue, ArrayElementId);
    end;
    varBoolean:begin { B }
      lBoolValue:= varvalue;
      WriteEnumerated(aName, TypeInfo(boolean), lBoolValue, ArrayElementId);
    end;
    varByte:begin { 11 }
      lByteValue := varvalue;
      WriteInteger(aName, otUByte, lByteValue, ArrayElementId);
    end;
    {$IFNDEF DELPHI5}
(*    varInt64:begin { 14 }
      NotSupported('');
    end;*)
    {$ENDIF DELPHI5}
    varOleStr,varString:begin { 8, 100 }
      lWideString := varvalue;
      WriteWideString(aName, lWideString, ArrayElementId);
    end;
    else NotSupported(Format(err_UnsupportedVariantType, [VarType(varvalue)]));
  end;
end;

function TROXMLSerializer.GetArrayElementName(
  anItemType: PTypeInfo; anItemReference: pointer): string;
var tn: string;
begin
  case anItemType.Kind of
    tkClass   : begin
        if anItemReference = nil then result := anItemType^.Name else result := TObject(anItemReference).ClassName;
      end;
    tkVariant :
      begin
        tn := VarTypeNameToSOAPType(VarType(Variant(anItemReference^)));
        result := Copy(tn, Pos(':', tn)+1, MaxInt);
      end;
    else begin
      tn := TypeInfoNameToSOAPType(anItemType);
      result := Copy(tn, Pos(':', tn)+1, MaxInt);
    end;
  end;
end;

function TROXMLSerializer.GetRecordStrictOrder: Boolean;
begin
  Result := xsoStrictStructureFieldOrder in fSerializationOptions;
end;

function TROXMLSerializer.FindSoapReference(subnode: IXMLNode): IXMLNode;
var
  hrefattr: IXMLNode;
  id: string;
begin
  result := subnode;
  if subnode = nil then
    exit;
  hrefattr := subnode.GetAttributeByName(tag_HRef);
  if (hrefattr<>NIL) then begin
    id := Copy(hrefattr.Value, 2, Length(hrefattr.Value)); // Removes the '#'
    while subnode <> nil do begin
      result := FindChildNodeByAttribute(subnode, tag_Id, id);
      if result <> nil then break;
      subnode := subnode.Parent;
    end;
  end;
end;

function TROXMLSerializer.GetObject(const aName: string; ArrayElementId : integer): IXMLNode;
begin
  if (ArrayElementId>=0)
    then result := fNode.Children[ArrayElementId]
    else result := FindChildNode(fNode, Unprefix(aName), ArrayElementId,TRUE);
end;

procedure TROXMLSerializer.ReadXml(const aName: String; var Ref;
  ArrayElementId: Integer);
var
  w: WideString;
  doc: IXMLDocument;
  node: IXMLNode;
begin
  node := GetObject(aName, ArrayElementID);
  if (xsoEncodedXML in SerializationOptions) or (node = nil) or (node.FirstChild = nil) or (Node.FirstChild.name = '#text') then begin
    ReadWideString(aName, w, ArrayElementId);
    if w = '' then
      IXMLNode(Ref) := nil
    else begin
      doc := NewROXmlDocument;
      doc.New;
      doc.XML := w;
      IXMLNode(Ref) := doc.DocumentNode;
    end;
  end else begin
    if node = nil then IXMLNode(Ref) := nil else begin
      node := Node.FirstChild;
      if node = nil then begin
        IXMLNode(Ref) := nil;
      end else begin
        doc := NewROXmlDocument;
        doc.New;
        doc.XML := node.XML;
        IXMLNode(Ref) := doc.DocumentNode;
      end;
    end;
  end;
end;

procedure TROXMLSerializer.WriteXml(const aName: String; const Ref;
  ArrayElementId: Integer);
var
  w: WideString;
  newnode: IXMLNode;
begin
  if (xsoEncodedXML in SerializationOptions) then begin
    if IXMLNode(Ref) = nil then
      w := ''
    else
      w := IXMLNode(Ref).XML;
    WriteWideString(aName, w, ArrayElementId);
  end else begin
    newnode := AddNode(fNode, Unprefix(aName));
    if IXMLNode(Ref) <> nil then begin
      newnode.AddXml(IXMLNode(Ref).XML);
    end;
  end;
end;

procedure TROXMLSerializer.ReadDecimal(const aName: String; var Ref;
  ArrayElementId: Integer);
var
  s: string;
begin
   ReadUTF8String(aName, s, ArrayElementId);
   if DecimalSeparator <> '.' then s := StringReplace(s, '.', DecimalSeparator, []);
   Variant(Ref) := BCDToVariant(StrToBcd(s));
end;

procedure TROXMLSerializer.ReadGuid(const aName: String; var Ref;
  ArrayElementId: Integer);
var
  s: string;
begin
  ReadUTF8String(aName, s, ArrayElementId);
  if Copy(s,1,1) <> '{' then s := '{'+s+'}';
  string(Ref) := s;
end;

procedure TROXMLSerializer.WriteDecimal(const aName: String; const Ref;
  ArrayElementId: Integer);
var
  s: string;
begin
  s := BcdToStr(VariantToBCD(variant(Ref)));
  if DecimalSeparator <> '.' then s := StringReplace(s, DecimalSeparator, '.', []); // delphi has no way to format a bcd with a specific format
  WriteUTF8String(aName, s, ArrayElementId);
end;

procedure TROXMLSerializer.WriteGuid(const aName: String; const Ref;
  ArrayElementId: Integer);
var
  s: string;
begin
  s := GuidToString(StringToGUID(string(Ref)));
  s := copy(s,2,length(s) -2); // remove curlies
  WriteUTF8String(aName, s, ArrayElementId);
end;

procedure TROXMLSerializer.ReadBinary(const aName: string; var Ref;
  ArrayElementId: integer);
var
  obj : Binary absolute Ref;
  ss : TStringStream;
  LevelRef: IXMLNode;
begin
  LevelRef := fNode;
  try
    if FindNode(aName, ArrayElementId) then begin
      if not Assigned(obj) then obj:= Binary.Create;
      ss := TStringStream.Create(fNode.Value);
      try
        obj.Clear;
        DecodeStream(ss, TMemoryStream(obj));
        TMemoryStream(obj).Position := 0;
      finally
        ss.Free;
      end;
    end
    else
      Obj := nil;
  finally
    fNode := LevelRef;
  end;
end;

procedure TROXMLSerializer.WriteBinary(const aName: string; const Ref;
  ArrayElementId: integer);
var
  obj : Binary absolute Ref;
  ss : TStringStream;
  LevelRef: IXMLNode;
begin
  LevelRef := fNode;
//BeginWriteObject
{ TODO -oek : BeginWriteObject }
  fNode := AddNode(fNode, Unprefix(aName));
  if Assigned(obj) then begin
    if not (xsoSendUntyped in SerializationOptions) then  AddXMLAttribute(fNode, 'xsi:type', 'xsd:'+dts_base64Binary);
    ss := TStringStream.Create('');
    try
      obj.Position := 0;
      EncodeStream(obj, ss);
      AddXMLTextValue(fNode, ss.DataString);
    finally
      ss.Free;
    end;
  end
  else
    AddXMLAttribute(fNode, tag_Nil, tag_NilValue);
  fNode := LevelRef;
end;

procedure TROXMLSerializer.WriteArray(const aName: string; const Ref;
  ArrayElementId: integer);
var
  obj : TROArray absolute Ref;
  LevelRef: IXmlNode;
  id : string;
  refnode : IXMLNode;
  xsiattr : IXMLNode;
  lName: String;
begin
  LevelRef := fNode;
  try
    lName := Unprefix(aName);
    if fRespNode = nil then fRespNode := fNode;
    LevelRef := fNode;
    if (xsoWriteMultiRefArray in SerializationOptions) then begin
      if Assigned(obj) then begin
        id := IntToStr(fMaxRef);
        Inc(fMaxRef);

        refnode := AddNode(fNode, lName);
        AddXMLAttribute(refnode, tag_href, '#'+id);

        fNode := AddNode(BodyNode, ns_Custom+':'+obj.ClassName);
        AddXMLAttribute(fNode, tag_Id, id);

        if not (xsoSendUntyped in SerializationOptions) then begin
          xsiattr := AddXMLAttribute(fNode, 'xsi:type', dts_Array);
          id :=  TypeInfoNameToSOAPType(obj.GetItemType)+'['+IntToStr(obj.Count)+']';
          AddXMLAttribute(fNode, 'SOAP-ENC:arrayType', id);
        end;
      end
      else begin
        refnode := AddNode(fNode, lName);
        AddXMLAttribute(refnode, tag_Nil, tag_NilValue);
      end;
    end
    else begin
      fNode := AddNode(fNode, lName);
      if not (xsoSendUntyped in SerializationOptions) then begin
        xsiattr := AddXMLAttribute(fNode, 'xsi:type', dts_Array);
        id :=  TypeInfoNameToSOAPType(obj.GetItemType)+'['+IntToStr(obj.Count)+']';
        AddXMLAttribute(fNode, 'SOAP-ENC:arrayType', id);
      end
    end;
    if Assigned(Obj) then Obj.WriteComplex(Self);
  finally
    fNode := IXMLNode(LevelRef);
  end;
end;

procedure TROXMLSerializer.WriteStruct(const aName: string; const Ref;
  ArrayElementId: integer);
var
  obj : TROComplexType absolute Ref;
  LevelRef: IXmlNode;
  id : string;
  refnode : IXMLNode;
  xsiattr : IXMLNode;
  lSaveNs, lName: String;
begin
  LevelRef:=fNode;
  try
    lName := Unprefix(aName);
    if fRespNode = nil then fRespNode := fNode;
    LevelRef := fNode;
    if (xsoWriteMultiRefObject in SerializationOptions) then begin

      if Assigned(obj) then begin
        id := IntToStr(fMaxRef);
        Inc(fMaxRef);
        refnode := AddNode(fNode, lName);
        AddXMLAttribute(refnode, tag_href, '#'+id);
        fNode := AddNode(BodyNode, ns_Custom+':'+obj.ClassName);
        AddXMLAttribute(fNode, tag_Id, id);
        if not (xsoSendUntyped in SerializationOptions) then
          xsiattr := AddXMLAttribute(fNode, 'xsi:type', ns_Custom+':'+obj.ClassName);
      end
      else begin
        refnode := AddNode(fNode, lName);
        AddXMLAttribute(refnode, tag_Nil, tag_NilValue);
      end;
    end
    else begin
      fNode := AddNode(fNode, lName);
      if not (xsoSendUntyped in SerializationOptions) then
        xsiattr := AddXMLAttribute(fNode, 'xsi:type', ns_Custom+':'+obj.ClassName);
    end;
    lSaveNs := CurrentNamespace;
    if (obj <> nil) and (xsoExternalTypesAsReferences in SerializationOptions) then
      CurrentNamespace := GetNamespace(TObject(Obj).ClassType, TObject(obj));
    if Assigned(Obj) then Obj.WriteComplex(Self);
    CurrentNamespace := lSaveNs;
  finally
    fNode := LevelRef;
  end;
end;

function TROXMLSerializer.ReadArray(const aName: string; aClass: TClass;
  var Ref; ArrayElementId: integer): Boolean;
var
  obj : TROArray absolute Ref;
  LevelRef: IXmlNode;
  cnt : integer;
  lNilAttr, hrefattr : IXMLNode;
  id : string;
  clsnme, namespc, clstype : string;
  lActualClass : TROArrayClass;
begin
  Result := False;
  LevelRef := fNode;
  try
    if fRespNode = nil then fRespNode := fNode;
    fnode := GetObject(aName, ArrayElementId);
    fnode := FindSoapReference(fnode);
    if (fNode=NIL) then begin
      // No such node found
      Obj := NIL;
      Exit;
    end;

    lNilAttr := fNode.GetAttributeByName(tag_Nil);
    if Assigned(lNilAttr) and (lNilAttr.Value = tag_NilValue) then begin
      obj := NIL;
      Exit;
    end;

    hrefattr := fNode.GetAttributeByName(tag_HRef);
    if (hrefattr<>NIL) then begin
      id := Copy(hrefattr.Value, 2, Length(hrefattr.Value)); // Removes the '#'
      fNode := FindChildNodeByAttribute(BodyNode, tag_Id, id);
      if fNode = nil then fNode := FindChildNodeByAttribute(fRespNode, tag_Id, id);
    end;

    clstype := VarToStr(fNode.GetAttributeValue('xsi:type', aClass.ClassName));
    if (clstype = dts_Array) or (clstype = dts_Array2) then begin
      //For arrays this attribute does't contain actual class name.
      obj := TROArrayClass(aClass).Create;
    end else begin
      if xsoIgnoreStructureType in fSerializationOptions then begin
        obj := TROArrayClass(aClass).Create;
      end
      else begin
        SplitName(clstype, namespc, clsnme);
        lActualClass := TROArrayClass(FindROClass(clsnme));

        if not Assigned(lActualClass) then RaiseError(err_UnknownClassInStream,[clsnme]);
        if not lActualClass.InheritsFrom(aClass) then RaiseError(err_UnexpectedClassInStream,[clsnme,aClass.ClassName]);
        Obj := lActualClass.Create;
      end;
    end;

    cnt := fNode.ChildrenCount;
    Obj.Resize(cnt);
    obj.ReadComplex(Self);
  finally
    fNode := LevelRef;
  end;
end;

function TROXMLSerializer.ReadStruct(const aName: string; aClass: TClass;
  var Ref; ArrayElementId: integer): Boolean;
var
  obj : TROComplexType absolute Ref;
  LevelRef: IXmlNode;
  lNilAttr, hrefattr : IXMLNode;
  id : string;
  clsnme, namespc, clstype : string;
  lActualClass : TROComplexTypeClass;
begin
  Result:=False;
  LevelRef:=fNode;
  try
    if fRespNode = nil then fRespNode := fNode;
    fnode := GetObject(aName, ArrayElementId);
    fnode := FindSoapReference(fnode);
    if (fNode=NIL) then begin
      // No such node found
      obj := NIL;
      Exit;
    end;

    lNilAttr := fNode.GetAttributeByName(tag_Nil);
    if Assigned(lNilAttr) and (lNilAttr.Value = tag_NilValue) then begin
      obj := NIL;
      Exit;
    end;

    hrefattr := fNode.GetAttributeByName(tag_HRef);
    if (hrefattr<>NIL) then begin
      id := Copy(hrefattr.Value, 2, Length(hrefattr.Value)); // Removes the '#'
      fNode := FindChildNodeByAttribute(BodyNode, tag_Id, id);
      if fNode = nil then
        fNode := FindChildNodeByAttribute(fRespNode, tag_Id, id);
    end;

    clstype := VarToStr(fNode.GetAttributeValue('xsi:type', aClass.ClassName));
    if (clstype = dts_Array) or (clstype = dts_Array2) then begin
      //For arrays this attribute does't contain actual class name.
      obj := TROComplexTypeClass(aClass).Create;
    end else begin
      if xsoIgnoreStructureType in fSerializationOptions then begin
        obj := TROComplexTypeClass(aClass).Create;
      end
      else begin
        SplitName(clstype, namespc, clsnme);
        lActualClass := FindROClass(clsnme);

        if not Assigned(lActualClass) then RaiseError(err_UnknownClassInStream,[clsnme]);
        if not lActualClass.InheritsFrom(aClass) then RaiseError(err_UnexpectedClassInStream,[clsnme,aClass.ClassName]);
        obj := lActualClass.Create;
      end;
    end;
    Obj.ReadComplex(Self);
  finally
    fNode := LevelRef;
  end;
end;

function TROXMLSerializer.FindNode(const aName: string;
  ArrayElementId: integer): Boolean;
var
  lNilAttr, hrefattr : IXMLNode;
  id : string;
begin
  Result:=False;
  if fRespNode = nil then fRespNode := fNode;
  fnode := FindSoapReference(GetObject(aName, ArrayElementId));

  if (fNode=NIL) then Result:=False; // No such node found

  lNilAttr := fNode.GetAttributeByName(tag_Nil);
  if Assigned(lNilAttr) and (lNilAttr.Value = tag_NilValue) then Exit;

  Result := True;
  hrefattr := fNode.GetAttributeByName(tag_HRef);
  if (hrefattr<>NIL) then begin
    id := Copy(hrefattr.Value, 2, Length(hrefattr.Value)); // Removes the '#'
    fNode := FindChildNodeByAttribute(BodyNode, tag_Id, id);
    if fNode = nil then fNode := FindChildNodeByAttribute(fRespNode, tag_Id, id);
  end;
end;

procedure TROXMLSerializer.ReadException(const aName: string; var Ref;
  ArrayElementId: integer);
var
  obj: EROException absolute Ref;
  LevelRef,
  lNilAttr, hrefattr : IXMLNode;
  id : string;
begin
  if fRespNode = nil then fRespNode := fNode;

  LevelRef := fNode;
  try
    fnode := GetObject(aName, ArrayElementId);

    fnode := FindSoapReference(fnode);

    if (fNode=NIL) then begin
      // No such node found
      obj := NIL;
      Exit;
    end;

    lNilAttr := fNode.GetAttributeByName(tag_Nil);
    if Assigned(lNilAttr) and (lNilAttr.Value = tag_NilValue) then begin
      obj := NIL;
      Exit;
    end;

    hrefattr := fNode.GetAttributeByName(tag_HRef);
    if (hrefattr<>NIL) then begin
      id := Copy(hrefattr.Value, 2, Length(hrefattr.Value)); // Removes the '#'
      fNode := FindChildNodeByAttribute(BodyNode, tag_Id, id);
      if fNode = nil then fNode := FindChildNodeByAttribute(fRespNode, tag_Id, id);
    end;
    Obj.ReadException(Self);
  finally
    fNode := LevelRef;
  end;
end;

procedure TROXMLSerializer.WriteException(const aName: string; const Ref;
  ArrayElementId: integer);
var
  obj: EROException absolute Ref;
  LevelRef,
  xsiattr : IXMLNode;
begin
  if fRespNode = nil then fRespNode := fNode;
  LevelRef := fNode;
  try
    fNode := AddNode(fNode, Unprefix(aName));
    if not (xsoSendUntyped in SerializationOptions) then
      xsiattr := AddXMLAttribute(fNode, 'xsi:type', ns_Custom+':'+obj.ClassName);
    if Assigned(obj) then Obj.WriteException(Self);
  finally
    fNode := LevelRef;
  end;
end;

function TROXMLSerializer.AddNode(aCurrent: IXmlNode; const aName: string): IXMLNode;
begin
  if Prefix <> '' then
    result := aCurrent.Add(Prefix+':'+aName, fCurrentNamespace)
  else
    result := aCurrent.Add(aName, fCurrentNamespace);
end;

destructor TROXMLSerializer.Destroy;
begin
  fPrefixMap.Free;
  inherited;
end;

procedure TROXMLSerializer.SetCurrentNamespace(const Value: string);
var
  i: Integer;
begin
  if (Value = '') and (fCurrentNamespace <> '') then exit;
  fCurrentNamespace := Value;
  i := fPrefixMap.IndexOf(Value);
  if i = -1 then i := fPrefixMap.Add(Value);
  fPrefix := 'v'+IntToStr(i+1);
end;

initialization
  {$IFDEF DELPHI7UP}
  GetLocaleFormatSettings(SOAPLocale,SOAPFormatSettings);
  //ToDo: fix this for D6
  {$ENDIF}
end.