ASP exports database records to XML, HTM, CSV, SQL code

Source: Internet
Author: User
Tags format chr table name urlencode
xml| Export xml| Data | Database 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
%>



Related Article

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.