Salad UN

To Taste The Salad Of Life.

« Asp跨站共享ACCESS数据库和数据库链接优化KingCMS视频教程制作计划 »

ASP操作XML类

[ At 2008-9-23 By Ash   0 comments ]

寻找到一篇ASP操作XML的文章,对读取Blog的XML以后应该有所帮助,贴着备份。

<%
'Project:ASP操作XML(添加、修改、删除、查找、替换)
'-------------------------------------------使用说明--b
'----获取类的执行情况
'response.write xml.iserr_
'-----
'-----查找
'-----
'call xml.f_node("/blog/sorts/sort[id='2']/name")
'nodes=xml.count("/blog/sorts/sort[id='2']")
'nodes 返回数组( 0 同级节点数,1 子节点数,2子集)
'-----
'-----添加
'-----
'判断节点结构,指定true 则在不存在时新建。
'xml.checknode("/blog/b/c/e",true)
'根据xml.iserr_ 为True 则存在, 为False 则不存在
'将字符作为子节点,插入指定位置。
'call xml.joinxml("/blog/sorts","<sort><id>3</id><name>分类3</name><total>33</total></sort>")
'如果节点数 < 指定数  则删除first节点,然后在最后新加一个同级节点
'call xml.add_node("/blog/sorts/sort","<sort><id>3</id><name>分类3</name><total>33</total></sort>",3)

