NcSerializer

{ **************************************************************************** }
{                                                                              }
{ Serializer Classes                                                           }
{                                                                              }
{ Copyright (C) 2010 Janos Janka - All rights reserved!                        }
{                                                                              }
{ **************************************************************************** }

unit NcSerializer;

interface

uses
  SysUtils, Classes, Forms, ActiveX, Contnrs, TypInfo,
  InvokeRegistry, OPConvert, OPToSOAPDomConv, XmlDoc, XmlIntf, XmlDom;

type
  /// <summary>
  ///   Represents a serializer interface abstraction.
  /// </summary>
  INcSerializer = interface
    ['{502DDBE8-D962-405E-AE7C-A0329B583BB3}']
    procedure Serialize(AObject: TObject; Stream: TStream);
    function Deserialize(Stream: TStream): TObject; overload;
    function Deserialize(AClass: TClass; Stream: TStream): TObject; overload;
  end;

  /// <summary>
  ///   Represents a serializer abstraction.
  /// </summary>
  TNcSerializer = class abstract(TInterfacedObject, INcSerializer)
  public
    procedure Serialize(AObject: TObject; Stream: TStream); virtual; abstract;
    function Deserialize(Stream: TStream): TObject; overload; virtual; abstract;
    function Deserialize(AClass: TClass; Stream: TStream): TObject; overload; virtual; abstract;

    class procedure RegisterClass(AClass: TClass); static;
    class procedure UnregisterClass(AClass: TClass); static;
  end;

  /// <summary>
  ///   Represents a SOAP/XML serializer.
  /// </summary>
  TNcXMLSerializer = class(TNcSerializer)
  private
    FObjConverter: IObjConverter;
    FXMLEncoding: string;
    FXMLEnvelope: string;
    FXMLOptions: TXMLDocOptions;
    FSOAPOptions: TSOAPConvertOptions;
    FObjectConverterOptions: TObjectConvertOptions;
  public
    constructor Create;

    procedure Serialize(AObject: TObject; Stream: TStream); overload; override;
    procedure Serialize(AObject: TObject; out XML: string); reintroduce; overload;

    function Deserialize(Stream: TStream): TObject; overload; override;
    function Deserialize(const XML: string): TObject; overload;
    function Deserialize(AClass: TClass; Stream: TStream): TObject; overload; override;
    function Deserialize(AClass: TClass; const XML: string): TObject; overload;

    property Converter: IObjConverter read FObjConverter write FObjConverter;
    property XMLEncoding: string read FXMLEncoding write FXMLEncoding;
    property XMLEnvelope: string read FXMLEnvelope write FXMLEnvelope;
    property XMLOptions: TXMLDocOptions read FXMLOptions write FXMLOptions;
    property SOAPOptions: TSOAPConvertOptions read FSOAPOptions write FSOAPOptions;
    property ObjectConverterOptions: TObjectConvertOptions read FObjectConverterOptions write FObjectConverterOptions;
  end;

  TNcClassList = class(TClassList)
  public
    function IndexOf(const AClassName, Namespace: string): Integer; overload;
  end;

implementation

uses
  NcHelpers, NcExceptions, NcResources;

var
  RegisteredClasses: TNcClassList = nil;

{ **************************************************************************** }
{ TNcSerializer                                                                }
{ **************************************************************************** }

class procedure TNcSerializer.RegisterClass(AClass: TClass);
begin
  NcContract.ArgumentIsNotNull('AClass', AClass);
  RegisteredClasses.Add(AClass);
end;

//------------------------------------------------------------------------------

class procedure TNcSerializer.UnregisterClass(AClass: TClass);
begin
  NcContract.ArgumentIsNotNull('AClass', AClass);
  RegisteredClasses.Remove(AClass);
end;

{ **************************************************************************** }
{ TNcXMLSerializer                                                             }
{ **************************************************************************** }

