xpxmldom.pas

Delphi XML & XPATH源代码

function TXMLPDOMDocument.GetDocument: TXpDocument;
begin
  Result := Node as TXpDocument;
end;

function TXMLPDOMDocument.createAttribute(const name: DOMString): IDOMAttr;
begin
  Result := IDOMAttr(MakeNode(Document.CreateAttribute(name), FOwnerDocument));
end;

function TXMLPDOMDocument.createAttributeNS(const namespaceURI,
  qualifiedName: DOMString): IDOMAttr;
begin
  Result := IDOMAttr(MakeNode(Document.CreateAttributeNS(
    namespaceURI, qualifiedName), FOwnerDocument));
end;

function TXMLPDOMDocument.createCDATASection(const data: DOMString):
  IDOMCDATASection;
begin
  Result := IDOMCDATASection(MakeNode(Document.CreateCDATASection(data),
    FOwnerDocument));
end;

function TXMLPDOMDocument.createComment(const data: DOMString): IDOMComment;
begin
  Result := IDOMComment(MakeNode(Document.CreateComment(data), FOwnerDocument));
end;

function TXMLPDOMDocument.createDocumentFragment: IDOMDocumentFragment;
begin
  Result := IDOMDocumentFragment(MakeNode(Document.CreateDocumentFragment,
    FOwnerDocument));
end;

function TXMLPDOMDocument.createElement(const tagName: DOMString): IDOMElement;
begin
  Result := IDOMElement(MakeNode(Document.CreateElement(tagName),
    FOwnerDocument));
end;

function TXMLPDOMDocument.createElementNS(
  const namespaceURI, qualifiedName: DOMString): IDOMElement;
begin
  Result := IDOMElement(MakeNode(Document.CreateElementNS(
    namespaceURI, qualifiedName), FOwnerDocument));
end;

function TXMLPDOMDocument.createEntityReference(const name: DOMString):
  IDOMEntityReference;
begin
  Result := IDOMEntityReference(MakeNode(Document.CreateEntityReference(name),
    FOwnerDocument));
end;

function TXMLPDOMDocument.createProcessingInstruction(
  const target, data: DOMString): IDOMProcessingInstruction;
begin
  Result := IDOMProcessingInstruction(MakeNode(
    Document.CreateProcessingInstruction(target, data), FOwnerDocument));
end;

function TXMLPDOMDocument.createTextNode(const data: DOMString): IDOMText;
begin
  Result := IDOMText(MakeNode(Document.CreateTextNode(data), FOwnerDocument));
end;

function TXMLPDOMDocument.get_doctype: IDOMDocumentType;
begin
  Result := IDOMDocumentType(MakeNode(Document.DocType, FOwnerDocument));
end;

function TXMLPDOMDocument.get_documentElement: IDOMElement;
begin
  Result := IDOMElement(MakeNode(Document.DocumentElement, FOwnerDocument));
end;

function TXMLPDOMDocument.get_domImplementation: IDOMImplementation;
begin
  Result := TXMLPDOMImplementation.Create(Document.DomImplementation);
end;

function TXMLPDOMDocument.get_nodeName: DOMString;
begin
  Result := '#document';
end;

function TXMLPDOMDocument.getElementById(const elementId: DOMString):
  IDOMElement;
begin
  Result := MakeNode(Document.SelectSingleNode('//*[@id="' + elementId + '"]'),
    FOwnerDocument) as IDOMElement;
end;

function TXMLPDOMDocument.getElementsByTagName(const tagName: DOMString):
  IDOMNodeList;
begin
  Result := MakeNodeList(Document.GetElementsByTagName(tagName), FOwnerDocument);
end;

function TXMLPDOMDocument.getElementsByTagNameNS(
  const namespaceURI, localName: DOMString): IDOMNodeList;
begin
  Result := MakeNodeList(Document.GetElementsByTagNameNS(
    namespaceURI, localName), FOwnerDocument);
end;

function TXMLPDOMDocument.importNode(importedNode: IDOMNode; deep: WordBool):
  IDOMNode;
begin
  Result := MakeNode(Document.ImportNode(GetNode(importedNode), deep),
    FOwnerDocument);
end;

procedure TXMLPDOMDocument.set_documentElement(const IDOMElement: IDOMElement);
begin
  if Assigned(Document.DocumentElement) then
    Document.RemoveChild(Document.DocumentElement);
  Document.AppendChild(GetNode(IDOMElement));
