csxmldom.pas

来自「Delphi XML & XPATH源代码」· PAS 代码 · 共 1,589 行 · 第 1/3 页

unit CSXMLDOM;

{
  Adapter for CUESoft XML for Delphi's XML DOM interfaces.

  Written by Keith Wood ([e-mail])
  Version 1.0 - 21 August 2002.
}

interface

uses
  Windows, SysUtils, Classes, XMLDOM, XmlObjModel, XslProcessor, XslFilterHTML;

const
  sCUEXml = 'CUEXml';  { Do not localize }

type

{ ICSNodeRef }

  ICSNodeRef = interface
    ['{7A53E169-3107-4DEB-A6A6-ADED0F25080C}']
    function GetXMLDOMNode: TXmlNode;
  end;

{ TCSDOMInterface }

  TCSDOMInterface = class(TInterfacedObject)
  end;

{ TCSDOMImplementation }

  TCSDOMImplementation = class(TCSDOMInterface, IDOMImplementation)
  private
    FDOMImpl: TXmlDOMImplementation;
  protected
    { IDOMImplementation }
    function hasFeature(const feature, version: DOMString): WordBool;
    function createDocumentType(const qualifiedName, publicId,
      systemId: DOMString): IDOMDocumentType; safecall;
    function createDocument(const namespaceURI, qualifiedName: DOMString;
      doctype: IDOMDocumentType): IDOMDocument; safecall;
  public
    constructor Create(DOMImplementation: TXmlDomImplementation);
    destructor Destroy; override;
    property DOMImpl: TXmlDOMImplementation read FDOMImpl;
  end;

{ TCSDOMNode }

  TCSDOMNodeClass = class of TCSDOMNode;

  TCSDOMDocument = class;

  TCSDOMNode = class(TCSDOMInterface,
    ICSNodeRef, IDOMNode, IDOMNodeEx, IDOMNodeSelect)
  private
    FAttributes: IDOMNamedNodeMap;
    FChildNodes: IDOMNodeList;
    FNode: TXmlNode;
    FOwnerDocument: TCSDOMDocument;
  protected
    { IXpNodeRef }
    function GetXMLDOMNode: TXmlNode;
    { IDOMNode }
    function get_nodeName: DOMString; virtual; safecall;
    function get_nodeValue: DOMString; safecall;
    procedure set_nodeValue(value: DOMString);
    function get_nodeType: DOMNodeType; virtual; safecall;
    function get_parentNode: IDOMNode; safecall;
    function get_childNodes: IDOMNodeList; virtual; safecall;
    function get_firstChild: IDOMNode; safecall;
    function get_lastChild: IDOMNode; safecall;
    function get_previousSibling: IDOMNode; safecall;
    function get_nextSibling: IDOMNode; safecall;
    function get_attributes: IDOMNamedNodeMap; safecall;
    function get_ownerDocument: IDOMDocument; safecall;
    function get_namespaceURI: DOMString; safecall;
    function get_prefix: DOMString; safecall;
    function get_localName: DOMString; safecall;
    function insertBefore(const newChild, refChild: IDOMNode): IDOMNode;
      safecall;
    function replaceChild(const newChild, oldChild: IDOMNode): IDOMNode;
      safecall;
    function removeChild(const childNode: IDOMNode): IDOMNode; safecall;
    function appendChild(const newChild: IDOMNode): IDOMNode; safecall;
    function hasChildNodes: WordBool; virtual; safecall;
    function cloneNode(deep: WordBool): IDOMNode; safecall;
    procedure normalize;
    function supports(const feature, version: DOMString): WordBool;
    { IDOMNodeEx }
    function get_text: DOMString; safecall;
    function get_xml: DOMString; safecall;
    procedure set_text(const Value: DOMString); safecall;
    procedure transformNode(const stylesheet: IDOMNode; var output: WideString);
      overload;
    procedure transformNode(const stylesheet: IDOMNode;
      const output: IDOMDocument); overload;
    { IDOMNodeSelect }
    function selectNode(const nodePath: WideString): IDOMNode; safecall;
    function selectNodes(const nodePath: WideString): IDOMNodeList; safecall;
  public
    constructor Create(const Node: TXmlNode; const Document: TCSDOMDocument);
      virtual;
    property Node: TXmlNode read FNode;
  end;

