数据库导出xml、htm、csv、sql

2022-07-15 80酷酷网 80kuku.com

　　xml|导出xml|数据|数据库

<%
'数据库导出记录代码
'作者海娃,haiwa#blueidea.com，http://www.51windows.Net
'用法：
'ExportDB.asp?sql=select语句&tablename=表名(可选)&filetype=导出格式(xml,htm,csv,sql)&pid=自动编号字段名(仅当导出sql类型时有用)
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语句必须为select * from [table] where ......."
Response.end
end if

if tablename = "" then
tablename = "数据导出结果"
end if

function HTMLEncode(fString)
if not isnull(fString) then
  fString = Server.HTMLEncode(fString)
  fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
  fString = Replace(fString, CHR(10), "
")
  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)
'导出XML文件
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&chr(9)&"<row>"
k=0
For each x in rs.fields
  strLine= strLine & vbnewline&chr(9)&chr(9)&"<"&thefield(k)&">"
  if instr(x.value,"<")>0 or instr(x.value,">")>0 or instr(x.value,"&")>0 or len(x.value)>255 then
   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>"

'导出sql文件
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 '如果是自动编号
   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
   '2004-8-11更新 Null值时无法导出的bug。
   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&"