function TNcXMLSerializer.Deserialize(Stream: TStream): TObject;
var
  XMLDoc: TXMLDocument;
  EnvelopeNode: IXMLNode;
  ObjectNode: IXMLNode;
  TypeNode: IXMLNode;
  Converter: IObjConverter;
  SOAPConverter: TSOAPDomConv;
  ClassItemIndex: Integer;
  ClassTypeName: string;
  ClassNamespace: string;
begin
  inherited;
 
  NcContract.ArgumentIsNotNull('Stream', Stream);

  XMLDoc := TXMLDocument.Create(Application);
  try
    XMLDoc.LoadFromStream(Stream);   
    XMLDoc.Active := True;

    // Check the envelope (root) node.
    EnvelopeNode := XMLDoc.DocumentElement;
    if (EnvelopeNode = nil) or (EnvelopeNode.ChildNodes.Count = 0) then
      raise NcInvalidOperationException.Create(NC_MSG_INVALID_XML_FORMAT);

    // Create a new SOAP converter.
    if Converter = nil then
    begin
      SOAPConverter := TSOAPDomConv.Create(Application);
      SOAPConverter.Options := FSOAPOptions;
      Converter := SOAPConverter as IObjConverter;
    end
    else // Set the custom converter.
      Converter := Self.Converter;

    ObjectNode := XMLDoc.DocumentElement.ChildNodes[0];

    // Search for the type attribute.
    TypeNode := ObjectNode.AttributeNodes.FindNode('type');
    if TypeNode = nil then
      raise NcInvalidOperationException.Create(
        NC_MSG_XML_TYPE_ATTRIBUTE_NOT_FOUND);

    // Specify the ClassTypeName/ClassNamespace.
    ClassTypeName := ExtractLocalName(TypeNode.Text);
    ClassNamespace := ExtractLocalName(
      EnvelopeNode.FindNamespaceURI(ExtractPrefix(TypeNode.Text)));

    // Where is the registered class type?
    ClassItemIndex := RegisteredClasses.IndexOf(ClassTypeName, ClassNamespace);
    if ClassItemIndex = -1 then
      raise NcInvalidOperationException.Create(
        Format(NC_MSG_TYPE_IS_NOT_REGISTERED,
          [ClassNamespace + ':' + ClassTypeName])
      );

    // Create a new instance.
    Result := RegisteredClasses.Items[ClassItemIndex].Create;
    try
      Converter.InitObjectFromSOAP(Result, ObjectNode, ObjectNode);
    except
      FreeAndNil(Result);
      raise;
    end;
  finally
    XMLDoc.Free;
  end;
end;

//------------------------------------------------------------------------------

function TNcXMLSerializer.Deserialize(const XML: string): TObject;
var
  StringStream: TStringStream;
begin
  NcContract.ArgumentIsNotWhiteSpace('XML', XML);

  StringStream := TStringStream.Create(XML);
  try
    Result := Deserialize(StringStream);
  finally
    StringStream.Free;
  end;
end;

//------------------------------------------------------------------------------

function TNcXMLSerializer.Deserialize(AClass: TClass; Stream: TStream): TObject;
var
  XMLDoc: TXMLDocument;
  EnvelopeNode: IXMLNode;
  ObjectNode: IXMLNode;
  Converter: IObjConverter;
  SOAPConverter: TSOAPDomConv;
begin
  inherited;
 
  NcContract.ArgumentIsNotNull('AClass', AClass);
  NcContract.ArgumentIsNotNull('Stream', Stream);

  XMLDoc := TXMLDocument.Create(Application);
  try
    XMLDoc.LoadFromStream(Stream);   
    XMLDoc.Active := True;

    // Check the envelope (root) node.
    EnvelopeNode := XMLDoc.DocumentElement;
    if (EnvelopeNode = nil) or (EnvelopeNode.ChildNodes.Count = 0) then
      raise NcInvalidOperationException.Create(NC_MSG_INVALID_XML_FORMAT);

    // Create a new SOAP converter.
    if Converter = nil then
    begin
      SOAPConverter := TSOAPDomConv.Create(Application);
      SOAPConverter.Options := FSOAPOptions;
      Converter := SOAPConverter as IObjConverter;
    end
    else // Set the custom converter.
      Converter := Self.Converter;

    ObjectNode := XMLDoc.DocumentElement.ChildNodes[0];

    // Create a new instance.
    Result := AClass.Create;
    try
      Converter.InitObjectFromSOAP(Result, ObjectNode, ObjectNode);
    except
      FreeAndNil(Result);
      raise;
    end;
  finally
    XMLDoc.Free;
  end;