{ TCSDOMNodeList }

  TCSDOMNodeList = class(TCSDOMInterface, IDOMNodeList)
  private
    FNodeList: TXmlNodeList;
    FOwnerDocument: TCSDOMDocument;
  protected
    { IDOMNodeList }
    function get_item(index: Integer): IDOMNode; safecall;
    function get_length: Integer; safecall;
  public
    constructor Create(const NodeList: TXmlNodeList;
      const Document: TCSDOMDocument);
    property NodeList: TXmlNodeList read FNodeList;
  end;

{ TCSDOMNamedNodeMap }

  TCSDOMNamedNodeMap = class(TCSDOMInterface, IDOMNamedNodeMap)
  private
    FNamedNodeMap: TXmlNamedNodeMap;
    FOwnerDocument: TCSDOMDocument;
  protected
    { IDOMNamedNodeMap }
    function get_item(index: Integer): IDOMNode; safecall;
    function get_length: Integer;
    function getNamedItem(const name: DOMString): IDOMNode; safecall;
    function setNamedItem(const newItem: IDOMNode): IDOMNode; safecall;
    function removeNamedItem(const name: DOMString): IDOMNode; safecall;
    function getNamedItemNS(const namespaceURI, localName: DOMString):
      IDOMNode; safecall;
    function setNamedItemNS(const arg: IDOMNode): IDOMNode; safecall;
    function removeNamedItemNS(const namespaceURI, localName: DOMString):
      IDOMNode; safecall;
  public
    constructor Create(const NamedNodeMap: TXmlNamedNodeMap;
      const Document: TCSDOMDocument);
    property NamedNodeMap: TXmlNamedNodeMap read FNamedNodeMap;
  end;

{ TCSDOMCharacterData }

  TCSDOMCharacterData = class(TCSDOMNode, IDOMCharacterData)
  private
    function GetCharacterData: TXmlCharacterData;
  protected
    { IDOMCharacterData }
    function get_data: DOMString;
    procedure set_data(const data: DOMString);
    function get_length: Integer;
    function substringData(offset, count: Integer): DOMString;
    procedure appendData(const data: DOMString);
    procedure insertData(offset: Integer; const data: DOMString);
    procedure deleteData(offset, count: Integer);
    procedure replaceData(offset, count: Integer; const data: DOMString);
  public
    property CharacterData: TXmlCharacterData read GetCharacterData;
  end;

{ TCSDOMAttr }

  TCSDOMAttr = class(TCSDOMNode, IDOMAttr)
  private
    function GetAttribute: TXmlAttribute;
  protected
    { Property Get/Set }
    function get_name: DOMString;
    function get_specified: WordBool;
    function get_value: DOMString;
    procedure set_value(const attributeValue: DOMString);
    function get_ownerElement: IDOMElement;
    { Properties }
    property name: DOMString read get_name;
    property specified: WordBool read get_specified;
    property value: DOMString read get_value write set_value;
    property ownerElement: IDOMElement read get_ownerElement;
  public
    property Attribute: TXmlAttribute read GetAttribute;
  end;

