<%
function wawa_recordxml(sql)
'*************************
'功能:把recordset转换成xml格式的字符串
'返回值:字符串
'参数:sql(字符串)
'提供者:蛙蛙王子(天极论坛)
'*************************
Dim Rs,strxml
strxml=""
strxml=strxml&"<?xml version='1.0' encoding='gb2312'?>"&vbcrlf
strxml=strxml&"<wawa>"
Set Rs= Server.CreateObject("Adodb.RecordSet")
Rs.Open sql,Conn,1,1
If Not(Rs.Eof And Rs.Bof) Then
 Do While Not Rs.Eof
  dim i
  For i = 0 To rs.Fields.Count - 1
   strxml=strxml&" <"&rs.Fields(i).Name&">"&wawa_xml_text(rs.Fields(i).Value)&"</"&rs.Fields(i).Name&">"&vbcrlf
  Next
  Rs.MoveNext
 Loop
 strxml=strxml&"</wawa>"
wawa_recordxml=strxml
Else
End If
rs.close
set rs=nothing
end function
%>
<%
function wawa_createxml(strXML)
'*************************
'功能:把符合xml格式的字符串写在服务器的一个目录上
'返回值:无
'参数:strxml(字符串)
'提供者:蛙蛙王子(天极论坛)
'*************************
dim objXML,fs,dir,files,path
Set fs = CreateObject("Scripting.FileSystemObject")
dir=server.mappath("xml")
if (fs.FolderExists(dir)) then
else
 fs.CreateFolder(dir)
end if
files="wawa.xml"
path=dir&"\"&files
set fs=nothing

Set objXML = Server.CreateObject("Msxml2.DOMDocument")
objXML.validateonparse = true
objXML.async=false
objXML.loadXML(strXML)
if objXML.ParseError.errorCode <> 0 then
    Response.Write("Error: " & objXML.parseError.reason & "<br>")
    Response.Write("Code: 0x" & hex(objXML.parseError.errorCode) & "<br>")
    Response.Write("At Line: " & objXML.parseError.line & "<br>")
    Response.Write("At pos: " & objXML.parseError.linePos & "<br>")
               
else
    set objRootElement = objXML.documentElement
    if not isObject(objRootElement) then
        Response.Write("no file loaded")
    else
        Response.Write(strXML)
  objXML.save Path
    end if
end if
end function
%>
<%
Function wawa_xml_text(fString)
'*************************
'功能:把一些特殊字符替换成转换符,以便让XML的TEXT节点合法
'返回值:字符串
'参数:fstring(字符串)
'提供者:蛙蛙王子(天极论坛)
'*************************
    if fString<>"" then
       fstring=cstr(fstring)
   fString = Replace(fString, "&","&amp;")
            fString = Replace(fString, "<","&lt;")
            fString = Replace(fString, ">","&gt;")
            fString = Replace(fString, CHR(34), "&quot;") '双引号
            fString = Replace(fString, CHR(39), "&#39;")  '单引号
            wawa_xml_text = fString
    end if
End Function
%>
<!-- 使用方法如下:conn.asp文件自己写就可以了,但数据库连接对象实例的名字必须是conn,然后把上面的三个函数保存为一个vbsxml.asp
 并包含进来,然后就是写自己所需要的sql字符串并调用函数了,函数里可能会有一些小BUG,比如说rs.field.name里面"xml",生成的XML
 文件就不合法了,时间太短,不写了,这些BUG由自己去保证不出错吧,呵呵
-->

<!--#include file="conn.asp" -->
<!--#include file="vbsxml.asp" -->
<%
'Response.ContentType = "text/XML"
'sql="SELECT lei_id as 编号 ,lei_name as 城市 FROM tese_lei ORDER BY lei_id DESC"
'call wawa_createxml(wawa_recordxml(sql))
%>