<%
Author :Qtian
Date :2007-05
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","3分类333")
'如果节点数 < 指定数 则删除first节点,然后在最后新加一个同级节点
'call xml.add_node("/blog/sorts/sort","3分类333",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']","新2新分类2新33")
'-----
'-----删除
'-----
'删除第一个符合条件的节点
'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
'Author : Missde
'Link : www.missde.cn
'Date : 15:25 2007-5-29
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 ""&vbcrlf&""&vbcrlf&""&vbcrlf&""&vbcrlf&""&vbcrlf&""&vbcrlf&""&vbcrlf&""&vbcrlf&"",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
%>