Componentes.Terceros.RemObjects/internal/5.0.23.613/1/RemObjects SDK for Delphi/Source/uROOpenXMLImpl.pas

unit uROOpenXMLImpl;

{----------------------------------------------------------------------------}
{ 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 Classes, uROXDOM_2_3, Variants, uROXMLIntf;

type
     TROOpenXMLDocument = class;
     { TROOpenXMLNode }
     TROOpenXMLNode = class(TInterfacedObject, IXMLNode)
     private
       fNode : TDOMNode;
       fDoc: TROOpenXMLDocument;
       //function GetNodesByAttribute(const anAttributeName, anAttributeValue: widestring): IXMLNodeList;

     protected
       function GetName : widestring;
       function GetLocalName : widestring;
       function GetRef : pointer;
       function GetParent : IXMLNode;

       function GetValue : Variant;
       procedure SetValue(const Value : Variant);
       
       function GetasString: widestring;
       procedure SetasString(const Value: widestring);

       function GetXML : widestring;

       function GetAttributes(Index : integer) : IXMLNode;
       function GetAttributeCount : integer;

       function GetChildren(Index : integer) : IXMLNode;
       function GetChildrenCount : integer;

       function Add(const aNodeName : widestring; aNameSpaceURI: widestring = '') : IXMLNode;
       function AddAttribute(const anAttributeName : widestring; const anAttributeValue : Variant) : IXMLNode; overload;
       function AddAttribute(const anAttributeName : widestring; const anAttributeString: widestring) : IXMLNode; overload;
       function AddXml(const Xml: WideString): IXMLNode;

       procedure Delete(Index : integer);
       procedure Remove(const aNode : IXMLNode);

       function GetAttributeByName(const anAttributeName : widestring) : IXMLNode;
       function GetAttributeValue(const anAttributeName : widestring; DefaultValue : Variant) : Variant;
       function GetAttributeAsString(const anAttributeName : widestring; DefaultValue : widestring) : widestring;

       function GetNodeByName(const aNodeName : widestring) : IXMLNode;
       function GetNodeValue(const aNodeName : widestring; const Default : Variant) : Variant;

       function GetNodesByName(const aNodeName : widestring) : IXMLNodeList;

       function GetNodeByAttribute(const anAttributeName, anAttributeValue : widestring) : IXMLNode;

       function GetFirstChild: IXMLNode;
       function GetNextSibling: IXMLNode;
       function GetNamespaceURI: WideString;
       function GetDocument: IXMLDocument;

     public
       constructor Create(const aNode : TDOMNode; aDoc: TROOpenXMLDocument);
       destructor Destroy; override;
     end;

     { TROOpenXMLNodeList }
     TROOpenXMLNodeList = class(TInterfacedObject, IXMLNodeLIst)
     private
       fNodeList : TdomNodeList;
       fDoc: TROOpenXMLDocument;

     protected
       function GetNodes(Index : integer) : IXMLNode;
       function GetCount : integer;

     public
       constructor Create(const aNodeList : TdomNodeList; aDoc: TROOpenXMLDocument);
     end;

     { TROOpenXMLDocument }
     TROOpenXMLDocument = class(TInterfacedObject, IXMLDocument)
     private
       fDocument : TDOMDocument;
       fDOMImpl : TDomImplementation;

     protected
       function GetDocumentNode : IXMLNode;

       function GetEncoding : TXMLEncoding;

       procedure New(aDocumentName : widestring = ''; anEncoding : TXMLEncoding = xeUTF8);

       procedure SaveToStream(aStream : TStream);
       procedure SaveToFile(const aFileName : string);
       procedure LoadFromStream(aStream : TStream);
       procedure LoadFromFile(const aFileName : string);
       function GetXml:widestring;
       procedure SetXML(const Value : widestring);

       function Transform(const XSL : string) : string;
     public
       constructor Create;
       destructor Destroy; override;

     end;

{ Misc. for OpenXML }
function DOMNodeToString(aDOMNode : TdomNode; aDOMImplementation : TDomImplementation = NIL) : string;
function DOMNodeToWidestring(aDOMNode : TdomNode; aDOMImplementation : TDomImplementation = NIL) : widestring;

implementation

uses uRORes, uROClasses, SysUtils;

function DOMNodeToString(aDOMNode : TdomNode; aDOMImplementation : TDomImplementation = NIL) : string;
var domimpl : TDOMImplementation;
    parser : TDomToXmlParser;
begin
  if (aDOMImplementation=NIL)
    then domimpl := TDomImplementation.Create(NIL)
    else domimpl := aDOMImplementation;

  parser := TDomToXmlParser.Create(NIL);

  try
    parser.DOMImpl := domimpl;
    parser.writeToString(aDOMNode, XMLEncodingStr[xeUTF8], result);
  finally
    parser.Free;
    if (aDOMImplementation=NIL) then domimpl.Free;
  end;
end;

function DOMNodeToWidestring(aDOMNode : TdomNode; aDOMImplementation : TDomImplementation = NIL) : widestring;
var domimpl : TDOMImplementation;
    parser : TDomToXmlParser;
begin
  if (aDOMImplementation=NIL)
    then domimpl := TDomImplementation.Create(NIL)
    else domimpl := aDOMImplementation;

  parser := TDomToXmlParser.Create(NIL);

  try
    parser.DOMImpl := domimpl;
    parser.writeToWideString(aDOMNode, result);
  finally
    parser.Free;
    if (aDOMImplementation=NIL) then domimpl.Free;
  end;
end;

{ TROOpenXMLNode }

constructor TROOpenXMLNode.Create(const aNode : TDOMNode; aDoc: TROOpenXMLDocument);
begin
  if not Assigned(aNode)
    then RaiseError(err_DOMElementIsNIL, []);

  inherited Create;

  fDoc := adoc;
  fNode := aNode;
end;

destructor TROOpenXMLNode.Destroy;
begin
  inherited;
end;

function TROOpenXMLNode.Add(const aNodeName: widestring; aNameSpaceURI: widestring = ''): IXMLNode;
var node : TDOMNode;
begin
  if aNameSpaceURI = '' then
    node := fNode.ownerDocument.createElement(aNodeName)
  else
    node := fNode.ownerDocument.createElementNS(aNameSpaceURI, aNodeName);
  fNode.appendChild(node);

  result := TROOpenXMLNode.Create(node, fDoc);
end;

procedure TROOpenXMLNode.Delete(Index: integer);
begin
  fNode.removeChild(fNode.childNodes.item(Index));
end;

function TROOpenXMLNode.GetAttributes(Index : integer): IXMLNode;
begin
  result := TROOpenXMLNode.Create(fNode.attributes.item(Index), fDoc);
end;

function TROOpenXMLNode.GetChildren(Index : integer): IXMLNode;
begin
  result := TROOpenXMLNode.Create(fNode.childNodes.item(Index), fDoc);
end;

function TROOpenXMLNode.GetName: widestring;
begin
  result := fNode.nodeName;
end;

function TROOpenXMLNode.GetValue: Variant;
begin
  result := fNode.textContent;
end;

function TROOpenXMLNode.GetXML: widestring;
begin
  DOMNodeToWidestring(fNode, fdoc.fDOMImpl);
end;

procedure TROOpenXMLNode.Remove(const aNode: IXMLNode);
begin
  fNode.removeChild(TdomNode(aNode.Ref));
end;

procedure TROOpenXMLNode.SetValue(const Value: Variant);
var textnode : TdomNode;
begin
  if (fNode.childNodes.length=1) and (fNode.childNodes.item(0).nodeName='#text')
    then fNode.removeChild(fNode.childNodes.item(0));

  textnode := fNode.ownerDocument.createTextNode(Value);
  fNode.appendChild(textnode)
end;

function TROOpenXMLNode.GetasString: widestring;
begin
  Result:=fNode.textContent;
end;

procedure TROOpenXMLNode.SetasString(const Value: widestring);
var textnode : TdomNode;
begin
  if (fNode.childNodes.length=1) and (fNode.childNodes.item(0).nodeName='#text')
    then fNode.removeChild(fNode.childNodes.item(0));

  textnode := fNode.ownerDocument.createTextNode(Value);
  fNode.appendChild(textnode)
end;


function TROOpenXMLNode.GetNodeByName(const aNodeName: widestring): IXMLNode;
var i : integer;
    nme : string;
begin
  result := NIL;

  with fNode.childNodes do
    for i := 0 to (length-1) do begin
      nme := item(i).nodeName;
      if (nme=aNodeName) then begin
        result := TROOpenXMLNode.Create(item(i), fDoc);
        Exit;
      end;
    end;
end;

{function TROOpenXMLNode.GetNodesByAttribute(const anAttributeName, anAttributeValue: widestring): IXMLNodeList;
//var node : TdomNodeList;
begin
  RaiseError(err_NotImplemented, []);
end;}

function TROOpenXMLNode.GetNodesByName(const aNodeName: widestring): IXMLNodeList;
var //i : integer;
    list : TdomNodeList;
begin
  result := NIL;

  list := (fNode as TdomElement).getElementsByTagName(aNodeName);
  if (list<>NIL)
    then result := TROOpenXMLNodeList.Create(list, fDoc)
end;

function TROOpenXMLNode.GetAttributeCount: integer;
begin
  result := fNode.attributes.length
end;

function TROOpenXMLNode.GetChildrenCount: integer;
begin
  result := fNode.childNodes.length
end;

function TROOpenXMLNode.GetRef: pointer;
begin
  result := fNode;
end;

function TROOpenXMLNode.GetLocalName: widestring;
begin
  result := fNode.nodeName
end;

function TROOpenXMLNode.AddAttribute(const anAttributeName : widestring;
  const anAttributeValue : Variant) : IXMLNode;
var attr : TdomNode;
begin
  attr := fNode.ownerDocument.createAttribute(anAttributeName);
  attr.nodeValue := anAttributeValue;
  fNode.attributes.setNamedItem(attr);

  result := TROOpenXMLNode.Create(attr, fDoc);
end;

function TROOpenXMLNode.AddAttribute(const anAttributeName: widestring;
  const anAttributeString: widestring): IXMLNode;
var attr : TdomNode;
begin
  attr := fNode.ownerDocument.createAttribute(anAttributeName);
  attr.nodeValue := anAttributeString;
  fNode.attributes.setNamedItem(attr);

  result := TROOpenXMLNode.Create(attr, fDoc);
end;

function TROOpenXMLNode.GetParent: IXMLNode;
begin
  result := TROOpenXMLNode.Create(fNode.ParentNode, fdoc)
end;

function TROOpenXMLNode.GetAttributeByName(
  const anAttributeName: widestring): IXMLNode;
var node : TDomNode;
begin
  result := NIL;
  if fNode.attributes = nil then exit;
  node := fNode.attributes.getNamedItem(anAttributeName);

  if (node<>NIL)
    then result := TROOpenXMLNode.Create(node, fDoc);
end;

function TROOpenXMLNode.GetNodeByAttribute(const anAttributeName,
  anAttributeValue: widestring): IXMLNode;
var i : integer;
begin
  result := NIL;
  if fNode.attributes = nil then exit;

  for i := 0 to (fNode.attributes.length-1) do
    with fNode.attributes.item(i) do
      if (nodeName=anAttributeName) and (nodeValue=anAttributeValue) then begin
        result := TROOpenXMLNode.Create(fNode.attributes.item(i), fDoc);
        Exit;
      end;
end;

function TROOpenXMLNode.GetAttributeValue(
  const anAttributeName: widestring; DefaultValue: Variant): Variant;
var attr : IXMLNode;
begin
  attr := GetAttributeByName(anAttributeName);
  if (attr<>NIL) then
     result := attr.Value
  else
     result := DefaultValue;
end;

function TROOpenXMLNode.GetAttributeAsString(const anAttributeName: widestring;
  DefaultValue: widestring): widestring;
var attr : IXMLNode;
begin
  attr := GetAttributeByName(anAttributeName);
  if (attr<>NIL) then
     result := attr.Value
  else
     result := DefaultValue;
end;



function TROOpenXMLNode.GetNodeValue(const aNodeName: widestring;
  const Default: Variant): Variant;
var node : IXMLNode;
begin
  node := GetNodeByName(aNodeName);
  if (node=NIL) then result := Default
                else result := node.Value
end;

function TROOpenXMLNode.GetFirstChild: IXMLNode;
var node : TDomNode;
begin
  result := NIL;
  node := fNode.firstChild;

  if (node<>NIL)
    then result := TROOpenXMLNode.Create(node, fDoc);
end;

function TROOpenXMLNode.GetNextSibling: IXMLNode;
var node : TDomNode;
begin
  result := NIL;
  node := fNode.nextSibling;

  if (node<>NIL)
    then result := TROOpenXMLNode.Create(node, fDoc);
end;

function TROOpenXMLNode.GetNamespaceURI: WideString;
begin
  Result := fNode.namespaceURI;
end;

function TROOpenXMLNode.AddXml(const Xml: WideString): IXMLNode;
begin
end;

function TROOpenXMLNode.GetDocument: IXMLDocument;
begin
  result := fDoc;
end;

{ TROOpenXMLNodeList }

constructor TROOpenXMLNodeList.Create(const aNodeList: TdomNodeList; aDoc: TROOpenXMLDocument);
begin
  if not Assigned(aNodeList)
    then RaiseError(err_DOMElementIsNIL, []);

  inherited Create;

  fDoc := aDoc;
  fNodeList := aNodeList;
end;

function TROOpenXMLNodeList.GetCount: integer;
begin
  result := fNodeList.length
end;

function TROOpenXMLNodeList.GetNodes(Index: integer): IXMLNode;
begin
  result := TROOpenXMLNode.Create(fNodeList.item(Index), fDoc);
end;

{ TROOpenXMLDocument }

constructor TROOpenXMLDocument.Create;
begin
  fDOMImpl := TDomImplementation.Create(NIL);
  fDocument := fDOMImpl.createDocument('XMLDOC', NIL);
end;

destructor TROOpenXMLDocument.Destroy;
begin
  fDOMImpl.freeDocument(fDocument);
  fDOMImpl.Free;

  inherited;
end;

function TROOpenXMLDocument.GetDocumentNode: IXMLNode;
begin
  result := TROOpenXMLNode.Create(fDocument.documentElement, self)
end;

function TROOpenXMLDocument.GetEncoding: TXMLEncoding;
begin
  result := xeUTF8
  { ToDo: for now, obtain the real encoding later ;-) }