end;

{ IDOMParseOptions Interface }

function TXMLPDOMDocument.get_async: Boolean;
begin
  Result := False;
end;

function TXMLPDOMDocument.get_preserveWhiteSpace: Boolean;
begin
  Result := not FXMLObjModel.NormalizeData;
end;

function TXMLPDOMDocument.get_resolveExternals: Boolean;
begin
  Result := False;
end;

function TXMLPDOMDocument.get_validate: Boolean;
begin
  Result := FValidate;
end;

procedure TXMLPDOMDocument.set_async(Value: Boolean);
begin
  if Value <> get_async then
    DOMVendorNotSupported('set_async', SXMLPartner); { Do not localize }
end;

procedure TXMLPDOMDocument.set_preserveWhiteSpace(Value: Boolean);
begin
  FXMLObjModel.NormalizeData := not Value;
end;

procedure TXMLPDOMDocument.set_resolveExternals(Value: Boolean);
begin
  if Value <> get_resolveExternals then
    DOMVendorNotSupported('set_resolveExternals', SXMLPartner); { Do not localize }
end;

procedure TXMLPDOMDocument.set_validate(Value: Boolean);
begin
  FValidate := Value;
end;

{ IDOMPersist interface }

function TXMLPDOMDocument.asyncLoadState: Integer;
begin
  Result := 0;
end;

function TXMLPDOMDocument.get_xml: DOMString;
var
  Index: Integer;
begin
  Result := '';
  if FVersion <> '' then
    Result := Result + ' ' + sVersion + '="' + FVersion + '"';
  if FEncoding <> '' then
    Result := Result + ' ' + sEncoding + '="' + FEncoding + '"';
  if FStandalone <> '' then
    Result := Result + ' ' + sStandalone + '="' + FStandalone + '"';
  if Result <> '' then
    Result := '<?xml' + Result + '?>'#13;
  for Index := 0 to Document.ChildNodes.Length - 1 do
    Result := Result + Document.ChildNodes.Item(Index).XmlDocument + #13;
end;

function TXMLPDOMDocument.load(source: OleVariant): WordBool;
begin
  FGotProlog := False;
  Result     := FXMLObjModel.LoadDataSource(source);
  if not Result then
    Exit;
  FNode := FXMLObjModel.Document;
  if FValidate then
    Result := FXMLObjModel.ValidateDocument;
end;

function TXMLPDOMDocument.loadFromStream(const stream: TStream): WordBool;
begin
  FGotProlog := False;
  Result     := FXMLObjModel.LoadStream(Stream);
  if not Result then
    Exit;
  FNode := FXMLObjModel.Document;
  if FValidate then
    Result := FXMLObjModel.ValidateDocument;
end;

function TXMLPDOMDocument.loadxml(const Value: DOMString): WordBool;
var
  XML: DOMString;
begin
  FGotProlog := False;
  XML        := Value;
  Result     := FXMLObjModel.LoadMemory(XML[1], Length(XML));
  if not Result then
    Exit;
  FNode := FXMLObjModel.Document;
  if FValidate then
    Result := FXMLObjModel.ValidateDocument;
end;

procedure TXMLPDOMDocument.save(destination: OleVariant);
begin
  destination := Document.XmlDocument;
end;

procedure TXMLPDOMDocument.saveToStream(const stream: TStream);
var
  StrStream: TStringStream;
begin
  StrStream := TStringStream.Create(Document.XmlDocument);
  try
    Stream.CopyFrom(StrStream, 0);
  finally
    StrStream.Free;
  end;
end;

procedure TXMLPDOMDocument.set_OnAsyncLoad(const Sender: TObject;
  EventHandler: TAsyncEventHandler);
begin
  //
end;

{ IDOMParseError Interface }

function TXMLPDOMDocument.get_errorCode: Integer;
begin
  Result := 0;
end;

function TXMLPDOMDocument.get_filepos: Integer;
begin
  Result := -1;
end;

function FindEmbeddedValue(const Text, Name: WideString): WideString;
var
  Index: Integer;
  Value: WideString;
begin
  Result := '';
  if Text = '' then
    Exit;
  Value := Text;
  Index := Pos(Name, Value);
  if Index > 0 then
    Delete(Value, 1, Index + Length(Name) - 1);
  Index := Pos(' ', Value);
  if Index > 0 then
    Result := Copy(Value, 1, Index - 1);
