hta实现的笨狼树状节点查看器

所属分类: 脚本专栏 / hta 阅读数: 1453
收藏 0 赞 0 分享
<html>
<head>
<style>
table
{
    border-collapse: collapse;
    border-width: 4; 
    border-style: double; 
    border-color:#15336F;
    font-size:12px;
}
body
{
    font-size:12px;
}
div
{
    width:100%;
    height:9; 
    border-style:solid; 
    border-width:1; 
    border-color:#eeeeee;    
    vertical-align:top;
    font-size:12;
    cursor:hand;
}
</style>
<title>笨狼树状节点查看器</title>
</head>
<body>
 <INPUT type="file" id=file1 name=file1>请输入xml文件路径
 <INPUT type="button" value="确定" onclick = "vbs:analyse ">
 <SELECT id="select1" onchange="vbs:analyse">
        <OPTION value="nodeName" >显示标签</OPTION>
        <OPTION  value="text" >显示文字</OPTION>
        <OPTION  value="attribute" >显示属性</OPTION>

        <OPTION  value="XPath" >显示XPath</OPTION>
</SELECT>
<DIV id="oList" style="padding-left:0"></DIV>

</body>
 <script language="vbScript" >
    '**************************************
    '****作者:    超级大笨狼 superdullwolf****
    '**************************************        

        public dic,favour,anything    ,doc      

        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象素

                ChildID = 0
                ChildXPath = myDIV.getAttribute("XPath") & "/" & myChild.nodeName & "[" & ChildID & "]"    

                do while not doc.selectSingleNode(ChildXPath) is myChild
                    ChildID=ChildID+1
                    ChildXPath = myDIV.getAttribute("XPath") & "/" & myChild.nodeName & "[" & ChildID & "]"    
                loop

                newDIV.setAttribute "XPath",ChildXPath 
                newDIV.setAttribute "parsed",false    '子元素还没标记过了。

                newDIV.title = newDIV.getAttribute("XPath") 
                newDIV.innerText = getText(myChild,newDIV) 

                if myChild.childNodes.length>0 then 

                        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
更多精彩内容其他人还在看

hta实现的笨狼XSLT练习器

学习XSLT的朋友,用这个小工具不错
收藏 0 赞 0 分享

hta实现的笨狼树状节点查看器

笨狼树状节点查看器
收藏 0 赞 0 分享

hta作品笨狼CSDN爬虫

笨狼CSDN爬虫
收藏 0 赞 0 分享

hta(vbs)列目录树代码

一个网友在短消息里问我这个问题,并给出了他写的出错代码。短消息有字数限制,在此回复他一下。玩了两个月,没有写代码了,脑子不好用了。费了好大劲,最后还是请教了老马才把网友的代码更写出来,几乎是重写了,呵呵。
收藏 0 赞 0 分享

适用于hta的Sleep函数

找到一个适用于 hta 的 Sleep 函数
收藏 0 赞 0 分享

hta 定时关机重启实现代码

一个用于定时重启或关闭计算机的小工具,适用于Windows 2K/XP/2003
收藏 0 赞 0 分享

从 HTA 中启动应用程序

如何从 HTA 中启动应用程序
收藏 0 赞 0 分享

ASP 辅助工具(hta版)

当我们使用asp的一些字段获取功能的时候,这个功能就非常有用了。
收藏 0 赞 0 分享

hta编写的软件管理工具0.1(IE7.0测试通过)

程序初始化是建立与本文件同名后缀为mdb的数据库
收藏 0 赞 0 分享

exe转换16进制的html保存的hta实现代码

用下面这个hta文件来转exe变成16进制的html保存了。这样也会方便一点。
收藏 0 赞 0 分享
查看更多