Database export XML, HTM, CSV, SQL common code

xml| Export xml| Data | database | Common code database Export XML, HTM, CSV, SQL code

Usage: Exportdb.asp?sql=select statement &table= table name (optional) &filetype= export Format (xml,htm,csv,sql) &pid= AutoNumber field name (useful only when exporting SQL types)

2004-8-11 Update

<!--#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& ". csv"
Strline= ""
For each x in Rs.fields
Strline= StrLine & def_export_val & x.name & Def_export_val & Def_export_sep
Next
Response.Write StrLine & vbNewLine
While Rs. EOF =false
Strline= ""
For each x in Rs.fields
Strline= StrLine & Def_export_val & Myreplace (x.value) & Def_export_val & Def_export_sep
Next
Rs. MoveNext
Response.Write StrLine & vbNewLine
Wend
Else
If filetype= ' htm ' then ' pop-up download HTML dialog box
Response.contenttype= "Application/ms-download"
Response.AddHeader "Content-disposition", "Attachment;filename=" &tablename& ". htm"
End If
%>
<meta http-equiv= "Content-type" content= "text/html; charset=gb2312 ">
<meta name= "Author" content= "51windows, Hai Eva, Haiwa" >
<meta name= "Description" content= "Power by 51windows.net" >
<title> Export Data-www.51windows.net</title>
<style>
<!--
body,input,select {font-family:tahoma; font-size:8pt}
th {font-family:tahoma; Font-size:8pt;padding:3px;color: #FFFFFF; Background-color: #999999;}
TD {Font-family:tahoma; Font-size:8pt;padding:3px;background-color: #EFEFEF;}
-->
</style>
<body style= "Overflow:auto;" topmargin=2 bgcolor=buttonface>

<form method= "POST" name=myform>
Sql:<input type= "text" name= "SQL" value= "<% = sql%>" >
Table name: <input type= "text" name= "tablename" value= "<% = tablename%>" size= "8" >
Export format: <select size= "1" name= "filetype" >
<option value= "" > Please select </option>
<option <%if filetype = "htm" Then Response.Write "selected"%>value= "htm" >htm</option>
<option <%if filetype = "xml" Then Response.Write "Selected"%>value= "xml" >xml</option>
<option <%if filetype = "csv" Then Response.Write "selected"%>value= "CSV" >csv</option>
<option <%if filetype = "sql" Then Response.Write "Selected"%>value= "SQL" >sql</option>
</select>
AutoNumber field Name: <input type= "text" name= "pid" value= "<% = fieldpid%>" size= "8" ><input type= "Submit" value= "OK" >
</form>

<div align= "center" >
<table border= "0" cellpadding= "0" cellspacing= "1" bgcolor= "#000000" >
<tr>
<%
I=0
For each x in Rs.fields
Strline= strLine &AMP;CHR (9) &AMP;CHR (9) & "<th align=" "Center" ">" & x.name & "</th>" & vbNewLine
Next
Response.Write STRLINE&AMP;CHR (9) & "</tr>" & vbNewLine & vbNewLine
While Rs. EOF =false
I=i+1
Response.Write Chr (9) & "<tr>" & vbNewLine
Strline= ""
For each x in Rs.fields
Strline= strLine &AMP;CHR (9) &AMP;CHR (9) & "<td>" & HTMLEncode (x.value) & "</td>" & vbNewLine
Next
Rs. MoveNext
Response.Write StrLine
Response.Write Chr (9) & "</tr>" & vbNewLine & vbNewLine
Wend
Response.Write "</table>" & vbNewLine
If filetype<> "htm" and filetype<> "xls" and filetype<> "SQL" then
Response.Write "<p style= ' line-height:160%; ' > "&i&" Record <a href= '? tablename= "& TableName &" &pid= "& Fieldpid &" &filetype=htm &sql= "&server.urlencode (SQL) &" ' > Export html</a> "
Response.Write "|<a href= '? tablename=" & TableName & "&pid=" & Fieldpid & "&filetype=csv& Sql= "&server.urlencode (SQL) &" ' > Export excel</a> "
Response.Write "|<a href= '? tablename=" & TableName & "&pid=" & Fieldpid & "&filetype=xml& Sql= "&server.urlencode (SQL) &" ' > Export xml</a> "
Response.Write "|<a href= '? tablename=" & TableName & "&pid=" & Fieldpid & "&filetype=sql& Sql= "&server.urlencode (SQL) &" ' > Export sql</a> "& vbNewLine
End If
Response.Write "<p>power by <a href=" "Http://www.51windows.Net" "target=" "_blank" ">51windows.net</a" > "& vbNewLine
Response.Write "</div>" & vbNewLine
Response.Write "</BODY>" & vbNewLine
Response.Write "</HTML>" & vbNewLine

End If
Rs.close
Conn.close
Set rs=nothing
Set conn=nothing
%>