{ TCSDOMElement }

  TCSDOMElement = class(TCSDOMNode, IDOMElement)
  private
    function GetElement: TXmlElement;
  protected
    { IDOMElement }
    function get_tagName: DOMString; safecall;
    function getAttribute(const name: DOMString): DOMString; safecall;
    procedure setAttribute(const name, value: DOMString);
    procedure removeAttribute(const name: DOMString);
    function getAttributeNode(const name: DOMString): IDOMAttr; safecall;
    function setAttributeNode(const newAttr: IDOMAttr): IDOMAttr; safecall;
    function removeAttributeNode(const oldAttr: IDOMAttr): IDOMAttr; safecall;
    function getElementsByTagName(const name: DOMString): IDOMNodeList; safecall;
    function getAttributeNS(const namespaceURI, localName: DOMString): DOMString; safecall;
    procedure setAttributeNS(const namespaceURI, qualifiedName, value: DOMString);
    procedure removeAttributeNS(const namespaceURI, localName: DOMString);
    function getAttributeNodeNS(const namespaceURI, localName: DOMString): IDOMAttr; safecall;
    function setAttributeNodeNS(const newAttr: IDOMAttr): IDOMAttr; safecall;
    function getElementsByTagNameNS(const namespaceURI,
      localName: DOMString): IDOMNodeList; safecall;
    function hasAttribute(const name: DOMString): WordBool; safecall;
    function hasAttributeNS(const namespaceURI, localName: DOMString): WordBool;
    procedure normalize;
  public
    property Element: TXmlElement read GetElement;
  end;

{ TCSDOMText }

  TCSDOMText = class(TCSDOMCharacterData, IDOMText)
  protected
    function splitText(offset: Integer): IDOMText; safecall;
  end;

{ TCSDOMComment }

  TCSDOMComment = class(TCSDOMCharacterData, IDOMComment)
  end;

{ TCSDOMCDATASection }

  TCSDOMCDATASection = class(TCSDOMText, IDOMCDATASection)
  end;

{ TCSDOMDocumentType }

  TCSDOMDocumentType = class(TCSDOMNode, IDOMDocumentType)
  private
    function GetDocumentType: TXmlDocumentType;
  protected
    { IDOMDocumentType }
    function get_name: DOMString; safecall;
    function get_entities: IDOMNamedNodeMap; safecall;
    function get_notations: IDOMNamedNodeMap; safecall;
    function get_publicId: DOMString; safecall;
    function get_systemId: DOMString; safecall;
    function get_internalSubset: DOMString; safecall;
  public
    property DocumentType: TXmlDocumentType read GetDocumentType;
  end;

{ TCSDOMNotation }

  TCSDOMNotation = class(TCSDOMNode, IDOMNotation)
  private
    function GetNotation: TXmlNotation;
  protected
    { IDOMNotation }
    function get_publicId: DOMString; safecall;
    function get_systemId: DOMString; safecall;
  public
    property Notation: TXmlNotation read GetNotation;
  end;

{ TCSDOMEntity }

  TCSDOMEntity = class(TCSDOMNode, IDOMEntity)
  private
    function GetEntity: TXmlEntity;
  protected
    { IDOMEntity }
    function get_publicId: DOMString; safecall;
    function get_systemId: DOMString; safecall;
    function get_notationName: DOMString; safecall;
  public
    property Entity: TXmlEntity read GetEntity;
  end;

{ TCSDOMEntityReference }

  TCSDOMEntityReference = class(TCSDOMNode, IDOMEntityReference)
  end;

{ TCSDOMProcessingInstruction }

  TCSDOMProcessingInstruction = class(TCSDOMNode, IDOMProcessingInstruction)
  private
    function GetProcessingInstruction: TXmlProcessingInstruction;
  protected
    { IDOMProcessingInstruction }
    function get_target: DOMString; safecall;
    function get_data: DOMString; safecall;
    procedure set_data(const value: DOMString);
  public
    property ProcessingInstruction: TXmlProcessingInstruction
      read GetProcessingInstruction;
  end;

{ TCSDOMDocumentFragment }

  TCSDOMDocumentFragment = class(TCSDOMNode, IDOMDocumentFragment)
  end;

