set doc = CreateObject("Microsoft.XMLDOM") doc.async=False sub analyse() dim myTR favour = select1.value removeDIV if not doc.load(file1.value) then alert "文件加载失败,请检查文件是否存在!" else Set rootNode = doc.DocumentElement set rootDIV = document.createElement("DIV") rootDIV.setAttribute "XPath",rootNode.nodeName oList.setAttribute "XPath",rootNode.nodeName oList.setAttribute "parsed",false appendDIV oList,rootNode
end if end sub
sub appendDIV(myDIV,myNode)
dim myChild ,newDIV,ChildID,thisID ,ChildXPath
for each myChild in myNode.childNodes
if myChild.nodeName > "#text" then set newDIV = document.createElement("DIV") myDIV.appendChild newDIV addPx newDIV, myDIV,10 '缩进10象素
do while not doc.selectSingleNode(ChildXPath) is myChild ChildID=ChildID+1 ChildXPath = myDIV.getAttribute("XPath") "/" myChild.nodeName "[" ChildID "]" loop
newDIV.attachEvent "onclick",GetRef("attachOnclick") end if end if next myDIV.setAttribute "parsed",true'所有子元素都标记过了。 end sub
sub removeDIV() dim oldDIV for each oldDIV in oList.childNodes oldDIV.removeNode(true) next end sub
sub attachOnclick() dim obj ,nodeXPath,cDIV set obj=window.event.srcElement nodeXPath = obj.getAttribute("XPath") if instr(nodeXPath,"#text") >0 then window.event.cancelBubble = true exit sub end if if not obj.getAttribute("parsed")= true then appendDIV obj ,doc.selectSingleNode(nodeXPath) else for each cDIV in obj.children if cDIV.style.display = "none" then cDIV.style.display = "" else cDIV.style.display = "none" end if next end if window.event.cancelBubble = true end sub
function getText(myNode,oDIV) dim myAttribute getText = "" select case favour case "text" if not isnull(myNode.text) then getText = myNode.text else getText = "空文字" end if case "nodeName" getText = myNode.nodeName case "attribute" if myNode.nodeName >"#text" then for each myAttribute in myNode.attributes getText =getText myAttribute.name getText = getText "=" chr(34) getText = getText myAttribute.value chr(34) " " next getText = trim(getText) end if
case "XPath" getText = oDIV.title end select if trim(getText) ="" then getText ="空" end function
sub addPx(newDIV,oldDIV,num) dim re,myString set re = new RegExp re.Global = true re.Pattern = "[^\d]*" myString = re.Replace(oldDIV.style.paddingLeft, "") if myString ="" then myString = "0" myString = (cint(myString) + num ) "px" newDIV.style.paddingLeft = myString set re = nothing end sub /script> /html> XMLTool.hta