IDC资讯中心
<%
class xmldomdocument
private fnode,fanode
private ferrinfo,ffilename,fopen
dim xmldom
返回节点的缩进字串
private property get tabstr(byval node)
tabstr=""
if node is nothing then exit property
if not node.parentnode is nothing then tabstr=" "&tabstr(node.parentnode)
end property
返回一个子节点对象,elementobj为父节点,childnodeobj要查找的节点,isattributenode指出是否为属性对象
public property get childnode(byval elementobj,byval childnodeobj,byval isattributenode)
dim element
set childnode=nothing
if isnull(childnodeobj) then
if isattributenode=false then
set childnode=fnode
else
set childnode=fanode
end if
exit property
elseif isobject(childnodeobj) then
set childnode=childnodeobj
exit property
end if
set element=nothing
if lcase(typename(childnodeobj))="string" and trim(childnodeobj)<>"" then
if isnull(elementobj) then
set element=fnode
elseif lcase(typename(elementobj))="string" then
if trim(elementobj)<>"" then
set element=xmldom.selectsinglenode("//"&trim(elementobj))
if lcase(element.nodetypestring)="attribute" then set element=element.selectsinglenode("..")
end if
elseif isobject(elementobj) then
set element=elementobj
end if
if element is nothing then
set childnode=xmldom.selectsinglenode("//"&trim(childnodeobj))
elseif isattributenode=true then
set childnode=element.selectsinglenode("./@"&trim(childnodeobj))
else
set childnode=element.selectsinglenode("./"&trim(childnodeobj))
end if
end if
end property
读取最后的错误信息
public property get errinfo
errinfo=ferrinfo
end property
给xml内容
public property get xmltext(byval elementobj)
xmltext=""
if fopen=false then exit property
set elementobj=childnode(xmldom,elementobj,false)
if elementobj is nothing then set elementobj=xmldom
xmltext=elementobj.xml
end property
=================================================================
类初始化
private sub class_initialize()
set xmldom=createobject("microsoft.xmldom")
xmldom.preservewhitespace=true
set fnode=nothing
set fanode=nothing
ferrinfo=""
ffilename=""
fopen=false
end sub
类释放
private sub class_terminate()
set fnode=nothing
set fanode=nothing
set xmldom=nothing
fopen=false
end sub
=====================================================================
建立一个xml文件，rootelementname：根结点名。xslurl：使用xsl样式地址
返回根结点
function create(byval rootelementname,byval xslurl)
dim pinode,rootelement
set create=nothing
if (xmldom is nothing) or (fopen=true) then exit function
if trim(rootelementname)="" then rootelementname="root"
set pinode=xmldom.createprocessinginstruction("xml", "version=""1.0"" encoding=""gb2312""")
xmldom.appendchild pinode
set pinode=xmldom.createprocessinginstruction("xml-stylesheet", "type=""text/xsl"" href="""&xslurl&"""")
xmldom.appendchild pinode
set rootelement=xmldom.createelement(trim(rootelementname))
xmldom.appendchild rootelement
set create=rootelement
fopen=true
set fnode=rootelement
end function
开打一个已经存在的xml文件,返回打开状态
function open(byval xmlsourcefile)
open=false
xmlsourcefile=trim(xmlsourcefile)
if xmlsourcefile="" then exit function
xmldom.async = false
xmldom.load xmlsourcefile
ffilename=xmlsourcefile
if not iserror then
open=true
fopen=true
end if
end function
关闭
sub close()
set fnode=nothing
set fanode=nothing
ferrinfo=""
ffilename=""
fopen=false
end sub
读取一个nodeobj的节点text的值
nodeobj可以是节点对象或节点名，为null就取当前默认fnode
function getnodetext(byval nodeobj)
getnodetext=""
if fopen=false then exit function
set nodeobj=childnode(null,nodeobj,false)
if nodeobj is nothing then exit function
if lcase(nodeobj.nodetypestring)="element" then
set fnode=nodeobj
else
set fanode=nodeobj
end if
getnodetext=nodeobj.text
end function
插入在befelementobj下面一个名为elementname，value为elementtext的子节点。
isfirst：是否插在第一个位置；iscdata：说明节点的值是否属于cdata类型
插入成功就返回新插入这个节点
befelementobj可以是对象也可以是节点名，为null就取当前默认对象
function insertelement(byval befelementobj,byval elementname,byval elementtext,byval isfirst,byval iscdata)
dim element,textsection,spacestr
set insertelement=nothing
if not fopen then exit function
set befelementobj=childnode(xmldom,befelementobj,false)
if befelementobj is nothing then exit function
set element=xmldom.createelement(trim(elementname))
spacestr=vbcrlf&tabstr(befelementobj)
set stabstr=xmldom.createtextnode(spacestr)
if len(spacestr)>2 then spacestr=left(spacestr,len(spacestr)-2)
set etabstr=xmldom.createtextnode(spacestr)
if isfirst=true then
befelementobj.insertbefore etabstr,befelementobj.firstchild
befelementobj.insertbefore element,befelementobj.firstchild
befelementobj.insertbefore stabstr,befelementobj.firstchild
else
befelementobj.appendchild stabstr
befelementobj.appendchild element
befelementobj.appendchild etabstr
end if
if iscdata=true then
set textsection=xmldom.createcdatasection(elementtext)
element.appendchild textsection
elseif elementtext<>"" then
element.text=elementtext
end if
set insertelement=element
set fnode=element
end function
在elementobj节点上插入或修改名为attributename，值为：attributetext的属性
如果已经存在名为attributename的属性对象，就进行修改。
返回插入或修改属性的node
elementobj可以是element对象或名，为null就取当前默认对象
function setattributenode(byval elementobj,byval attributename,byval attributetext)
dim attributenode
set setattributenode=nothing
if not fopen then exit function
set elementobj=childnode(xmldom,elementobj,false)
if elementobj is nothing then exit function
set attributenode=elementobj.attributes.getnameditem(attributename)
if attributenode is nothing then
set attributenode=xmldom.createattribute(attributename)
elementobj.setattributenode attributenode
end if
attributenode.text=attributetext
set fnode=elementobj
set fanode=attributenode
set setattributenode=attributenode
end function
修改elementobj节点的text值，并返回这个节点
elementobj可以对象或对象名，为null就取当前默认对象
function updatenodetext(byval elementobj,byval newelementtext,byval iscdata)
dim textsection
set updatenodetext=nothing
if not fopen then exit function
set elementobj=childnode(xmldom,elementobj,false)
if elementobj is nothing then exit function
if iscdata=true then
set textsection=xmldom.createcdatasection(newelementtext)
if elementobj.firstchild is nothing then
elementobj.appendchild textsection
elseif lcase(elementobj.firstchild.nodetypestring)="cdatasection" then
elementobj.replacechild textsection,elementobj.firstchild
end if
else
elementobj.text=newelementtext
end if
set fnode=elementobj
set updatenodetext=elementobj
end function
返回符合testvalue条件的第一个elementnode，为null就取当前默认对象
function getelementnode(byval elementname,byval testvalue)
dim element,regex,basename
set getelementnode=nothing
if not fopen then exit function
testvalue=trim(testvalue)
set regex=new regexp
regex.pattern="^[a-za-z]+"
regex.ignorecase=true
if regex.test(testvalue) then testvalue="/"&testvalue
set regex=nothing
basename=lcase(right(elementname,len(elementname)-instrrev(elementname,"/",-1)))
set element=xmldom.selectsinglenode("//"&elementname&testvalue)
if element is nothing then
response.write elementname&testvalue
set getelementnode=nothing
exit function
end if
do while lcase(element.basename)<>basename
set element=element.selectsinglenode("..")
if element is nothing then exit do
loop
if lcase(element.basename)<>basename then
set getelementnode=nothing
else
set getelementnode=element
if lcase(element.nodetypestring)="element" then
set fnode=element
else
set fanode=element
end if
end if
end function
删除一个子节点
function removechild(byval elementobj)
removechild=false
if not fopen then exit function
set elementobj=childnode(null,elementobj,false)
if elementobj is nothing then exit function
response.write elementobj.basename
if lcase(elementobj.nodetypestring)="element" then
if elementobj is fnode then set fnode=nothing
if elementobj.parentnode is nothing then
xmldom.removechild(elementobj)
else
elementobj.parentnode.removechild(elementobj)
end if
removechild=true
end if
end function
清空一个节点所有子节点
function clearnode(byval elementobj)
set clearnode=nothing
if not fopen then exit function
set elementobj=childnode(null,elementobj,false)
if elementobj is nothing then exit function
elementobj.text=""
elementobj.removechild(elementobj.firstchild)
set clearnode=elementobj
set fnode=elementobj
end function
删除子节点的一个属性
function removeattributenode(byval elementobj,byval attributeobj)
removeattributenode=false
if not fopen then exit function
set elementobj=childnode(xmldom,elementobj,false)
if elementobj is nothing then exit function
set attributeobj=childnode(elementobj,attributeobj,true)
if not attributeobj is nothing then
elementobj.removeattributenode(attributeobj)
removeattributenode=true
end if
end function
保存打开过的文件，只要保证filename不为空就可以实现保存
function save()
on error resume next
save=false
if (not fopen) or (ffilename="") then exit function
xmldom.save ffilename
save=(not iserror)
if err.number<>0 then
err.clear
save=false
end if
end function
另存为xml文件，只要保证filename不为空就可以实现保存
function saveas(savefilename)
on error resume next
saveas=false
if (not fopen) or savefilename="" then exit function
xmldom.save savefilename
saveas=(not iserror)
if err.number<>0 then
err.clear
saveas=false
end if
end function
检查并打印错误信息
private function iserror()
if xmldom.parseerror.errorcode<>0 then
ferrinfo="<h1>error"&xmldom.parseerror.errorcode&"</h1>"
ferrinfo=ferrinfo&"<b>reason :</b>"&xmldom.parseerror.reason&"<br>"
ferrinfo=ferrinfo&"<b>url :</b>"&xmldom.parseerror.url&"<br>"
ferrinfo=ferrinfo&"<b>line :</b>"&xmldom.parseerror.line&"<br>"
ferrinfo=ferrinfo&"<b>filepos:</b>"&xmldom.parseerror.filepos&"<br>"
ferrinfo=ferrinfo&"<b>srctext:</b>"&xmldom.parseerror.srctext&"<br>"
iserror=true
else
iserror=false
end if
end function
end class
%>