{ TCSDOMDocument }

  TCSDOMDocument = class(TCSDOMNode, IDOMDocument, IDOMParseOptions,
    IDOMPersist, IDOMParseError, IDOMXMLProlog)
  private
    FEncoding: DOMString;
    FGotProlog: Boolean;
    FStandalone: DOMString;
    FVersion: DOMString;
    FXMLObjModel: TXmlObjModel;
    function GetDocument: TXmlDocument;
  protected
    procedure InvalidDocument(oOwner: TObject; wCode: Integer; oNode: TXmlNode;
      var bStop: Boolean);
    procedure GetProlog;
    { IDOMNode }
    function get_nodeName: DOMString; override; safecall;
    { IDOMDocument }
    function get_doctype: IDOMDocumentType; safecall;
    function get_domImplementation: IDOMImplementation; safecall;
    function get_documentElement: IDOMElement; safecall;
    procedure set_documentElement(const IDOMElement: IDOMElement);
    function createElement(const tagName: DOMString): IDOMElement; safecall;
    function createDocumentFragment: IDOMDocumentFragment; safecall;
    function createTextNode(const data: DOMString): IDOMText; safecall;
    function createComment(const data: DOMString): IDOMComment; safecall;
    function createCDATASection(const data: DOMString): IDOMCDATASection; safecall;
    function createProcessingInstruction(const target,
      data: DOMString): IDOMProcessingInstruction; safecall;
    function createAttribute(const name: DOMString): IDOMAttr; safecall;
    function createEntityReference(const name: DOMString): IDOMEntityReference; safecall;
    function getElementsByTagName(const tagName: DOMString): IDOMNodeList; safecall;
    function importNode(importedNode: IDOMNode; deep: WordBool): IDOMNode; safecall;
    function createElementNS(const namespaceURI,
      qualifiedName: DOMString): IDOMElement; safecall;
    function createAttributeNS(const namespaceURI,
      qualifiedName: DOMString): IDOMAttr; safecall;
    function getElementsByTagNameNS(const namespaceURI,
      localName: DOMString): IDOMNodeList; safecall;
    function getElementById(const elementId: DOMString): IDOMElement;
    { IDOMParseOptions }
    function get_async: Boolean;
    function get_preserveWhiteSpace: Boolean;
    function get_resolveExternals: Boolean;
    function get_validate: Boolean;
    procedure set_async(Value: Boolean);
    procedure set_preserveWhiteSpace(Value: Boolean);
    procedure set_resolveExternals(Value: Boolean);
    procedure set_validate(Value: Boolean);
    { IDOMPersist }
    function get_xml: DOMString; safecall;
    function asyncLoadState: Integer; safecall;
    function load(source: OleVariant): WordBool; safecall;
    function loadFromStream(const stream: TStream): WordBool; safecall;
    function loadxml(const Value: DOMString): WordBool; safecall;
    procedure save(destination: OleVariant); safecall;
    procedure saveToStream(const stream: TStream); safecall;
    procedure set_OnAsyncLoad(const Sender: TObject;
      EventHandler: TAsyncEventHandler); safecall;
    { IDOMParseError }
    function get_errorCode: Integer;
    function get_url: WideString; safecall;
    function get_reason: WideString; safecall;
    function get_srcText: WideString; safecall;
    function get_line: Integer;
    function get_linepos: Integer;
    function get_filepos: Integer;
    { IDOMXMLProlog }
    function get_Encoding: DOMString; safecall;
    function get_Standalone: DOMString; safecall;
    function get_Version: DOMString; safecall;
    procedure set_Encoding(const Value: DOMString); safecall;
    procedure set_Standalone(const Value: DOMString); safecall;
    procedure set_Version(const Value: DOMString); safecall;
  public
    constructor Create(const Node: TXmlNode; const Document: TCSDOMDocument);
      override;
    destructor Destroy; override;
    property Document: TXmlDocument read GetDocument;
  end;

{ TCSDOMImplementationFactory }

  TCSDOMImplementationFactory = class(TDOMVendor)
  public
    function DOMImplementation: IDOMImplementation; override;
    function Description: String; override;
  end;

var
  CSXML_DOM: TCSDOMImplementationFactory;

implementation

resourcestring
  sNodeExpected = 'Node cannot be null';

{ Utility Functions -----------------------------------------------------------}

function MakeNode(const Node: TXmlNode; const Document: TCSDOMDocument):
  IDOMNode;
