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

把下面代码保存为Asp_XML.asp运行即可:

< %
' By Dicky 2005-03-22 21:52:18 AM QQ:25941 E-mail:[email protected]
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
% >