end;

function TROOpenXMLDocument.GetXml: widestring;
var
    parser : TDomToXmlParser;
begin
  parser := TDomToXmlParser.Create(NIL);

  try
    parser.DOMImpl := fDOMImpl;
    parser.writeToWideString(fDocument.documentElement, result);
  finally
    parser.Free;
  end;
end;

procedure TROOpenXMLDocument.LoadFromFile(const aFileName: string);
var //domimpl : TDOMImplementation;
    parser : TXmlToDomParser;
begin
  New('');
  parser := TXmlToDomParser.Create(NIL);
  try
    parser.DOMImpl := fDOMImpl;

    fDocument := parser.fileToDom(aFileName);
  finally
    parser.Free;
  end;
end;

procedure TROOpenXMLDocument.LoadFromStream(aStream: TStream);
var //domimpl : TDOMImplementation;
    folddoc : TdomDocument;
    parser : TXmlToDomParser;
begin
  New('');
  parser := TXmlToDomParser.Create(NIL);
  try
    parser.DOMImpl := fDOMImpl;

    fOldDoc := fdocument;
    fDocument := parser.streamToDom(aStream);
    fOldDoc.domImplementation.freeDocument(fOldDoc);
  finally
    parser.Free;
  end;
end;

procedure TROOpenXMLDocument.New(aDocumentName : widestring = ''; anEncoding : TXMLEncoding = xeUTF8);
var docel : TdomNode;
begin
  fDocument.clear;

  if (aDocumentName<>'') then begin
    docel := fDocument.createElement(aDocumentName);
    fDocument.appendChild(docel)
  end;
