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

%

>