const
  NodeClasses: array [ELEMENT_NODE..NOTATION_NODE] of TCSDOMNodeClass =
    (TCSDOMElement, TCSDOMAttr, TCSDOMText, TCSDOMCDataSection,
     TCSDOMEntityReference, TCSDOMEntity, TCSDOMProcessingInstruction,
     TCSDOMComment, TCSDOMDocument, TCSDOMDocumentType,
     TCSDOMDocumentFragment, TCSDOMNotation);
begin
  if Assigned(Node) then
    Result := NodeClasses[Node.nodeType].Create(Node, Document)
  else
    Result := nil;
end;

function MakeNodeList(const NodeList: TXmlNodeList;
  const Document: TCSDOMDocument): IDOMNodeList;
begin
  Result := TCSDOMNodeList.Create(NodeList, Document);
end;

function MakeNamedNodeMap(const NamedNodeMap: TXmlNamedNodeMap;
  const Document: TCSDOMDocument): IDOMNamedNodeMap;
begin
  Result := TCSDOMNamedNodeMap.Create(NamedNodeMap, Document);
end;

function GetNode(const Node: IDOMNode): TXmlNode;
begin
  if not Assigned(Node) then
    raise DOMException.Create(sNodeExpected);
  Result := (Node as ICSNodeRef).GetXMLDOMNode;
end;

function FixLineBreaks(const Value: string): string;
var
  Index: Integer;
begin
  Result := Value;
  while True do
  begin
    Index := Pos(#0, Result);
    if Index = 0 then
      Exit;
    Result[Index] := #13;
  end;
end;

{ TCSDOMImplementation ------------------------------------------------------}

constructor TCSDOMImplementation.Create(
  DOMImplementation: TXmlDomImplementation);
begin
  inherited Create;
  FDOMImpl := DOMImplementation;
end;

destructor TCSDOMImplementation.Destroy;
begin
  FDOMImpl.Free;
  inherited Destroy;
end;

function TCSDOMImplementation.createDocument(const namespaceURI,
  qualifiedName: DOMString; doctype: IDOMDocumentType): IDOMDocument;
var
  Document: TCSDOMDocument;
  XML: string;
begin
  Document := TCSDOMDocument.Create(nil, nil);
  Document.FOwnerDocument := Document;
  if qualifiedName <> '' then
  begin
    XML := '<' + qualifiedName;
    if namespaceURI <> '' then
      XML := XML +
        ' xmlns:' + ExtractPrefix(qualifiedName) + '="' + namespaceURI + '"';
    XML := XML + '/>';
    Document.loadxml(XML);
  end;
  Result := Document;
end;

function TCSDOMImplementation.createDocumentType(const qualifiedName,
  publicId, systemId: DOMString): IDOMDocumentType;
begin
  DOMVendorNotSupported('createDocumentType', sCUEXml); { Do not localize }
end;

function TCSDOMImplementation.hasFeature(
  const feature, version: DOMString): WordBool;
begin
  Result := DOMImpl.hasFeature(feature, version);
end;

{ TCSDOMNode ----------------------------------------------------------------}

constructor TCSDOMNode.Create(const Node: TXmlNode;
  const Document: TCSDOMDocument);
begin
  Assert(Assigned(Node));
  FNode          := Node;
  FOwnerDocument := Document;
  inherited Create;
end;

function TCSDOMNode.appendChild(const newChild: IDOMNode): IDOMNode;
begin
  Node.appendChild(GetNode(newChild));
  Result := newChild
end;

function TCSDOMNode.cloneNode(Deep: WordBool): IDOMNode;
begin
  Result := MakeNode(Node.CloneNode(deep), FOwnerDocument);
end;

function TCSDOMNode.get_attributes: IDOMNamedNodeMap;
begin
  if not Assigned(FAttributes) and Assigned(Node.Attributes) then
    FAttributes := MakeNamedNodeMap(Node.Attributes, FOwnerDocument);
  Result := FAttributes;
end;

function TCSDOMNode.get_childNodes: IDOMNodeList;
begin
  if not Assigned(FChildNodes) then
    FChildNodes := MakeNodeList(Node.ChildNodes, FOwnerDocument);