end;

//------------------------------------------------------------------------------

function TNcXMLSerializer.Deserialize(AClass: TClass;
  const XML: string): TObject;
var
  StringStream: TStringStream;
begin
  NcContract.ArgumentIsNotNull('AClass', AClass);
  NcContract.ArgumentIsNotWhiteSpace('XML', XML);

  StringStream := TStringStream.Create(XML);
  try
    Result := Deserialize(AClass, StringStream);
  finally
    StringStream.Free;
  end;
end;

//------------------------------------------------------------------------------

constructor TNcXMLSerializer.Create;
begin
  FXMLEncoding := 'utf-8';
  FXMLEnvelope := 'Envelope';
  FXMLOptions := [doNodeAutoCreate, doAttrNull, doAutoPrefix, doNamespaceDecl];
  FSOAPOptions := [soSendMultiRefObj, soSendMultiRefArray, soRootRefNodesToBody,
    soTryAllSchema, soCacheMimeResponse, soUTF8EncodeXML];
end;

//------------------------------------------------------------------------------

procedure TNcXMLSerializer.Serialize(AObject: TObject; Stream: TStream);
var
  RefId: WideString;
  XMLDoc: TXMLDocument;
  EnvelopeNode: IXMLNode;
  Converter: IObjConverter;
  SOAPConverter: TSOAPDomConv;
begin
  inherited;
 
  NcContract.ArgumentIsNotNull('AObject', AObject);
  NcContract.ArgumentIsNotNull('Stream', Stream);

  // Create a new XML document.
  XMLDoc := TXMLDocument.Create(Application);
  try
    XMLDoc.Active := True;
    XMLDoc.Options := FXMLOptions;
    XMLDoc.Encoding := FXMLEncoding;

    // Create a new SOAP converter.
    if Converter = nil then
    begin
      SOAPConverter := TSOAPDomConv.Create(Application);
      SOAPConverter.Options := FSOAPOptions;
      Converter := SOAPConverter as IObjConverter;
    end
    else // Set the custom converter.
      Converter := Self.Converter;

    // Create an envelope (root) node.
    EnvelopeNode := XMLDoc.AddChild(FXMLEnvelope);

    // Serialize the object to SOAP/Custom format.
    Converter.ObjInstanceToSOAP(
      AObject,                                 // Object reference.
      EnvelopeNode,                            // Root node.
      nil,                                     // Parent node.
      AObject.ClassName,                       // Class name.
      GetTypeData(AObject.ClassInfo).UnitName, // Unit namespace.
      FObjectConverterOptions,                 // Object converter options.
      RefId                                    // Reference identity.
    );

    // Save to stream.
    XMLDoc.SaveToStream(Stream);
  finally
    XMLDoc.Free;
  end;
end;

//------------------------------------------------------------------------------

procedure TNcXMLSerializer.Serialize(AObject: TObject; out XML: string);
const
  BufferSize = 4096;
var
  StringStream: TStringStream;
  ReadSize: Longint;
  Buffer: array[0..BufferSize - 1] of Char;
begin
  NcContract.ArgumentIsNotNull('AObject', AObject);

  StringStream := TStringStream.Create(EmptyStr);
  try
    // Serialize the object to XML.
    Serialize(AObject, StringStream);

    // Read data (block size: 4096 bytes).
    StringStream.Seek(0, soFromBeginning);
    while StringStream.Position < StringStream.Size do
    begin
      ReadSize := StringStream.Read(Buffer, BufferSize);
      if ReadSize = BufferSize then        XML := XML + Buffer      else        XML := XML + Copy(Buffer, 0, ReadSize);
    end;
  finally
    StringStream.Free;
  end;
