Frog recommended: Save recordset as an XML file

<! -- Frog recommendation: Save recordset as an XML file -->

<%
Function wawa_recordxml (SQL)
'*************************
'Function: converts A recordset to a string in XML format.
'Return value: String
'Parameter: SQL (string)
'Provider: Frog Prince (Tianji Forum)
'*************************
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)
'*************************
'Function: Write a string in XML format to a directory on the server.
'Return value: None
'Parameter: strxml (string)
'Provider: Frog Prince (Tianji Forum)
'*************************
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.doc umentelement
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)
'*************************
'Function: replace some special characters with Conversion characters to make the text node of XML legal
'Return value: String
'Parameter: fstring (string)
'Provider: Frog Prince (Tianji Forum)
'*************************
If fstring <> "" then
Fstring = CSTR (fstring)
Fstring = Replace (fstring, "&", "& amp ;")
Fstring = Replace (fstring, "<", "& lt ;")
Fstring = Replace (fstring, ">", "& gt ;")
Fstring = Replace (fstring, CHR (34), "& quot;") 'Double quotation marks
Fstring = Replace (fstring, CHR (39), "& #39;") 'single quotes
Wawa_xml_text = fstring
End if
End Function
%>
<! -- Use the following method: the conn. asp file can be written by yourself, but the database connection object instance name must be Conn, and then save the above three functions as a vbsxml. asp
Then, write the required SQL string and call the function. There may be some bugs in the function, such as the XML generated by "XML" in RS. Field. Name.
The file is not legal. The time is too short and you don't need to write it. You should ensure that these bugs do not go wrong.
-->

<! -- # Include file = "conn. asp" -->
<! -- # Include file = "vbsxml. asp" -->
<%
'Response. contenttype = "text/XML"
'SQL = "select lei_id as number, lei_name as city from tese_lei order by lei_id DESC"
'Call wawa_createxml (wawa_recordxml (SQL ))
%>

Function wawa_xml_text (fstring)
'*************************
'Function: replace some special characters with Conversion characters to make the text node of XML legal
'Return value: String
'Parameter: fstring (string)
'Provider: Frog Prince (Tianji Forum)
'*************************
??? If fstring "" then
???? ?? Fstring = CSTR (fstring)
??? Fstring = Replace (fstring ,"&","&")
??????????? Fstring = Replace (fstring ,"??????????? Fstring = Replace (fstring, ">", "> ")
??????????? Fstring = Replace (fstring, CHR (34), "") 'Double quotation marks
??????????? Fstring = Replace (fstring, CHR (39 ),"'")? 'Single quotes
??????????? Wawa_xml_text = fstring
??? End if
End Function
%>

'Response. contenttype = "text/XML"
'SQL = "select lei_id as number, lei_name as city from tese_lei order by lei_id DESC"
'Call wawa_createxml (wawa_recordxml (SQL ))
%>