csxmldom.pas

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

function TCSDOMDocumentType.get_notations: IDOMNamedNodeMap;
begin
  Result := MakeNamedNodeMap(DocumentType.Notations, FOwnerDocument);
end;

function TCSDOMDocumentType.get_publicId: DOMString;
begin
  Result := '';
end;

function TCSDOMDocumentType.get_systemId: DOMString;
begin
  Result := '';
end;

{ TCSDOMNotation ------------------------------------------------------------}

function TCSDOMNotation.GetNotation: TXmlNotation;
begin
  Result := Node as TXmlNotation;
end;

function TCSDOMNotation.get_publicId: DOMString;
begin
  Result := Notation.PublicId;
end;

function TCSDOMNotation.get_systemId: DOMString;
begin
  Result := Notation.SystemId;
end;

{ TCSDOMEntity --------------------------------------------------------------}

function TCSDOMEntity.GetEntity: TXmlEntity;
begin
  Result := Node as TXmlEntity;
end;

function TCSDOMEntity.get_notationName: DOMString;
begin
  Result := Entity.NotationName;
end;

function TCSDOMEntity.get_publicId: DOMString;
begin
  Result := Entity.PublicId;
end;

function TCSDOMEntity.get_systemId: DOMString;
begin
  Result := Entity.SystemId;
end;

{ TCSDOMProcessingInstruction -----------------------------------------------}

function TCSDOMProcessingInstruction.GetProcessingInstruction:
  TXmlProcessingInstruction;
begin
  Result := Node as TXmlProcessingInstruction;
end;

function TCSDOMProcessingInstruction.get_data: DOMString;
begin
  Result := ProcessingInstruction.Data;
end;

function TCSDOMProcessingInstruction.get_target: DOMString;
begin
  Result := ProcessingInstruction.Target;
end;

procedure TCSDOMProcessingInstruction.set_data(const value: DOMString);
begin
  ProcessingInstruction.Data := value;
end;

{ TCSDOMDocument ------------------------------------------------------------}

constructor TCSDOMDocument.Create(const Node: TXmlNode;
  const Document: TCSDOMDocument);
begin
  FXMLObjModel             := TXmlObjModel.Create(nil);
  FXMLObjModel.RaiseErrors := False;
  if Assigned(Node) then
    inherited Create(Node, Self)
  else
    inherited Create(FXMLObjModel.Document, Self);
end;

destructor TCSDOMDocument.Destroy;
begin
  FXMLObjModel.Free;
  inherited Destroy;
end;

function TCSDOMDocument.GetDocument: TXmlDocument;
begin
  Result := Node as TXmlDocument;
end;

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

function TCSDOMDocument.createAttributeNS(const namespaceURI,
  qualifiedName: DOMString): IDOMAttr;
begin
  Result := createAttribute(qualifiedName);
end;

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

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

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

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

function TCSDOMDocument.createElementNS(
  const namespaceURI, qualifiedName: DOMString): IDOMElement;
begin
  Result := createElement(qualifiedName);
end;

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

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

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

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

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

function TCSDOMDocument.get_domImplementation: IDOMImplementation;
begin
  Result := TCSDOMImplementation.Create(Document.DomImplementation);
end;

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

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

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

function TCSDOMDocument.getElementsByTagNameNS(
  const namespaceURI, localName: DOMString): IDOMNodeList;
begin
  DOMVendorNotSupported('getElementsByTagNameNS', sCUEXml); { Do not localize }
end;

function TCSDOMDocument.importNode(importedNode: IDOMNode; deep: WordBool):
  IDOMNode;
var
  NewNode: TXmlNode;
begin
  NewNode := GetNode(importedNode).CloneNode(deep);
  Document.ForceOwnerDocument(NewNode);
  Result  := MakeNode(NewNode, FOwnerDocument);
end;

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

{ IDOMParseOptions Interface }

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

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

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

function TCSDOMDocument.get_validate: Boolean;
begin
  Result := False;
end;

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

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

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