end;

procedure TROOpenXMLDocument.SaveToFile(const aFileName: string);
var //domimpl : TDOMImplementation;
    parser : TDomToXmlParser;
    fstream : TFileStream;
begin
  fstream := NIL;
  parser := TDomToXmlParser.Create(NIL);

  try
    fstream := TFileStream.Create(aFileName, fmCreate);
    parser.DOMImpl := fDOMImpl;

    parser.writeToStream(fDocument.documentElement, 'UTF-8', fstream);
  finally
    parser.Free;
    fstream.Free;
  end;
end;

procedure TROOpenXMLDocument.SaveToStream(aStream: TStream);
var //domimpl : TDOMImplementation;
    parser : TDomToXmlParser;
    //fstream : TFileStream;
begin
  //fstream := NIL;
  parser := TDomToXmlParser.Create(NIL);

  try
    parser.DOMImpl := fDOMImpl;
    parser.writeToStream(fDocument.documentElement, 'UTF-8', aStream);
  finally
    parser.Free;
  end;
end;

procedure TROOpenXMLDocument.SetXML(const Value: widestring);
var
  ss: TXmlToDomParser;
  fOldDoc: TdomDocument;
begin
  New('');
  ss := TXmlToDomParser.Create(NIL);
  try
    ss.DOMImpl := fDOMImpl;

    fOldDoc := fdocument;
    fDocument := ss.wideStringToDom(value);
    fOldDoc.Free;
  finally
    ss.Free;
  end;
end;

function TROOpenXMLDocument.Transform(const XSL: string): string;
begin
  RaiseError(err_NotImplemented, []);
end;

end.