end;

{ **************************************************************************** }
{ TNcClassList                                                                 }
{ **************************************************************************** }

function TNcClassList.IndexOf(const AClassName, Namespace: string): Integer;
var
  I: Integer;
  C: TClass;
begin
  for I := 0 to Count - 1 do
  begin
    C := Items[I];
    if (C <> nil) and SameStr(C.ClassName, AClassName)
      and SameStr(GetTypeData(C.ClassInfo).UnitName, Namespace) then
    begin
      Result := I;
      Exit;
    end;
  end;

  Result := -1;
end;

initialization
  RegisteredClasses := TNcClassList.Create;

finalization
  RegisteredClasses.Free;

end.An example:

program SerializerTest;

// {$DEFINE TREMOTABLE}

{$APPTYPE CONSOLE}

uses
  SysUtils, Classes, ActiveX, InvokeRegistry, XMLIntf, NcSerializer;

type
  {$TYPEINFO ON}

  /// <summary>
  ///   Represents a person.
  /// </summary>
  TPerson = class {$IFDEF TREMOTABLE} (TRemotable) {$ENDIF}
  strict private
    FUserId: string; // TGUID is not supported.
    FUserName: string;
    FAddress: string;
  published
    property UserId: string read FUserId write FUserId;
    property UserName: string read FUserName write FUserName;
    property Address: string read FAddress write FAddress;
  end;

  {$TYPEINFO OFF}

  TConsole = class sealed
  public
    class procedure Main; static;
  end;

class procedure TConsole.Main;
var
  Person: TPerson;
  Serializer: INcSerializer;
  MemoryStream: TMemoryStream;
begin
  // Create a new XML serializer.
  Serializer := TNcXMLSerializer.Create as INcSerializer;

  MemoryStream := TMemoryStream.Create;
  try
    // Serialization -----------------------------------------------------------

    Person := TPerson.Create;
    try
      Person.UserId := '{6842EA05-3E51-4571-B25C-FDF86B80F10E}';
      Person.Address := 'Hungary';
      Person.UserName := 'Janos Janka';
      Serializer.Serialize(Person, MemoryStream);
    finally
      Person.Free;
    end;

    // Deserialization 1 -------------------------------------------------------

    Person := TPerson(Serializer.Deserialize(TPerson, MemoryStream));
    try
      Writeln('Deserialization 1', sLineBreak,
        Format('UserId: %s%sUserName: %s%sAddress: %s%s',
          [Person.UserId, sLineBreak,
           Person.UserName, sLineBreak,
           Person.Address, sLineBreak]));
    finally
      Person.Free;
    end;

    // Deserialization 2 -------------------------------------------------------

    TNcSerializer.RegisterClass(TPerson);

    Person := TPerson(Serializer.Deserialize(MemoryStream));
    try
      Writeln('Deserialization 2', sLineBreak,
        Format('UserId: %s%sUserName: %s%sAddress: %s%s',
          [Person.UserId, sLineBreak,
           Person.UserName, sLineBreak,
           Person.Address, sLineBreak]));
    finally
      Person.Free;
    end;
  finally
    MemoryStream.Free;
  end;
end;

var
  Ret: HRESULT;
begin
  ReportMemoryLeaksOnShutdown := True;

  // Intialize COM.
  Ret := CoInitializeEx(nil, COINIT_APARTMENTTHREADED);
  if FAILED(Ret) then
    raise Exception.Create(Format(
      'Failed to initialize COM library. Error code = %d.', [Ret]));

  try
    TConsole.Main;
  except
    on E: Exception do
      WriteLn(E.ClassName + ': ' + E.Message);
  end;

  Write('Press ENTER to continue..');
  ReadLn;
end.