end;

function TXMLPDOMDocument.get_line: Integer;
begin
  Result := -1;
  try
    Result := StrToInt(FindEmbeddedValue(get_reason, 'Line: '));
  except on EConvertError do
    // Ignore
  end;
end;

function TXMLPDOMDocument.get_linepos: Integer;
begin
  Result := -1;
  try
    Result := StrToInt(FindEmbeddedValue(get_reason, 'Col: '));
  except on EConvertError do
    // Ignore
  end;
end;

function TXMLPDOMDocument.get_reason: WideString;
begin
  Result := FXMLObjModel.Errors.Text;
end;

function TXMLPDOMDocument.get_srcText: WideString;
begin
  Result := '';
end;

function TXMLPDOMDocument.get_url: WideString;
begin
  Result := FindEmbeddedValue(get_reason, 'File: ');
end;

{ IDOMXMLProlog Interface }

procedure TXMLPDOMDocument.GetProlog;
var
  Data: string;
  Attrs: TStringList;

  procedure ExtractAttrs(const Data: DOMString; const Attrs: TStringList);
  var
    Index, Start, Len: Integer;
    Name: string;
    Quote: WideChar;
  begin
    Index := 1;
    Len   := Length(Data);
    repeat
      while (Index <= Len) and XPIsSpace(Ord(Data[Index])) do
        Inc(Index);
      Start := Index;
      while (Index <= Len) and XPIsNameChar(Ord(Data[Index])) do
        Inc(Index);
      Name := Copy(Data, Start, Index - Start);
      while (Index <= Len) and XPIsSpace(Ord(Data[Index])) do
        Inc(Index);
      if Data[Index] <> '=' then
        raise DOMException.Create('Expected "="');
      Inc(Index);
      while (Index <= Len) and XPIsSpace(Ord(Data[Index])) do
        Inc(Index);
      Quote := Data[Index];
      Inc(Index);
      Start := Index;
      while (Index <= Len) and (Data[Index] <> Quote) do
        Inc(Index);
      Attrs.Values[Name] := Copy(Data, Start, Index - Start);
      Inc(Index);
      while (Index <= Len) and XPIsSpace(Ord(Data[Index])) do
        Inc(Index);
    until Index > Length(Data);
  end;

begin
  if FGotProlog then
    Exit;
  FGotProlog := True;
  if (Document.FirstChild.NodeType <> PROCESSING_INSTRUCTION_NODE) or
      (TXpProcessingInstruction(Document.FirstChild).Target <> sXML) then
    Exit;
  Data  := TXpProcessingInstruction(Document.FirstChild).Data;
  Attrs := TStringList.Create;
  try
    ExtractAttrs(Data, Attrs);
    FVersion    := Attrs.Values[sVersion];
    FEncoding   := Attrs.Values[sEncoding];
    FStandalone := Attrs.Values[sStandalone];
  finally
    Attrs.Free;
  end;
end;

function TXMLPDOMDocument.get_Encoding: DOMString;
begin
  GetProlog;
  Result := FEncoding;
end;

function TXMLPDOMDocument.get_Standalone: DOMString;
begin
  GetProlog;
  Result := FStandalone;
end;

function TXMLPDOMDocument.get_Version: DOMString;
begin
  GetProlog;
  Result := FVersion;
end;

procedure TXMLPDOMDocument.set_Encoding(const Value: DOMString);
begin
  FEncoding := Value;
end;

procedure TXMLPDOMDocument.set_Standalone(const Value: DOMString);
begin
  FStandalone := Value;
end;

procedure TXMLPDOMDocument.set_Version(const Value: DOMString);
begin
  FVersion := Value;
end;

{ TXMLPDOMImplementationFactory -----------------------------------------------}

function TXMLPDOMImplementationFactory.DOMImplementation: IDOMImplementation;
begin
  Result := TXMLPDOMImplementation.Create(TXpDomImplementation.Create);
end;

function TXMLPDOMImplementationFactory.Description: String;
begin
  Result := SXMLPartner;
end;

initialization
  XPXML_DOM   := TXMLPDOMImplementationFactory.Create;
  RegisterDOMVendor(XPXML_DOM);
finalization
  UnRegisterDOMVendor(XPXML_DOM);
  XPXML_DOM.Free;
end.