把下面代碼儲存為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
%>