procedure TCSDOMDocument.set_validate(Value: Boolean);
begin
  if Value <> get_validate then
    DOMVendorNotSupported('set_validate', sCUEXml); { Do not localize }
end;

{ IDOMPersist interface }

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

function TCSDOMDocument.get_xml: DOMString;
var
  Index: Integer;
  XML: string;
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 + FixLineBreaks(Document.ChildNodes.Item(Index).XmlDocument);
end;

procedure TCSDOMDocument.InvalidDocument(oOwner: TObject;
  wCode: Integer; oNode: TXmlNode; var bStop: Boolean);
begin
end;

function TCSDOMDocument.load(source: OleVariant): WordBool;
var
  XMLDoc: DOMString;
begin
  FGotProlog := False;
  XMLDoc     := source;
  Result     := FXMLObjModel.LoadDataSource(XMLDoc);
end;

function TCSDOMDocument.loadFromStream(const stream: TStream): WordBool;
var
  MemStream: TMemoryStream;
begin
  FGotProlog := False;
  MemStream  := TMemoryStream.Create;
  try
    MemStream.CopyFrom(stream, 0);
    Result := FXMLObjModel.LoadMemory(MemStream.Memory);
  finally
    MemStream.Free;
  end;
end;

function TCSDOMDocument.loadxml(const Value: DOMString): WordBool;
var
  XML: WideString;
begin
  FGotProlog := False;
  XML        := WideChar($FEFF) + Value;
  Result     := FXMLObjModel.LoadMemory(@XML[1]);
end;

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

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

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

{ IDOMParseError }

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

function TCSDOMDocument.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 TCSDOMDocument.get_line: Integer;
begin
  Result := -1;
  try
    Result := StrToInt(FindEmbeddedValue(get_reason, 'Line: '));
  except on EConvertError do
    // Ignore
  end;
end;

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

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

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

function TCSDOMDocument.get_url: WideString;
begin
  Result := '';
end;

{ IDOMXMLProlog Interface }

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

  procedure ExtractAttrs(const Data: DOMString; const Attrs: TStringList);
  const
    Whitespace = [#9, #10, #13, ' '];
    NameChars  = ['A'..'Z', 'a'..'z', '0'..'9', '_'];
  var
    Index, Start, Len: Integer;
    Name: string;
    Quote: WideChar;
  begin
    Index := 1;
    Len   := Length(Data);
    repeat
      while (Index <= Len) and (Char(Data[Index]) in Whitespace) do
        Inc(Index);
      Start := Index;
      while (Index <= Len) and (Char(Data[Index]) in NameChars) do
        Inc(Index);
      Name := Copy(Data, Start, Index - Start);
      while (Index <= Len) and (Char(Data[Index]) in Whitespace) do
        Inc(Index);
      if Data[Index] <> '=' then
        raise DOMException.Create('Expected "="');
      Inc(Index);
      while (Index <= Len) and (Char(Data[Index]) in Whitespace) 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 (Char(Data[Index]) in Whitespace) do
        Inc(Index);
    until Index > Length(Data);
  end;

begin
  if FGotProlog then
    Exit;
  FGotProlog := True;
  if (Document.FirstChild.NodeType <> PROCESSING_INSTRUCTION_NODE) or
      (TXmlProcessingInstruction(Document.FirstChild).Target <> sXML) then
    Exit;
  Data  := TXmlProcessingInstruction(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 TCSDOMDocument.get_Encoding: DOMString;
begin
  GetProlog;
  Result := FEncoding;
end;

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

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

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

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

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

{ TCSDOMImplementationFactory -------------------------------------------------}

function TCSDOMImplementationFactory.DOMImplementation: IDOMImplementation;
begin
  Result := TCSDOMImplementation.Create(TXmlDomImplementation.Create);
end;

function TCSDOMImplementationFactory.Description: String;
begin
  Result := sCUEXml;
end;

initialization
  CSXML_DOM   := TCSDOMImplementationFactory.Create;
  RegisterDOMVendor(CSXML_DOM);
finalization
  UnRegisterDOMVendor(CSXML_DOM);
  CSXML_DOM.Free;
end.