ASP中查询数据库记录写入XML文件示例

把下面代码保存为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


%>