Database export XML, HTM, CSV, sql

xml| Export xml| Data | database

<!--#include file= '. /conn.asp '-->
<%
' Database export record code
' Author Eva, haiwa#blueidea.com,http://www.51windows.net
Usage
' exportdb.asp?sql=select statement &tablename= table name (optional) &filetype= export Format (xml,htm,csv,sql) &pid= AutoNumber field name ( Useful only when exporting SQL types
Dim tablename,filetype,fieldpid
sql = Request ("SQL")
TableName = Request ("tablename")
filetype = LCase (Request ("filetype"))
Fieldpid = Request ("pid")
If Fieldpid = "" Then
Fieldpid = "id"
End If
Fieldpid = LCase (fieldpid)
If LCase (left (sql,6)) <> "Select" Then
Response.Write "SQL statement must be a SELECT * from [table] where ..."
Response.End
End If

If TableName = "" Then
TableName = "Data export results"
End If

function HTMLEncode (fstring)
If not IsNull (fstring) Then
fstring = Server.HTMLEncode (fstring)
fstring = Replace (fstring, CHR (a) & CHR (a), "</P><P>")
fstring = Replace (fstring, CHR (), "<BR>")
fstring = Replace (fstring, CHR (9), "")

HTMLEncode = fstring
End If
End Function

function Myreplace (str)
If not IsNull (str) Then
fstring = Replace (fstring, "" "" "" "" "")
Myreplace = str
Else
Myreplace = ""
End If
End Function

function Myreplace2 (str)
If not IsNull (str) Then
fstring = Replace (fstring, "'", "")
Myreplace2 = str
Else
Myreplace2 = ""
End If
End Function

Dim def_export_sep,def_export_val
Def_export_sep = ","
Def_export_val = "" "" "

Set rs = conn.execute (SQL)
' Export XML file
If filetype= "xml" Then
Response.contenttype= "Text/xml"
Response.Charset = "gb2312"
Response.AddHeader "Content-disposition", "Attachment;filename=" &tablename& ". xml"
Response.Write "<?xml version=" "1.0" "encoding=" "gb2312" "?>" & vbNewLine
Response.Write "<root>"
Strline= ""
Dim Thefield (50)
i = 0
For each x in Rs.fields
Thefield (i) =x.name
I=i+1
Next
While Rs. EOF =false
Strline= VBNEWLINE&AMP;CHR (9) & "<row>"
K=0
For each x in Rs.fields
Strline= StrLine & VBNEWLINE&AMP;CHR (9) &AMP;CHR (9) & "<" &thefield (k) & ">"
If InStr (X.value, "<") >0 or InStr (X.value, ">") >0 or InStr (X.value, "&") >0 or Len (x.value) >255
strline= StrLine & "<! [Cdata[& X.value & "]]>"
Else
Strline= StrLine & X.value
End If
strline= StrLine & "</" &thefield (k) & ">"
K=k+1
Next
Rs. MoveNext
Response.Write StrLine &vbnewline& chr (9) & "</row>"
Wend
Response.Write vbnewline& "</root>"

' Export SQL file
ElseIf filetype= "SQL" then
Response.contenttype= "Text/sql"
Response.AddHeader "Content-disposition", "Attachment;filename=" &tablename& ". sql"
Strline= ""
Dim Sql_insert
For each x in Rs.fields
If LCase (x.name) <>fieldpid Then ' if it is automatically numbered
Strline= StrLine & def_export_val & x.name & Def_export_val & Def_export_sep
End If
Next
StrLine = replace (left (Strline,len (strLine)-1), "" "," ""
StrLine = "INSERT INTO [&tablename&]" ("& StrLine &") values "
Sql_insert = StrLine
' Response.Write StrLine & vbNewLine
' Response.End
While Rs. EOF =false
Strline= ""
Def_export_val = "'"
For each x in Rs.fields
If LCase (x.name) <>fieldpid Then
' Bug that cannot be exported when the null value was updated in 2004-8-11.
X_value = X.value
If IsNull (X_value) or len (x_value) = 0 Then
X_value = ""
Else
X_value = replace (X_value, "'", "")
End If
Strline= StrLine & def_export_val & X_value & Def_export_val & Def_export_sep
End If
Next
Rs. MoveNext
StrLine = Left (Strline,len (strLine)-1)
Response.Write Sql_insert & "(" & StrLine & ") *" & vbNewLine
Wend
ElseIf filetype= "CSV" then
Response.contenttype= "Text/csv"
Response.AddHeader "Content-disposition", "Attachment;filename=" &tablename& "