DOMCore.pas
上传用户:yjb1804
上传日期:2021-01-30
资源大小:3105k
文件大小:46k
源码类别:

Email服务器

开发平台:

Delphi

  1. unit DomCore;
  2. interface
  3. uses
  4.   Classes, SysUtils, WStrings;
  5. const
  6.   TAB = 9;
  7.   LF = 10;
  8.   CR = 13;
  9.   SP = 32;
  10.   WhiteSpace = [TAB, LF, CR, SP];
  11.   NONE                           = 0;  // extension
  12.   ELEMENT_NODE                   = 1;
  13.   ATTRIBUTE_NODE                 = 2;
  14.   TEXT_NODE                      = 3;
  15.   CDATA_SECTION_NODE             = 4;
  16.   ENTITY_REFERENCE_NODE          = 5;
  17.   ENTITY_NODE                    = 6;
  18.   PROCESSING_INSTRUCTION_NODE    = 7;
  19.   COMMENT_NODE                   = 8;
  20.   DOCUMENT_NODE                  = 9;
  21.   DOCUMENT_TYPE_NODE             = 10;
  22.   DOCUMENT_FRAGMENT_NODE         = 11;
  23.   NOTATION_NODE                  = 12;
  24.   END_ELEMENT_NODE               = 255; // extension
  25.   INDEX_SIZE_ERR                 = 1;
  26.   DOMSTRING_SIZE_ERR             = 2;
  27.   HIERARCHY_REQUEST_ERR          = 3;
  28.   WRONG_DOCUMENT_ERR             = 4;
  29.   INVALID_CHARACTER_ERR          = 5;
  30.   NO_DATA_ALLOWED_ERR            = 6;
  31.   NO_MODIFICATION_ALLOWED_ERR    = 7;
  32.   NOT_FOUND_ERR                  = 8;
  33.   NOT_SUPPORTED_ERR              = 9;
  34.   INUSE_ATTRIBUTE_ERR            = 10;
  35.   INVALID_STATE_ERR              = 11;
  36.   SYNTAX_ERR                     = 12;
  37.   INVALID_MODIFICATION_ERR       = 13;
  38.   NAMESPACE_ERR                  = 14;
  39.   INVALID_ACCESS_ERR             = 15;
  40.   {HTML DTDs}
  41.   DTD_HTML_STRICT    = 1;
  42.   DTD_HTML_LOOSE     = 2;
  43.   DTD_HTML_FRAMESET  = 3;
  44.   DTD_XHTML_STRICT   = 4;
  45.   DTD_XHTML_LOOSE    = 5;
  46.   DTD_XHTML_FRAMESET = 6;
  47.   
  48. type
  49.   TDomString = WideString;
  50.   DomException = class(Exception)
  51.   private
  52.     FCode: Integer;
  53.   public
  54.     constructor Create(code: Integer);
  55.     property code: Integer read FCode;
  56.   end;
  57.   TNamespaceURIList = class
  58.   private
  59.     FList: TWStrings;
  60.     function GetItem(I: Integer): TDomString;
  61.   public
  62.     constructor Create;
  63.     destructor Destroy; override;
  64.     procedure Clear;
  65.     function Add(const NamespaceURI: TDomString): Integer;
  66.     property Item[I: Integer]: TDomString read GetItem; default;
  67.   end;
  68.   TDocument = class;
  69.   TNodeList = class;
  70.   TNamedNodeMap = class;
  71.   TElement = class;
  72.   TNode = class
  73.   private
  74.     FOwnerDocument: TDocument;
  75.     FParentNode: TNode;
  76.     FNamespaceURI: Integer;
  77.     FPrefix: TDomString;
  78.     FNodeName: TDomString;
  79.     FNodeValue: TDomString;
  80.     FAttributes: TNamedNodeMap;
  81.     function GetFirstChild: TNode;
  82.     function GetLastChild: TNode;
  83.     function GetPreviousSibling: TNode;
  84.     function GetNextSibling: TNode;
  85.     function GetLocalName: TDomString;
  86.     function GetNamespaceURI: TDomString;
  87.     function InsertSingleNode(newChild, refChild: TNode): TNode;
  88.   protected                    
  89.     FChildNodes: TNodeList;
  90.     function GetNodeName: TDomString; virtual;
  91.     function GetNodeValue: TDomString; virtual;
  92.     function GetNodeType: Integer; virtual; abstract;
  93.     function GetParentNode: TNode; virtual;
  94.     function CanInsert(Node: TNode): Boolean; virtual;
  95.     function ExportNode(otherDocument: TDocument; deep: Boolean): TNode; virtual;
  96.     procedure SetNodeValue(const value: TDomString); virtual;
  97.     procedure SetNamespaceURI(const value: TDomString);
  98.     procedure SetPrefix(const value: TDomString);
  99.     procedure SetLocalName(const value: TDomString);
  100.     procedure CloneChildNodesFrom(Node: TNode);
  101.     constructor Create(ownerDocument: TDocument; const namespaceURI, qualifiedName: TDomString; withNS: Boolean);
  102.   public
  103.     destructor Destroy; override;
  104.     function insertBefore(newChild, refChild: TNode): TNode;
  105.     function replaceChild(newChild, oldChild: TNode): TNode;
  106.     function removeChild(oldChild: TNode): TNode;
  107.     function appendChild(newChild: TNode): TNode;
  108.     function hasChildNodes: Boolean;
  109.     function cloneNode(deep: Boolean): TNode; virtual; abstract;
  110.     function isSupported(const feature, version: TDomString): Boolean;
  111.     function hasAttributes: Boolean;
  112.     function ancestorOf(node: TNode): Boolean;
  113.     function getElementsByTagName(const name: TDomString): TNodeList;
  114.     function getElementsByTagNameNS(const namespaceURI, localName: TDomString): TNodeList;
  115.     function getElementById(const elementId: TDomString): TElement;
  116.     procedure normalize;
  117.     property nodeName: TDomString read GetNodeName;
  118.     property nodeValue: TDomString read FNodeValue write SetNodeValue;
  119.     property nodeType: Integer read GetNodeType;
  120.     property parentNode: TNode read GetParentNode;
  121.     property childNodes: TNodeList read FChildNodes;
  122.     property firstChild: TNode read GetFirstChild;
  123.     property lastChild: TNode read GetLastChild;
  124.     property previousSibling: TNode read GetPreviousSibling;
  125.     property nextSibling: TNode read GetNextSibling;
  126.     property attributes: TNamedNodeMap read FAttributes;
  127.     property ownerDocument: TDocument read FOwnerDocument;
  128.     property namespaceURI: TDomString read GetNamespaceURI;
  129.     property prefix: TDomString read FPrefix write SetPrefix;
  130.     property localName: TDomString read GetLocalName;
  131.   end;
  132.   TNodeList = class
  133.   private
  134.     FOwnerNode: TNode;
  135.     FList: TList;
  136.   protected
  137.     function GetLength: Integer; virtual;
  138.     function IndexOf(node: TNode): Integer;
  139.     procedure Add(node: TNode);
  140.     procedure Delete(I: Integer);
  141.     procedure Insert(I: Integer; node: TNode);
  142.     procedure Remove(node: TNode);
  143.     procedure Clear(WithItems: Boolean);
  144.     property ownerNode: TNode read FOwnerNode;
  145.     constructor Create(AOwnerNode: TNode);
  146.   public                                  
  147.     destructor Destroy; override;
  148.     function item(index: Integer): TNode; virtual;
  149.     property length: Integer read GetLength;
  150.   end;
  151.   TNamedNodeMap = class(TNodeList)
  152.   public
  153.     function getNamedItem(const name: TDomString): TNode;
  154.     function setNamedItem(arg: TNode): TNode;
  155.     function removeNamedItem(const name: TDomString): TNode;
  156.     function getNamedItemNS(const namespaceURI, localName: TDomString): TNode;
  157.     function setNamedItemNS(arg: TNode): TNode;
  158.     function removeNamedItemNS(const namespaceURI, localName: TDomString): TNode;
  159.   end;
  160.   TCharacterData = class(TNode)
  161.   private
  162.     function GetLength: Integer;
  163.   protected
  164.     procedure SetNodeValue(const value: TDomString); override;
  165.     constructor Create(ownerDocument: TDocument; const data: TDomString);
  166.   public
  167.     function substringData(offset, count: Integer): TDomString;
  168.     procedure appendData(const arg: TDomString);
  169.     procedure deleteData(offset, count: Integer);
  170.     procedure insertData(offset: Integer; arg: TDomString);
  171.     procedure replaceData(offset, count: Integer; const arg: TDomString);
  172.     property data: TDomString read GetNodeValue write SetNodeValue;
  173.     property length: Integer read GetLength;
  174.   end;
  175.   TComment = class(TCharacterData)
  176.   protected
  177.     function GetNodeName: TDomString; override;
  178.     function GetNodeType: Integer; override;
  179.     function ExportNode(otherDocument: TDocument; deep: Boolean): TNode; override;
  180.   public
  181.     function cloneNode(deep: Boolean): TNode; override;
  182.   end;
  183.   TTextNode = class(TCharacterData)
  184.   protected
  185.     function GetNodeName: TDomString; override;
  186.     function GetNodeType: Integer; override;
  187.     function ExportNode(otherDocument: TDocument; deep: Boolean): TNode; override;
  188.   public
  189.     function cloneNode(deep: Boolean): TNode; override;
  190.     function splitText(offset: Integer): TTextNode;
  191.   end;
  192.   TCDATASection = class(TTextNode)
  193.   protected
  194.     function GetNodeName: TDomString; override;
  195.     function GetNodeType: Integer; override;
  196.     function ExportNode(otherDocument: TDocument; deep: Boolean): TNode; override;
  197.   public
  198.     function cloneNode(deep: Boolean): TNode; override;
  199.   end;
  200.   TAttr = class(TNode)
  201.   private
  202.     function GetOwnerElement: TElement;
  203.     function GetLength: Integer;
  204.     function GetSpecified: Boolean;
  205.   protected
  206.     function GetNodeValue: TDomString; override;
  207.     function GetNodeType: Integer; override;
  208.     function GetParentNode: TNode; override;
  209.     function CanInsert(node: TNode): Boolean; override;
  210.     function ExportNode(ownerDocument: TDocument; deep: Boolean): TNode; override;
  211.     procedure SetNodeValue(const value: TDomString); override;
  212.   public
  213.     function cloneNode(deep: Boolean): TNode; override;
  214.     property name: TDomString read GetNodeName;
  215.     property specified: Boolean read GetSpecified;
  216.     property value: TDomString read GetNodeValue write SetNodeValue;
  217.     property ownerElement: TElement read GetOwnerElement;
  218.   end;
  219.   TElement = class(TNode)
  220.   private
  221.     FIsEmpty: Boolean;
  222.   protected
  223.     function GetNodeType: Integer; override;
  224.     function CanInsert(node: TNode): Boolean; override;
  225.     function ExportNode(otherDocument: TDocument; deep: Boolean): TNode; override;
  226.     constructor Create(ownerDocument: TDocument; const namespaceURI, qualifiedName: TDomString; withNS: Boolean);
  227.   public
  228.     function cloneNode(deep: Boolean): TNode; override;
  229.     function getAttribute(const name: TDomString): TDomString;
  230.     function getAttributeNode(const name: TDomString): TAttr;
  231.     function setAttributeNode(newAttr: TAttr): TAttr;
  232.     function removeAttributeNode(oldAttr: TAttr): TAttr;
  233.     function getAttributeNS(const namespaceURI, localName: TDomString): TDomString;
  234.     function getAttributeNodeNS(const namespaceURI, localName: TDomString): TAttr;
  235.     function setAttributeNodeNS(newAttr: TAttr): TAttr;
  236.     function hasAttribute(const name: TDomString): Boolean;
  237.     function hasAttributeNS(const namespaceURI, localName: TDomString): Boolean;
  238.     procedure setAttribute(const name, value: TDomString);
  239.     procedure removeAttribute(const name: TDomString);
  240.     procedure setAttributeNS(const namespaceURI, qualifiedName, value: TDomString);
  241.     procedure removeAttributeNS(const namespaceURI, localName: TDomString);
  242.     property tagName: TDomString read GetNodeName;
  243.     property isEmpty: Boolean read FIsEmpty write FIsEmpty;
  244.   end;
  245.   TEntityReference = class(TNode)
  246.   protected
  247.     function GetNodeType: Integer; override;
  248.     function ExportNode(otherDocument: TDocument; deep: Boolean): TNode; override;
  249.     constructor Create(ownerDocument: TDocument; const name: TDomString);
  250.   public
  251.     function cloneNode(deep: Boolean): TNode; override;
  252.   end;
  253.   TProcessingInstruction = class(TNode)
  254.   private
  255.     function GetTarget: TDomString;
  256.     function GetData: TDomString;
  257.     procedure SetData(const value: TDomString);
  258.   protected
  259.     function GetNodeType: Integer; override;
  260.     function ExportNode(otherDocument: TDocument; deep: Boolean): TNode; override;
  261.     constructor Create(ownerDocument: TDocument; const target, data: TDomString);
  262.   public
  263.     function cloneNode(deep: Boolean): TNode; override;
  264.     property target: TDomString read GetTarget;
  265.     property data: TDomString read GetData write SetData;
  266.   end;
  267.   TDocumentFragment = class(TNode)
  268.   protected
  269.     function CanInsert(node: TNode): Boolean; override;
  270.     function GetNodeType: Integer; override;
  271.     function GetNodeName: TDomString; override;
  272.     function ExportNode(otherDocument: TDocument; deep: Boolean): TNode; override;
  273.     constructor Create(ownerDocument: TDocument);
  274.   public
  275.     function cloneNode(deep: Boolean): TNode; override;
  276.   end;
  277.   TDocumentType = class(TNode)
  278.   private
  279.     FEntities: TNamedNodeMap;
  280.     FNotations: TNamedNodeMap;
  281.     FPublicID: TDomString;
  282.     FSystemID: TDomString;
  283.     FInternalSubset: TDomString;
  284.   protected
  285.     function GetNodeType: Integer; override;
  286.     constructor Create(ownerDocument: TDocument; const name, publicId, systemId: TDomString);
  287.   public
  288.     function cloneNode(deep: Boolean): TNode; override;
  289.     property name: TDomString read GetNodeName;
  290.     property entities: TNamedNodeMap read FEntities;
  291.     property notations: TNamedNodeMap read FNotations;
  292.     property publicId: TDomString read FPublicID;
  293.     property systemId: TDomString read FSystemID;
  294.     property internalSubset: TDomString read FInternalSubset;
  295.   end;
  296.   TDocument = class(TNode)
  297.   private
  298.     FDocType: TDocumentType;
  299.     FNamespaceURIList: TNamespaceURIList;
  300.     FSearchNodeLists: TList;
  301.     function GetDocumentElement: TElement;
  302.   protected
  303.     function GetNodeName: TDomString; override;
  304.     function GetNodeType: Integer; override;
  305.     function CanInsert(Node: TNode): Boolean; override;
  306.     function createDocType(const name, publicId, systemId: TDomString): TDocumentType;
  307.     procedure AddSearchNodeList(NodeList: TNodeList);
  308.     procedure RemoveSearchNodeList(NodeList: TNodeList);
  309.     procedure InvalidateSearchNodeLists;
  310.     procedure SetDocType(value: TDocumentType);
  311.   public
  312.     constructor Create(doctype: TDocumentType);
  313.     destructor Destroy; override;
  314.     procedure Clear;
  315.     function cloneNode(deep: Boolean): TNode; override;
  316.     function createElement(const tagName: TDomString): TElement;
  317.     function createDocumentFragment: TDocumentFragment;
  318.     function createTextNode(const data: TDomString): TTextNode;
  319.     function createComment(const data: TDomString): TComment;
  320.     function createCDATASection(const data: TDomString): TCDATASection;
  321.     function createProcessingInstruction(const target, data: TDomString): TProcessingInstruction;
  322.     function createAttribute(const name: TDomString): TAttr;
  323.     function createEntityReference(const name: TDomString): TEntityReference;
  324.     function importNode(importedNode: TNode; deep: Boolean): TNode;
  325.     function createElementNS(const namespaceURI, qualifiedName: TDomString): TElement;
  326.     function createAttributeNS(const namespaceURI, qualifiedName: TDomString): TAttr;
  327.     property doctype: TDocumentType read FDocType write SetDocType;
  328.     property namespaceURIList: TNamespaceURIList read FNamespaceURIList;
  329.     property documentElement: TElement read GetDocumentElement;
  330.   end;
  331.   DomImplementation = class
  332.   public
  333.     class function hasFeature(const feature, version: TDomString): Boolean;
  334.     class function createDocumentType(const qualifiedName, publicId, systemId: TDomString): TDocumentType;
  335.     class function createHtmlDocumentType(htmlDocType: Integer): TDocumentType; // extension
  336.     class function createEmptyDocument(doctype: TDocumentType): TDocument; // extension
  337.     class function createDocument(const namespaceURI, qualifiedName: TDomString; doctype: TDocumentType): TDocument;
  338.   end;
  339. implementation
  340. uses
  341.   Entities;
  342. const
  343.   ExceptionMsg: array[INDEX_SIZE_ERR..INVALID_ACCESS_ERR] of String = (
  344.     'Index or size is negative, or greater than the allowed value',
  345.     'The specified range of text does not fit into a DOMString',
  346.     'Node is inserted somewhere it doesn''t belong ',
  347.     'Node is used in a different document than the one that created it',
  348.     'Invalid or illegal character is specified, such as in a name',
  349.     'Data is specified for a node which does not support data',
  350.     'An attempt is made to modify an object where modifications are not allowed',
  351.     'An attempt is made to reference a node in a context where it does not exist',
  352.     'Implementation does not support the requested type of object or operation',
  353.     'An attempt is made to add an attribute that is already in use elsewhere',
  354.     'An attempt is made to use an object that is not, or is no longer, usable',
  355.     'An invalid or illegal string is specified',
  356.     'An attempt is made to modify the type of the underlying object',
  357.     'An attempt is made to create or change an object in a way which is incorrect with regard to namespaces',
  358.     'A parameter or an operation is not supported by the underlying object'
  359.   );
  360.   ID_NAME = 'id';
  361. type
  362.   TDTDParams = record
  363.     PublicId: TDomString;
  364.     SystemId: TDomString;
  365.   end;
  366.   TDTDList = array[DTD_HTML_STRICT..DTD_XHTML_FRAMESET] of TDTDParams;
  367. const
  368.   DTDList: TDTDList = (
  369.     (publicId: '-//W3C//DTD HTML 4.01//EN';              systemId: 'http://www.w3.org/TR/html4/strict.dtd'),
  370.     (publicId: '-//W3C//DTD HTML 4.01 Transitional//EN'; systemId: 'http://www.w3.org/TR/1999/REC-html401-19991224/loose.dtd'),
  371.     (publicId: '-//W3C//DTD HTML 4.01 Frameset//EN';     systemId: 'http://www.w3.org/TR/1999/REC-html401-19991224/frameset.dtd'),
  372.     (publicId: '-//W3C//DTD XHTML 1.0 Strict//EN';       systemId: 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'),
  373.     (publicId: '-//W3C//DTD XHTML 1.0 Transitional//EN'; systemId: 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd'),
  374.     (publicId: '-//W3C//DTD XHTML 1.0 Frameset//EN';     systemId: 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd')
  375.   );
  376.   HTML_TAG_NAME = 'html';
  377. type
  378.   TSearchNodeList = class(TNodeList)
  379.   private
  380.     FNamespaceParam : TDomString;
  381.     FNameParam : TDomString;
  382.     FSynchronized: Boolean;
  383.     function GetLength: Integer; override;
  384.     function acceptNode(node: TNode): Boolean;
  385.     procedure TraverseTree(rootNode: TNode);
  386.     procedure Rebuild;
  387.   public
  388.     constructor Create(AOwnerNode: TNode; const namespaceURI, name: TDomString);
  389.     destructor Destroy; override;
  390.     procedure Invalidate; 
  391.     function item(index: Integer): TNode; override;
  392.   end;
  393. {
  394. function Concat(const S1, S2: TDomString): TDomString;
  395. begin
  396.   SetLength(Result, Length(S1) + Length(S2));
  397.   Move(S1[1], Result[1], 2 * Length(S1));
  398.   Move(S2[1], Result[Length(S1) + 1], 2 * Length(S2))
  399. end;
  400. }
  401. function IsNCName(const Value: TDomString): Boolean;
  402. begin
  403.   //TODO
  404.   Result := true
  405. end;
  406. constructor TNamespaceURIList.Create;
  407. begin
  408.   inherited Create;
  409.   FList := TWStringList.Create;
  410.   FList.Add('')
  411. end;
  412. destructor TNamespaceURIList.Destroy;
  413. begin
  414.   FList.Free;
  415.   inherited Destroy
  416. end;
  417. procedure TNamespaceURIList.Clear;
  418. begin
  419.   FList.Clear
  420. end;
  421. function TNamespaceURIList.GetItem(I: Integer): TDomString;
  422. begin
  423.   Result := FList[I]
  424. end;
  425. function TNamespaceURIList.Add(const NamespaceURI: TDomString): Integer;
  426. var
  427.   I: Integer;
  428. begin
  429.   for I := 0 to FList.Count - 1 do
  430.     if FList[I] = NamespaceURI then
  431.     begin
  432.       Result := I;
  433.       Exit
  434.     end;
  435.   Result := FList.Add(NamespaceURI)
  436. end;
  437. constructor DomException.Create(code: Integer);
  438. begin
  439.   inherited Create(ExceptionMsg[code]);
  440.   FCode := code
  441. end;
  442. constructor TNode.Create(ownerDocument: TDocument; const namespaceURI, qualifiedName: TDomString; withNS: Boolean);
  443. var
  444.   I: Integer;
  445. begin
  446.   inherited Create;
  447.   FOwnerDocument := ownerDocument;
  448.   SetNamespaceURI(namespaceURI);
  449.   if withNS then
  450.   begin
  451.     I := Pos(':', qualifiedName);
  452.     if I <> 0 then
  453.     begin
  454.       SetPrefix(Copy(qualifiedName, 1, I - 1));
  455.       SetLocalName(Copy(qualifiedName, I + 1, Length(qualifiedName) - I))
  456.     end
  457.     else
  458.       SetLocalName(qualifiedName)
  459.   end
  460.   else
  461.       SetLocalName(qualifiedName);
  462.   FChildNodes := TNodeList.Create(Self)
  463. end;
  464. destructor TNode.Destroy;
  465. begin
  466.   if Assigned(FChildNodes) then
  467.   begin
  468.     FChildNodes.Clear(true);
  469.     FChildNodes.Free
  470.   end;
  471.   if Assigned(FAttributes) then
  472.   begin
  473.     FAttributes.Clear(true);
  474.     FAttributes.Free
  475.   end;
  476.   inherited Destroy
  477. end;
  478. function TNode.GetFirstChild: TNode;
  479. begin
  480.   if childNodes.length <> 0 then
  481.     Result := childNodes.item(0)
  482.   else
  483.     Result := nil
  484. end;
  485. function TNode.GetLastChild: TNode;
  486. begin                          
  487.   if childNodes.length <> 0 then
  488.     Result := childNodes.item(childNodes.length - 1)
  489.   else
  490.     Result := nil
  491. end;
  492. function TNode.GetPreviousSibling: TNode;       
  493. var
  494.   I: Integer;
  495. begin 
  496.   Result := nil;
  497.   if Assigned(parentNode) then
  498.   begin
  499.     I := parentNode.childNodes.IndexOf(Self);
  500.     if I > 0 then
  501.       Result := parentNode.childNodes.item(I - 1)
  502.   end
  503. end;
  504. function TNode.GetNextSibling: TNode;       
  505. var
  506.   I: Integer;
  507. begin 
  508.   Result := nil;
  509.   if Assigned(parentNode) then
  510.   begin
  511.     I := parentNode.childNodes.IndexOf(Self);
  512.     if (I >= 0) and (I < parentNode.childNodes.length - 1) then
  513.       Result := parentNode.childNodes.item(I + 1)
  514.   end
  515. end;
  516. function TNode.GetNodeName: TDomString;
  517. begin
  518.   if FPrefix <> '' then
  519.     Result := FPrefix + ':' + FNodeName
  520.   else
  521.     Result := FNodeName
  522. end;
  523. function TNode.GetNodeValue: TDomString;
  524. begin
  525.   Result := FNodeValue
  526. end;
  527. function TNode.GetParentNode: TNode;
  528. begin
  529.   Result := FParentNode
  530. end;
  531. function TNode.GetLocalName: TDomString;
  532. begin
  533.   Result := FNodeName
  534. end;
  535.                             
  536. function TNode.CanInsert(Node: TNode): Boolean;
  537. begin
  538.   Result := false;
  539. end;
  540.                         
  541. function TNode.ExportNode(otherDocument: TDocument; deep: Boolean): TNode;
  542. begin
  543.   raise DomException.Create(NOT_SUPPORTED_ERR)
  544. end;
  545. function TNode.getElementsByTagName(const name: TDomString): TNodeList;
  546. begin
  547.   Result := TSearchNodeList.Create(Self, '*', name)
  548. end;
  549. function TNode.getElementsByTagNameNS(const namespaceURI, localName: TDomString): TNodeList;
  550. begin
  551.   Result := TSearchNodeList.Create(Self, namespaceURI, localName)
  552. end;
  553. function TNode.getElementById(const elementId: TDomString): TElement;
  554. var
  555.   I: Integer;
  556. begin
  557.   Result := nil;
  558.   if nodeType <> ELEMENT_NODE then
  559.     Exit;
  560.   if (Self as TElement).getAttribute(ID_NAME) = elementId then
  561.     Result := Self as TElement
  562.   else
  563.   begin
  564.     for I := 0 to childNodes.length - 1 do
  565.     begin
  566.       Result := childNodes.item(I).getElementById(elementId);
  567.       if Assigned(Result) then
  568.         Exit
  569.     end
  570.   end
  571. end;
  572. procedure TNode.SetNodeValue(const value: TDomString);
  573. begin
  574.   raise DomException.Create(NO_MODIFICATION_ALLOWED_ERR)
  575. end;
  576. procedure TNode.SetNamespaceURI(const value: TDomString);
  577. begin
  578.   if value <> '' then
  579.     //TODO validate
  580.     FNamespaceURI := ownerDocument.namespaceURIList.Add(value)
  581. end;
  582. function TNode.GetNamespaceURI: TDomString;
  583. begin
  584.   Result := ownerDocument.namespaceURIList[FNamespaceURI]
  585. end;
  586. procedure TNode.SetPrefix(const value: TDomString);
  587. begin
  588.   if not IsNCName(value) then
  589.     raise DomException.Create(INVALID_CHARACTER_ERR);
  590.   FPrefix := value
  591. end;
  592. procedure TNode.SetLocalName(const value: TDomString);
  593. begin
  594.   if not IsNCName(value) then
  595.     raise DomException.Create(INVALID_CHARACTER_ERR);
  596.   FNodeName := value
  597. end;
  598. procedure TNode.CloneChildNodesFrom(Node: TNode);
  599. var
  600.   childNode: TNode;
  601.   I: Integer;
  602. begin
  603.   for I := 0 to Node.childNodes.length - 1 do
  604.   begin
  605.     childNode := Node.childNodes.item(I);
  606.     appendChild(childNode.cloneNode(true))
  607.   end
  608. end;
  609.                                    
  610. function TNode.InsertSingleNode(newChild, refChild: TNode): TNode;
  611. var
  612.   I: Integer;
  613. begin
  614.   if not CanInsert(newChild) or newChild.ancestorOf(Self) then
  615.     raise DomException.Create(HIERARCHY_REQUEST_ERR);
  616.   if newChild <> refChild then
  617.   begin
  618.     if Assigned(refChild) then
  619.     begin
  620.       I := FChildNodes.IndexOf(refChild);
  621.       if I < 0 then
  622.         raise DomException.Create(NOT_FOUND_ERR);
  623.       FChildNodes.Insert(I, newChild)
  624.     end
  625.     else
  626.       FChildNodes.Add(newChild);
  627.     if Assigned(newChild.parentNode) then
  628.       newChild.parentNode.removeChild(newChild);
  629.     newChild.FParentNode := Self
  630.   end;
  631.   Result := newChild
  632. end;
  633. function TNode.insertBefore(newChild, refChild: TNode): TNode;
  634. begin
  635.   if newChild.ownerDocument <> ownerDocument then
  636.     raise DomException.Create(WRONG_DOCUMENT_ERR);
  637.   if newChild.nodeType = DOCUMENT_FRAGMENT_NODE then
  638.   begin
  639.     while Assigned(newChild.firstChild) do
  640.       InsertSingleNode(newChild.firstChild, refChild);
  641.     Result := newChild
  642.   end
  643.   else
  644.     Result := InsertSingleNode(newChild, refChild);
  645.   if Assigned(ownerDocument) then
  646.     ownerDocument.InvalidateSearchNodeLists
  647. end;
  648. function TNode.replaceChild(newChild, oldChild: TNode): TNode;
  649. begin
  650.   if newChild <> oldChild then
  651.   begin
  652.     insertBefore(newChild, oldChild);
  653.     removeChild(oldChild)
  654.   end;
  655.   Result := oldChild;
  656.   if Assigned(ownerDocument) then
  657.     ownerDocument.InvalidateSearchNodeLists
  658. end;
  659. function TNode.appendChild(newChild: TNode): TNode;
  660. begin
  661.   Result := insertBefore(newChild, nil);
  662.   if Assigned(ownerDocument) then
  663.     ownerDocument.InvalidateSearchNodeLists
  664. end;
  665. function TNode.removeChild(oldChild: TNode): TNode;
  666. var
  667.   I: Integer;
  668. begin
  669.   I := FChildNodes.IndexOf(oldChild);
  670.   if I < 0 then
  671.     raise DomException.Create(NOT_FOUND_ERR);
  672.   FChildNodes.Delete(I);
  673.   oldChild.FParentNode := nil;
  674.   Result := oldChild;
  675.   if Assigned(ownerDocument) then
  676.     ownerDocument.InvalidateSearchNodeLists
  677. end;
  678. function TNode.hasChildNodes: Boolean;
  679. begin
  680.   Result := FChildNodes.length <> 0
  681. end;
  682.                           
  683. function TNode.isSupported(const feature, version: TDomString): Boolean;
  684. begin
  685.   Result := DOMImplementation.hasFeature(feature, version)
  686. end;
  687. function TNode.hasAttributes: Boolean;
  688. begin
  689.   Result := Assigned(FAttributes) and (FAttributes.length <> 0)
  690. end;
  691.                          
  692. function TNode.ancestorOf(node: TNode): Boolean;
  693. begin
  694.   while Assigned(node) do
  695.   begin
  696.     if node = self then
  697.     begin
  698.       Result := true;
  699.       Exit
  700.     end;
  701.     node := node.parentNode
  702.   end;
  703.   Result := false
  704. end;
  705. procedure TNode.normalize;
  706. var
  707.   childNode: TNode;
  708.   textNode: TTextNode;
  709.   I: Integer;
  710. begin
  711.   I := 0;
  712.   while I < childNodes.length do
  713.   begin
  714.     childNode := childNodes.item(I);
  715.     if childNode.nodeType = ELEMENT_NODE then
  716.     begin
  717.       (childNode as TElement).normalize;
  718.       Inc(I)
  719.     end
  720.     else
  721.     if childNode.nodeType = TEXT_NODE then
  722.     begin
  723.       textNode := childNode as TTextNode;
  724.       Inc(I);
  725.       childNode := childNodes.item(I);
  726.       while childNode.nodeType = TEXT_NODE do
  727.       begin
  728.         textNode.appendData((childNode as TTextNode).Data);
  729.         Inc(I);
  730.         childNode := childNodes.item(I)
  731.       end
  732.     end
  733.     else
  734.       Inc(I)
  735.   end
  736. end;
  737. constructor TNodeList.Create(AOwnerNode: TNode);
  738. begin
  739.   inherited Create;
  740.   FOwnerNode := AOwnerNode;
  741.   FList := TList.Create
  742. end;
  743. destructor TNodeList.Destroy;
  744. begin
  745.   FList.Free;
  746.   inherited Destroy
  747. end;
  748. function TNodeList.IndexOf(node: TNode): Integer;
  749. begin
  750.   Result := FList.IndexOf(node)
  751. end;
  752. function TNodeList.GetLength: Integer;
  753. begin
  754.   Result := FList.Count
  755. end;
  756. procedure TNodeList.Insert(I: Integer; Node: TNode);
  757. begin
  758.   FList.Insert(I, Node)
  759. end;
  760. procedure TNodeList.Delete(I: Integer);
  761. begin
  762.   FList.Delete(I)
  763. end;
  764. procedure TNodeList.Add(node: TNode);
  765. begin
  766.   FList.Add(node)
  767. end;
  768. procedure TNodeList.Remove(node: TNode);
  769. begin
  770.   FList.Remove(node)
  771. end;
  772. function TNodeList.item(index: Integer): TNode;
  773. begin
  774.   if (index >= 0) and (index < length) then
  775.     Result := FList[index]
  776.   else
  777.     Result := nil
  778. end;
  779. procedure TNodeList.Clear(WithItems: Boolean);
  780. var
  781.   I: Integer;
  782. begin
  783.   if WithItems then
  784.   begin
  785.     for I := 0 to length - 1 do
  786.       item(I).Free
  787.   end;
  788.   FList.Clear
  789. end;
  790. constructor TSearchNodeList.Create(AOwnerNode: TNode; const namespaceURI, name: TDomString);
  791. begin
  792.   inherited Create(AOwnerNode);
  793.   FNamespaceParam := namespaceURI;
  794.   FNameParam := name;
  795.   Rebuild
  796. end;
  797. destructor TSearchNodeList.Destroy;
  798. begin
  799.   if Assigned(ownerNode) and Assigned(ownerNode.ownerDocument) then
  800.     ownerNode.ownerDocument.RemoveSearchNodeList(Self);
  801.   inherited Destroy
  802. end;
  803.                            
  804. function TSearchNodeList.GetLength: Integer;
  805. begin
  806.   if not FSynchronized then
  807.     Rebuild;
  808.   Result := inherited GetLength
  809. end;
  810. function TSearchNodeList.acceptNode(node: TNode): Boolean;
  811. begin
  812.   Result := (Node.nodeType = ELEMENT_NODE) and
  813.             ((FNamespaceParam = '*') or (FNamespaceParam = node.namespaceURI)) and
  814.             ((FNameParam = '*') or (FNameParam = node.localName))
  815. end;
  816. procedure TSearchNodeList.TraverseTree(rootNode: TNode);
  817. var
  818.   I: Integer;
  819. begin
  820.   if (rootNode <> ownerNode) and acceptNode(rootNode) then
  821.     Add(rootNode);
  822.   for I := 0 to rootNode.childNodes.length - 1 do
  823.     TraverseTree(rootNode.childNodes.item(I))
  824. end;
  825. procedure TSearchNodeList.Rebuild;
  826. begin
  827.   Clear(false);
  828.   if Assigned(ownerNode) and Assigned(ownerNode.ownerDocument) then
  829.   begin
  830.     TraverseTree(ownerNode);
  831.     ownerNode.ownerDocument.AddSearchNodeList(Self)
  832.   end;
  833.   Fsynchronized := true
  834. end;
  835.                            
  836. procedure TSearchNodeList.Invalidate;
  837. begin
  838.   FSynchronized := false
  839. end;
  840.  function TSearchNodeList.item(index: Integer): TNode;
  841. begin
  842.   if not FSynchronized then
  843.     Rebuild;
  844.   Result := inherited item(index)
  845. end;
  846. function TNamedNodeMap.getNamedItem(const name: TDomString): TNode;
  847. var
  848.   I: Integer;
  849. begin
  850.   for I := 0 to length - 1 do
  851.   begin
  852.     Result := item(I);
  853.     if Result.nodeName = name then
  854.       Exit
  855.   end;
  856.   Result := nil
  857. end;
  858. function TNamedNodeMap.setNamedItem(arg: TNode): TNode;
  859. var
  860.   Attr: TAttr;
  861. begin
  862.   if arg.ownerDocument <> Self.ownerNode.ownerDocument then
  863.     raise DomException(WRONG_DOCUMENT_ERR);
  864.   if arg.NodeType = ATTRIBUTE_NODE then
  865.   begin
  866.     Attr := arg as TAttr;
  867.     if Assigned(Attr.ownerElement) and (Attr.ownerElement <> ownerNode) then
  868.       raise DomException(INUSE_ATTRIBUTE_ERR)
  869.   end;
  870.   Result := getNamedItem(arg.nodeName);
  871.   if Assigned(Result) then
  872.     Remove(Result);
  873.   Add(arg)
  874. end;
  875. function TNamedNodeMap.removeNamedItem(const name: TDomString): TNode;
  876. var
  877.   Node: TNode;
  878. begin
  879.   Node := getNamedItem(name);
  880.   if Node = nil then
  881.     raise DomException.Create(NOT_FOUND_ERR);
  882.   Remove(Node);
  883.   Result := Node
  884. end;
  885. function TNamedNodeMap.getNamedItemNS(const namespaceURI, localName: TDomString): TNode;
  886. var
  887.   I: Integer;
  888. begin
  889.   for I := 0 to length - 1 do
  890.   begin
  891.     Result := item(I);
  892.     if (Result.localName = localName) and (Result.namespaceURI = namespaceURI) then
  893.       Exit
  894.   end;
  895.   Result := nil
  896. end;
  897. function TNamedNodeMap.setNamedItemNS(arg: TNode): TNode;
  898. var
  899.   Attr: TAttr;
  900. begin
  901.   if arg.ownerDocument <> Self.ownerNode.ownerDocument then
  902.     raise DomException(WRONG_DOCUMENT_ERR);
  903.   if arg.NodeType = ATTRIBUTE_NODE then
  904.   begin
  905.     Attr := arg as TAttr;
  906.     if Assigned(Attr.ownerElement) and (Attr.ownerElement <> ownerNode) then
  907.       raise DomException(INUSE_ATTRIBUTE_ERR)
  908.   end;
  909.   Result := getNamedItemNS(arg.namespaceURI, arg.localName);
  910.   if Assigned(Result) then
  911.     Remove(Result);
  912.   Add(arg)
  913. end;
  914. function TNamedNodeMap.removeNamedItemNS(const namespaceURI, localName: TDomString): TNode;
  915. var
  916.   Node: TNode;
  917. begin
  918.   Node := getNamedItemNS(namespaceURI, localName);
  919.   if Node = nil then
  920.     raise DomException.Create(NOT_FOUND_ERR);
  921.   Remove(Node);
  922.   Result := Node
  923. end;
  924. constructor TEntityReference.Create(ownerDocument: TDocument; const name: TDomString);
  925. begin
  926.   inherited Create(ownerDocument, '', name, false)
  927. end;
  928. function TEntityReference.GetNodeType: Integer;
  929. begin
  930.   Result := ENTITY_REFERENCE_NODE
  931. end;
  932.                             
  933. function TEntityReference.ExportNode(otherDocument: TDocument; deep: Boolean): TNode;
  934. begin
  935.   Result := otherDocument.createEntityReference(nodeName)
  936. end;
  937. function TEntityReference.cloneNode(deep: Boolean): TNode;
  938. begin
  939.   Result := ownerDocument.createEntityReference(nodeName)
  940. end;
  941. constructor TCharacterData.Create(ownerDocument: TDocument; const data: TDomString);
  942. begin
  943.   inherited Create(ownerDocument, '', '', false);
  944.   SetNodeValue(data)
  945. end;
  946. procedure TCharacterData.SetNodeValue(const value: TDomString);
  947. begin
  948.   FNodeValue := value
  949. end;
  950. function TCharacterData.GetLength: Integer;
  951. begin
  952.   Result := System.Length(FNodeValue)
  953. end;
  954. function TCharacterData.substringData(offset, count: Integer): TDomString;
  955. begin
  956.   if (offset < 0) or (offset >= length) or (count < 0) then
  957.     raise DomException(INDEX_SIZE_ERR);
  958.   Result := Copy(FNodeValue, offset + 1, count)
  959. end;
  960. procedure TCharacterData.appendData(const arg: TDomString);
  961. begin
  962.   FNodeValue := FNodeValue + arg
  963. end;
  964. procedure TCharacterData.insertData(offset: Integer; arg: TDomString);
  965. begin
  966.   replaceData(offset, 0, arg)
  967. end;
  968. procedure TCharacterData.deleteData(offset, count: Integer);
  969. begin
  970.   replaceData(offset, count, '')
  971. end;
  972. procedure TCharacterData.replaceData(offset, count: Integer; const arg: TDomString);
  973. begin                                  
  974.   if (offset < 0) or (offset >= length) or (count < 0) then
  975.     raise DomException(INDEX_SIZE_ERR);
  976.   FNodeValue := substringData(0, offset) + arg + substringData(offset + count, length - (offset + count))
  977. end;
  978. function TCDATASection.GetNodeName: TDomString;
  979. begin
  980.   Result := '#cdata-section'
  981. end;
  982. function TCDATASection.GetNodeType: Integer;
  983. begin
  984.   Result := CDATA_SECTION_NODE
  985. end;
  986.                       
  987. function TCDATASection.ExportNode(otherDocument: TDocument; deep: Boolean): TNode;
  988. begin
  989.   Result := otherDocument.createCDATASection(data)
  990. end;
  991. function TCDATASection.cloneNode(deep: Boolean): TNode;
  992. begin
  993.   Result := ownerDocument.createCDATASection(data)
  994. end;
  995. function TComment.GetNodeName: TDomString;
  996. begin
  997.   Result := '#comment'
  998. end;
  999. function TComment.GetNodeType: Integer;
  1000. begin
  1001.   Result := COMMENT_NODE
  1002. end;
  1003. function TComment.ExportNode(otherDocument: TDocument; deep: Boolean): TNode;
  1004. begin
  1005.   Result := otherDocument.createComment(data)
  1006. end;
  1007. function TComment.cloneNode(deep: Boolean): TNode;
  1008. begin
  1009.   Result := ownerDocument.createComment(data)
  1010. end;
  1011. function TTextNode.GetNodeName: TDomString;
  1012. begin
  1013.   Result := '#text'
  1014. end;
  1015. function TTextNode.GetNodeType: Integer;
  1016. begin
  1017.   Result := TEXT_NODE
  1018. end;
  1019.                   
  1020. function TTextNode.ExportNode(otherDocument: TDocument; deep: Boolean): TNode;
  1021. begin
  1022.   Result := otherDocument.CreateTextNode(data)
  1023. end;
  1024. function TTextNode.cloneNode(deep: Boolean): TNode;
  1025. begin
  1026.   Result := ownerDocument.CreateTextNode(data)
  1027. end;
  1028. function TTextNode.splitText(offset: Integer): TTextNode;
  1029. begin
  1030.   Result := ownerDocument.CreateTextNode(substringData(offset, length - offset));
  1031.   deleteData(offset, length - offset);
  1032.   if Assigned(parentNode) then
  1033.     insertBefore(Result, nextSibling)
  1034. end;
  1035. function TAttr.GetOwnerElement: TElement;
  1036. begin
  1037.   Result := FParentNode as TElement
  1038. end;
  1039. function TAttr.GetLength: Integer;
  1040. var
  1041.   Node: TNode;
  1042.   I: Integer;
  1043. begin
  1044.   Result := 0;
  1045.   for I := 0 to childNodes.length - 1 do
  1046.   begin
  1047.     Node := childNodes.item(I);
  1048.     if Node.nodeType = TEXT_NODE then
  1049.       Inc(Result, (Node as TTextNode).length)
  1050.     else
  1051.     if Node.nodeType = ENTITY_REFERENCE_NODE then
  1052.       Inc(Result)
  1053.   end
  1054. end;
  1055. function TAttr.GetNodeValue: TDomString;
  1056. var
  1057.   Node: TNode;
  1058.   Len, Pos, I, J: Integer;
  1059. begin
  1060.   Len := GetLength;
  1061.   SetLength(Result, Len);
  1062.   Pos := 0;
  1063.   for I := 0 to childNodes.length - 1 do
  1064.   begin
  1065.     Node := childNodes.item(I);
  1066.     if Node.nodeType = TEXT_NODE then
  1067.       for J := 1 to (Node as TTextNode).length do
  1068.       begin
  1069.         Inc(Pos);
  1070.         Result[Pos] := Node.FNodeValue[J]
  1071.       end
  1072.     else
  1073.     if Node.nodeType = ENTITY_REFERENCE_NODE then
  1074.     begin
  1075.       Inc(Pos);
  1076.       Result[Pos] := GetEntValue(Node.nodeName)
  1077.     end
  1078.   end
  1079. end;
  1080. function TAttr.GetNodeType: Integer;
  1081. begin
  1082.   Result := ATTRIBUTE_NODE
  1083. end;
  1084. procedure TAttr.SetNodeValue(const value: TDomString);
  1085. begin
  1086.   FChildNodes.Clear(false);
  1087.   appendChild(ownerDocument.CreateTextNode(value))
  1088. end;
  1089. function TAttr.GetParentNode: TNode;
  1090. begin
  1091.   Result := nil
  1092. end;
  1093.               
  1094. function TAttr.GetSpecified: Boolean;
  1095. begin
  1096.   Result := true
  1097. end;
  1098. function TAttr.CanInsert(node: TNode): Boolean;
  1099. begin
  1100.   Result := node.nodeType in [ENTITY_REFERENCE_NODE, TEXT_NODE]
  1101. end;
  1102.                         
  1103. function TAttr.ExportNode(ownerDocument: TDocument; deep: Boolean): TNode;
  1104. begin
  1105.   Result := ownerDocument.createAttribute(name);
  1106.   Result.CloneChildNodesFrom(Self)
  1107. end;
  1108. function TAttr.cloneNode(deep: Boolean): TNode;
  1109. begin
  1110.   Result := ownerDocument.createAttribute(name);
  1111.   Result.CloneChildNodesFrom(Self)
  1112. end;
  1113. constructor TElement.Create(ownerDocument: TDocument; const namespaceURI, qualifiedName: TDomString; withNS: Boolean);
  1114. begin
  1115.   inherited Create(ownerDocument, namespaceURI, qualifiedName, withNS);
  1116.   FAttributes := TNamedNodeMap.Create(Self)
  1117. end;
  1118. function TElement.GetNodeType: Integer;
  1119. begin
  1120.   Result := ELEMENT_NODE
  1121. end;
  1122. function TElement.CanInsert(node: TNode): Boolean;
  1123. begin
  1124.   Result := not (node.nodeType in [ENTITY_NODE, DOCUMENT_NODE, DOCUMENT_TYPE_NODE, NOTATION_NODE]);
  1125. end;
  1126. function TElement.ExportNode(otherDocument: TDocument; deep: Boolean): TNode;
  1127. begin
  1128.   Result := otherDocument.createElement(tagName);
  1129.   if deep then
  1130.     Result.CloneChildNodesFrom(Self)
  1131. end;
  1132. function TElement.cloneNode(deep: Boolean): TNode;
  1133. begin
  1134.   Result := ownerDocument.createElement(tagName);
  1135.   if deep then
  1136.     Result.CloneChildNodesFrom(Self)
  1137. end;
  1138. function TElement.getAttributeNode(const name: TDomString): TAttr;
  1139. begin
  1140.   Result := attributes.getNamedItem(name) as TAttr
  1141. end;
  1142. function TElement.getAttribute(const name: TDomString): TDomString;
  1143. var
  1144.   Attr: TAttr;
  1145. begin
  1146.   Attr := getAttributeNode(name);
  1147.   if Assigned(Attr) then
  1148.     Result := Attr.value
  1149.   else
  1150.     Result := ''
  1151. end;
  1152. procedure TElement.setAttribute(const name, value: TDomString);
  1153. var
  1154.   newAttr: TAttr;
  1155. begin
  1156.   newAttr := ownerDocument.createAttribute(name);
  1157.   newAttr.value := value;
  1158.   setAttributeNode(newAttr)
  1159. end;
  1160. function TElement.setAttributeNode(newAttr: TAttr): TAttr;
  1161. begin
  1162.   if Assigned(newAttr.ownerElement) then
  1163.     raise DomException.Create(INUSE_ATTRIBUTE_ERR);
  1164.   Result := attributes.setNamedItem(newAttr) as TAttr;
  1165.   if Assigned(Result) then
  1166.     Result.FParentNode := nil;
  1167.   newAttr.FParentNode := Self
  1168. end;
  1169. function TElement.removeAttributeNode(oldAttr: TAttr): TAttr;
  1170. begin
  1171.   if attributes.IndexOf(oldAttr) < 0 then
  1172.     raise DomException.Create(NOT_FOUND_ERR);
  1173.   attributes.Remove(oldAttr);
  1174.   oldAttr.FParentNode := nil;
  1175.   Result := oldAttr
  1176. end;
  1177. procedure TElement.removeAttribute(const name: TDomString);
  1178. begin
  1179.   attributes.removeNamedItem(name).Free
  1180. end;
  1181. function TElement.getAttributeNS(const namespaceURI, localName: TDomString): TDomString;
  1182. var
  1183.   Attr: TAttr;
  1184. begin
  1185.   Attr := getAttributeNodeNS(namespaceURI, localName);
  1186.   if Assigned(Attr) then
  1187.     Result := Attr.value
  1188.   else
  1189.     Result := ''
  1190. end;
  1191. procedure TElement.setAttributeNS(const namespaceURI, qualifiedName, value: TDomString);
  1192. var
  1193.   newAttr: TAttr;
  1194. begin
  1195.   newAttr := ownerDocument.createAttributeNS(namespaceURI, qualifiedName);
  1196.   newAttr.value := value;
  1197.   setAttributeNodeNS(newAttr)
  1198. end;
  1199. procedure TElement.removeAttributeNS(const namespaceURI, localName: TDomString);
  1200. begin
  1201.   attributes.removeNamedItemNS(namespaceURI, localName).Free
  1202. end;
  1203. function TElement.getAttributeNodeNS(const namespaceURI, localName: TDomString): TAttr;
  1204. begin
  1205.   Result := attributes.getNamedItemNS(namespaceURI, localName) as TAttr
  1206. end;
  1207. function TElement.setAttributeNodeNS(newAttr: TAttr): TAttr;
  1208. begin
  1209.   if Assigned(newAttr.ownerElement) then
  1210.     raise DomException.Create(INUSE_ATTRIBUTE_ERR);
  1211.   Result := attributes.setNamedItemNS(newAttr) as TAttr;
  1212.   if Assigned(Result) then
  1213.     Result.FParentNode := nil;
  1214.   newAttr.FParentNode := Self
  1215. end;
  1216. function TElement.hasAttribute(const name: TDomString): Boolean;
  1217. begin
  1218.   Result := Assigned(getAttributeNode(name))
  1219. end;
  1220. function TElement.hasAttributeNS(const namespaceURI, localName: TDomString): Boolean;
  1221. begin
  1222.   Result := Assigned(getAttributeNodeNS(namespaceURI, localName))
  1223. end;
  1224. constructor TDocumentType.Create(ownerDocument: TDocument; const name, publicId, systemId: TDomString);
  1225. begin
  1226.   inherited Create(ownerDocument, '', name, false);
  1227.   FPublicID := publicId;
  1228.   FSystemID := systemId
  1229. end;
  1230. function TDocumentType.GetNodeType: Integer;
  1231. begin
  1232.   Result := DOCUMENT_TYPE_NODE
  1233. end;
  1234. function TDocumentType.cloneNode(deep: Boolean): TNode;
  1235. begin
  1236.   Result := TDocumentType.Create(ownerDocument, name, publicId, systemId)
  1237. end;
  1238. constructor TDocumentFragment.Create(ownerDocument: TDocument);
  1239. begin
  1240.   inherited Create(ownerDocument, '', '', false)
  1241. end;
  1242. function TDocumentFragment.GetNodeType: Integer;
  1243. begin
  1244.   Result := DOCUMENT_FRAGMENT_NODE
  1245. end;
  1246. function TDocumentFragment.GetNodeName: TDomString;
  1247. begin
  1248.   Result := '#document-fragment'
  1249. end;
  1250. function TDocumentFragment.CanInsert(node: TNode): Boolean;
  1251. begin
  1252.   Result := not (node.nodeType in [ENTITY_NODE, DOCUMENT_NODE, DOCUMENT_TYPE_NODE, NOTATION_NODE]);
  1253. end;
  1254. function TDocumentFragment.ExportNode(otherDocument: TDocument; deep: Boolean): TNode;
  1255. begin
  1256.   Result := otherDocument.createDocumentFragment;
  1257.   if deep then
  1258.     Result.CloneChildNodesFrom(Self)
  1259. end;
  1260. function TDocumentFragment.cloneNode(deep: Boolean): TNode;
  1261. begin
  1262.   Result := ownerDocument.createDocumentFragment;
  1263.   if deep then
  1264.     Result.CloneChildNodesFrom(Self)
  1265. end;
  1266. constructor TDocument.Create(doctype: TDocumentType);
  1267. begin
  1268.   inherited Create(Self, '', '', false);
  1269.   FDocType := doctype;
  1270.   if Assigned(FDocType) then
  1271.     FDocType.FOwnerDocument := Self;
  1272.   FNamespaceURIList := TNamespaceURIList.Create;
  1273.   FSearchNodeLists := TList.Create;
  1274. end;
  1275. destructor TDocument.Destroy;
  1276. begin
  1277.   FDocType.Free;
  1278.   FNamespaceURIList.Free;
  1279.   FSearchNodeLists.Free;
  1280.   inherited Destroy
  1281. end;
  1282. procedure TDocument.SetDocType(value: TDocumentType);
  1283. begin
  1284.   if Assigned(FDocType) then
  1285.     FDocType.Free;
  1286.   FDocType := value
  1287. end;
  1288. function TDocument.GetDocumentElement: TElement;
  1289. var
  1290.   Child: TNode;
  1291.   I: Integer;
  1292. begin
  1293.   for I := 0 to childNodes.length - 1 do
  1294.   begin
  1295.     Child := childNodes.item(I);
  1296.     if Child.nodeType = ELEMENT_NODE then
  1297.     begin
  1298.       Result := Child as TElement;
  1299.       Exit
  1300.     end
  1301.   end;
  1302.   Result := nil
  1303. end;
  1304. function TDocument.GetNodeName: TDomString;
  1305. begin
  1306.   Result := '#document'
  1307. end;
  1308. function TDocument.GetNodeType: Integer;
  1309. begin
  1310.   Result := DOCUMENT_NODE
  1311. end;
  1312. procedure TDocument.Clear;
  1313. begin
  1314.   if Assigned(FDocType) then
  1315.   begin
  1316.     FDocType.Free;
  1317.     FDocType := nil
  1318.   end;
  1319.   FNamespaceURIList.Clear;
  1320.   FSearchNodeLists.Clear;
  1321.   FChildNodes.Clear(false)
  1322. end;
  1323. procedure TDocument.AddSearchNodeList(NodeList: TNodeList);
  1324. begin
  1325.   if FSearchNodeLists.IndexOf(NodeList) < 0 then
  1326.     FSearchNodeLists.Add(Nodelist)
  1327. end;
  1328. procedure TDocument.RemoveSearchNodeList(NodeList: TNodeList);
  1329. begin
  1330.   FSearchNodeLists.Remove(NodeList)
  1331. end;
  1332. procedure TDocument.InvalidateSearchNodeLists;
  1333. var
  1334.   I: Integer;
  1335. begin
  1336.   for I := 0 to FSearchNodeLists.Count - 1 do
  1337.     TSearchNodeList(FSearchNodeLists[I]).Invalidate
  1338. end;
  1339. function TDocument.createDocType(const name, publicId, systemId: TDomString): TDocumentType;
  1340. begin
  1341.   Result := TDocumentType.Create(Self, name, publicId, systemId)
  1342. end;
  1343. function TDocument.CanInsert(Node: TNode): Boolean;
  1344. begin
  1345.   Result := (node.nodeType in [TEXT_NODE, COMMENT_NODE, PROCESSING_INSTRUCTION_NODE]) or
  1346.             (node.nodeType = ELEMENT_NODE) and (documentElement = nil)
  1347. end;
  1348. function TDocument.cloneNode(deep: Boolean): TNode;
  1349. begin
  1350.   Result := DOMImplementation.createDocument(namespaceURI, documentElement.nodeName, doctype.cloneNode(false) as TDocumentType)
  1351. end;
  1352. function TDocument.createElement(const tagName: TDomString): TElement;
  1353. begin
  1354.   Result := TElement.Create(Self, '', tagName, false)
  1355. end;
  1356. function TDocument.createDocumentFragment: TDocumentFragment;
  1357. begin
  1358.   Result := TDocumentFragment.Create(Self)
  1359. end;
  1360. function TDocument.createTextNode(const data: TDomString): TTextNode;
  1361. begin
  1362.   Result := TTextNode.Create(Self, data)
  1363. end;
  1364. function TDocument.createComment(const data: TDomString): TComment;
  1365. begin
  1366.   Result := TComment.Create(Self, data)
  1367. end;
  1368. function TDocument.createCDATASection(const data: TDomString): TCDATASection;
  1369. begin
  1370.   Result := TCDATASection.Create(Self, data)
  1371. end;
  1372. function TDocument.createProcessingInstruction(const target, data: TDomString): TProcessingInstruction;
  1373. begin
  1374.   Result := TProcessingInstruction.Create(Self, target, data)
  1375. end;
  1376. function TDocument.createAttribute(const name: TDomString): TAttr;
  1377. begin
  1378.   Result := TAttr.Create(Self, '', name, false)
  1379. end;
  1380. function TDocument.createEntityReference(const name: TDomString): TEntityReference;
  1381. begin
  1382.   Result := TEntityReference.Create(Self, name)
  1383. end;
  1384.                                         
  1385. function TDocument.importNode(importedNode: TNode; deep: Boolean): TNode;
  1386. begin
  1387.   Result := importedNode.ExportNode(Self, deep)
  1388. end;
  1389. function TDocument.createElementNS(const namespaceURI, qualifiedName: TDomString): TElement;
  1390. begin
  1391.   Result := TElement.Create(Self, namespaceURI, qualifiedName, true)
  1392. end;
  1393. function TDocument.createAttributeNS(const namespaceURI, qualifiedName: TDomString): TAttr;
  1394. begin
  1395.   Result := TAttr.Create(Self, namespaceURI, qualifiedName, true)
  1396. end;
  1397. constructor TProcessingInstruction.Create(ownerDocument: TDocument; const target, data: TDomString);
  1398. begin
  1399.   inherited Create(ownerDocument, '', '', false);
  1400.   FNodeName := target;
  1401.   FNodeValue := data
  1402. end;
  1403. function TProcessingInstruction.GetTarget: TDomString;
  1404. begin
  1405.   Result := FNodeName
  1406. end;
  1407. function TProcessingInstruction.GetData: TDomString;
  1408. begin
  1409.   Result := FNodeValue
  1410. end;
  1411. procedure TProcessingInstruction.SetData(const value: TDomString);
  1412. begin
  1413.   FNodeValue := value
  1414. end;
  1415. function TProcessingInstruction.GetNodeType: Integer;
  1416. begin
  1417.   Result := PROCESSING_INSTRUCTION_NODE
  1418. end;
  1419. function TProcessingInstruction.ExportNode(otherDocument: TDocument; deep: Boolean): TNode;
  1420. begin
  1421.   Result := otherDocument.createProcessingInstruction(target, data)
  1422. end;
  1423. function TProcessingInstruction.cloneNode(deep: Boolean): TNode;
  1424. begin
  1425.   Result := ownerDocument.createProcessingInstruction(target, data)
  1426. end;
  1427. class function DOMImplementation.hasFeature(const feature, version: TDomString): Boolean;
  1428. begin
  1429.   Result := UpperCase(feature) = 'CORE'
  1430. end;
  1431. class function DOMImplementation.createDocumentType(const qualifiedName, publicId, systemId: TDomString): TDocumentType;
  1432. begin
  1433.   Result := TDocumentType.Create(nil, qualifiedName, publicId, systemId)
  1434. end;
  1435. class function DomImplementation.createHtmlDocumentType(htmlDocType: Integer): TDocumentType;
  1436. begin
  1437.   if htmlDocType in [DTD_HTML_STRICT..DTD_XHTML_FRAMESET] then
  1438.     with DTDList[htmlDocType] do
  1439.       Result := createDocumentType(HTML_TAG_NAME, publicId, systemId)
  1440.   else
  1441.     Result := nil
  1442. end;
  1443. class function DOMImplementation.createEmptyDocument(doctype: TDocumentType): TDocument;
  1444. begin
  1445.   if Assigned(doctype) and Assigned(doctype.ownerDocument) then
  1446.     raise DomException.Create(WRONG_DOCUMENT_ERR);
  1447.   Result := TDocument.Create(doctype)
  1448. end;
  1449. class function DOMImplementation.createDocument(const namespaceURI, qualifiedName: TDomString; doctype: TDocumentType): TDocument;
  1450. begin
  1451.   Result := createEmptyDocument(doctype);
  1452.   Result.appendChild(Result.createElementNS(namespaceURI, qualifiedName))
  1453. end;
  1454. end.