把下面代码保存为Asp_XML.asp运行即可:
<%
'By Dicky 2005-03-22 21:52:18 AM QQ:25941 E-mail:AppleBBS@GMail.Com
Const IsSql = 1 '定义数据库类型为SQL Server
Call OpenConn(Conn) '打开数据库连接
Dim Rs,Sql
Set Rs = Server.CreateObject('ADODB.RecordSet')
Sql = 'SELECT * FROM Products ORDER BY ProductName'
Rs.Open Sql,Conn,1,1 '以只读方式查询数据记录
If Rs.Eof Then
Response.Write 'Sorry,no record!' '如果没有记录
Else
Dim objXMLDOM, objRootNode, objNode
Set objXMLDOM = Server.CreateObject('MSXML2.DOMDocument') '创建XML文档对象
Set objRootNode = objXMLDOM.createElement('xml') '创建根节点
objXMLDOM.documentElement = objRootNode
Do While Not Rs.Eof '循环出所有记录
' Response.Write Rs('ProductName') &'<br>'
Set objRowNode = objXMLDOM.createElement('row') '创建父节点
Set objNode = objXMLDOM.createElement('ProductName') '创建子节点
objNode.text = Rs('ProductName')
objRowNode.appendChild(objNode)
Set objNode = objXMLDOM.createElement('UnitPrice')
objNode.text = Rs('UnitPrice')
objRowNode.appendChild(objNode)
Set objNode = objXMLDOM.createElement('UnitsInStock')
objNode.text = Rs('UnitsInStock')
objRowNode.appendChild(objNode)
objRootNode.appendChild(objRowNode)
Rs.MoveNext:Loop '循环结束
objXMLDOM.Save 'D:\MyXMLDoc.xml' '写入XML文件 可以用变量让用户在页面上自定义文件名
Response.Write '<script>alert('恭喜，写入XML文件成功！');</script>'
Set objNode = Nothing '销毁对象
Set objRowNode = Nothing '销毁对象
Set objRootNode = Nothing '销毁对象
End If
Rs.Close
Set Rs = Nothing
Call CloseConn() '关闭数据库连接
Function OpenConn(Conn) '打开数据库连接
Dim ConnStr
If IsSql = 1 Then '如果是SQL Server数据库
'SQL Server数据库连接参数:用户名、用户密码、数据库名、连接名（本地用local，外地用IP）
Dim SqlUsername,SqlPassword,SqlDatabaseName,SqlLocalName
SqlUsername = 'sa'
SqlPassword = ''
SqlDatabaseName = 'Northwind'
SqlLocalName = '(local)'
ConnStr = 'Provider = Sqloledb; User ID = ' & SqlUsername & '; Password = ' & SqlPassword & '; Initial Catalog = ' & SqlDatabaseName & '; Data Source = ' & SqlLocalName & ';'
Else '如果是Access数据库
Dim Db
'第一次使用请修改本处数据库地址并相应修改数据库名称，如将Dicky.mdb修改为Dicky.asp(防止恶意下载Access数据库)
Db = 'Dicky.mdb'
ConnStr = 'Provider = Microsoft.Jet.OLEDB.4.0;Data Source = ' & Server.MapPath(Db)
End If
On Error Resume Next
Set Conn = Server.CreateObject('ADODB.Connection')
Conn.Open ConnStr
If Err Then
' Err.Clear
Set Conn = Nothing
Response.Write '数据库连接出错，请检查连接字串。'
Response.End
End If
Set Rs = Server.CreateObject('Adodb.RecordSet')
End Function
Function CloseConn() '关闭数据库连接
Conn.Close
Set Conn = Nothing
End Function
%>
免责声明：本文为网络用户发布，其观点仅代表作者个人观点，与本站无关，本站仅提供信息存储服务。文中陈述内容未经本站证实，其真实性、完整性、及时性本站不作任何保证或承诺，请读者仅作参考，并请自行核实相关内容。