'-----
'-----修改
'-----
'将第一条件值替换成新值
'call xml.r_node("/blog/sorts/sort[id='2']/name","新值")
'将全部条件值替换成新值
'call xml.r_nodes("/blog/sorts/sort[id='2']/name","新值")
'将指点节点替换成新节点
'call xml.replace_node("/blog/sorts/sort[id='2']","<sort><id>新2</id><name>新分类2</name><total>新33</total></sort>")
'-----
'-----删除
'-----
'删除第一个符合条件的节点
'call xml.d_node("/blog/sorts/sort[id='3']")
'删除所有符合条件的节点()
'call xml.d_nodes("/blog/sorts/sort[id='2']")
'删除节点下的全部子节点
'call xml.d_nodes("/blog/sorts/sort[id='2']")
'-----
'-----清空
'-----
'清空第一个符合条件的节点
' xml.c_node("/blog/sorts/sort[id='2']")
'清空全部符合条件的节点
' xml.c_nodes("/blog/sorts/sort[id='2']")
'-------------------------------------------使用说明--E
dim xmlfile,xml
Class QT_XML_Class
        'Projict        :        ASP操作XML

        private dom,dom2,xmlpath,doc
        Public iserr_
        '初始化类
        Private Sub Class_Initialize()
                Set dom = Server.CreateObject("Microsoft.FreeThreadedXMLDOM")
                xmlpath = Server.MapPath(xmlfile)
                If not dom.Load(xmlpath) Then
                        SaveToFile "<?xml version=""1.0"" encoding=""utf-8""?>"&vbcrlf&"<blog>"&vbcrlf&"<sorts>"&vbcrlf&"</sorts>"&vbcrlf&"<blogs>"&vbcrlf&"</blogs>"&vbcrlf&"<re>"&vbcrlf&"</re>"&vbcrlf&"</blog>",xmlpath
                        dom.Load(xmlpath)
                End If
        end Sub
        '类结束
        Private Sub Class_Terminate       
                If IsObject(dom) Then Set dom = Nothing
                If IsObject(dom2) Then Set dom2 = Nothing
                If IsObject(doc) Then Set doc = Nothing
        End Sub
        '生成XML文件
        Private Function SaveToFile(ByVal strBody,ByVal SavePath)
                dim ado
                Set ado = Server.CreateObject("ADODB.Stream")
                ado.Open
                ado.Type = 2
                ado.charset = "utf-8"
                ado.WriteText strBody
                ado.SaveToFile SavePath,2
                ado.Close
                Set ado = Nothing
        End Function
        '删除第一个符合条件的节点
        function d_node(node)
                Set dom2 = Server.CreateObject("Microsoft.FreeThreadedXMLDOM")
                dom2.Load(xmlpath)
                iserr_=False
                set doc=dom2.documentElement.selectSingleNode(node)
                if not doc is nothing then
                        doc.parentNode.removeChild(doc)
                        dom2.save(xmlpath)
                        iserr_=True
                end if
                set dom2=nothing
                set doc=nothing
        End Function
        '删除所有符合条件的节点
        function d_nodes(node)
                dim i
                iserr_=False
                set doc=dom.selectNodes(node)
                if not doc is nothing then
                        for i=0 to doc.length-1
                                doc.item(i).parentNode.removeChild(doc.item(i))
                        next
                        iserr_=True
                end if
                dom.save(xmlpath)
                set doc=nothing
        End Function
        '清空第一个条件节点
        function c_node(node)
                iserr_=False
                set doc=dom.documentElement.selectSingleNode(node)
                if not doc is nothing then
                        doc.text=""
                        dom.Save(xmlpath)
                        iserr_=True
                end if
                set doc=nothing
        end function
        '清空节点
        function c_nodes(node)
                dim i
                iserr_=False
                set doc=dom.selectNodes(node)
                if not doc is nothing then
                        for i=0 to doc.length-1
                                doc.item(i).text=""
                        next
                        dom.Save(xmlpath)
                        iserr_=True
                end if
                set doc=nothing
        end function


        '检测节点是否存在,不存在则新建
        function checknode(nodes,build)
                dim doc2,doc3
                dim i,f_node_,n_node,newnode
                iserr_=True
                Set doc = dom.documentElement.selectSingleNode(nodes)
                if doc is nothing then
                        iserr_=False
                        if build then
                                nodes=split(nodes,"/")
                                f_node_=""
                                n_node=""
                                for i=0 to ubound(nodes)-1
                                        if nodes(i)="" then
                                                f_node_=f_node_&nodes(i)
                                                f_node_=f_node_&"/"
                                                n_node=f_node_&nodes(i+1)
                                        else
                                                f_node_=n_node
                                                n_node=f_node_&"/"&nodes(i+1)
                                        end if
                                        Set doc2 = dom.documentElement.selectSingleNode(f_node_)
                                        set doc3 = dom.documentElement.selectSingleNode(n_node)
                                        if doc3 is nothing then
                                                Set newnode = dom.createElement(nodes(i+1))
                                                newnode.Text=""
                                                doc2.AppendChild(newnode)
                                                Set newnode=nothing
                                        end if
                                        set doc2=nothing
                                        set doc3=nothing
                                next
                                dom.Save(xmlpath)
                        end if
                end if
                set doc=nothing
        End Function

        '将指点字符串作为子节点,插入到指定节点子集的末尾
        function joinxml(inset_node,xmlstr)
                dim oldxml,newxml,rootNewNode
                iserr_=False
                Set oldXML = Server.CreateObject("Microsoft.XMLDOM")
                oldXML.load(xmlpath)
                set doc=oldxml.documentElement.selectSingleNode(inset_node)
                if not doc is nothing then
                        iserr_=True
                        Set newXML = Server.CreateObject("Microsoft.XMLDOM")
                        newXML.loadXML(xmlstr&vbcrlf)
                        set rootNewNode=newXML.documentElement
                        doc.appendChild(rootNewNode)
                        oldxml.Save(xmlpath)
                end if
                set oldXML=nothing
                set newXML=nothing
                set doc=nothing
        End Function

        '替换第一个条件值
        function r_node(node,newstr)
                iserr_=False
                set doc=dom.documentElement.selectSingleNode(node)
                if not doc is nothing then
                        doc.text=newstr
                        iserr_=True
                end if
                set doc=nothing
                dom.Save(xmlpath)
        End Function
        '替换全部条件值
        function r_nodes(node,newstr)
                dim i
                iserr_=False
                set doc=dom.selectNodes(node)
                if not doc is nothing then
                        for i=0 to doc.length-1
                                doc.item(i).text=newstr
                        next
                        iserr_=True
                end if
                set doc=nothing
                dom.Save(xmlpath)
        End Function
        '替换整个节点
        '--假替换。实际上是先删除旧的,再添加新的。
        function replace_node(node,newstr)
                call add_node(node,newstr,0)
        End Function
        '如果子节点数 < num  则删除掉的,然后 新加一个子节点
        function add_node(node,newstr,num)
                set doc=dom.selectNodes(node)
                if not doc is nothing then
                        if doc.length >=num then
                                call d_node(node)
                        end if
                end if
                set doc=nothing
                call joinxml(left(node,instrrev(node,"/")-1),newstr)
        End Function
        '查找节点
        function f_node(node)
                dim getnode
                node=replace(node,"\","\\")
                set doc=dom.documentElement.selectSingleNode(node)
                if not doc is nothing then
                        iserr_=True
                        getnode=doc.Text
                else
                        getnode=""
                        iserr_=False
                end if
                set doc=nothing
                f_node=getnode
        end function
        '统计节点
        function count(node)
                dim nodenum
                nodenum=array(0,0,"")'(同级节点数,子节点数)
                iserr_=False
                set doc=dom.selectNodes(node)
                if not doc is nothing then
                        nodenum(0)=doc.length
                        nodenum(2)=doc.item(0).xml
                        if doc.item(0).hasChildNodes() then
                                nodenum(1)=doc.item(0).childNodes.length
                        end if
                        iserr_=True
                end if
                count=nodenum
        end function
end class
%>

发表评论:

◎欢迎参与讨论,请在这里发表您的看法、交流您的观点。

日历

最新评论及回复

最近发表

Powered By Z-Blog 1.8 Spirit Build 80722 Code detection by Codefense

Copyright 2008 www.s-un.cn. Some Rights Reserved.