<% '欢迎与我交流和学习 '作者:幸福的子弹 'blog:http://mysheji.com/blog 'e-mail:zhaojiangang@gmail.com 'qq:37294812 '----------------------------------------------------------------------------- '开启容错机制 on error resume next '功能,检测服务器是否支持指定组件 function object_install(strclassstring) on error resume next object_install=false dim xtestobj set xtestobj=server.createobject(strclassstring) if -2147221005 <> err then object_install=true set xtestobj=nothing end function if object_install("scripting.filesystemobject")=false then response.write "<div style='color:#333;height:20px;line-height:20px;border:1px solid #ddcf8f;padding:6px;background:#ffffed;font-family:verdana'>对不起,您的空间不支持fso组件,请与管理员联系!</div>" response.end end if if object_install("adodb.stream")=false then response.write "<div style='color:#333;height:20px;line-height:20px;border:1px solid #ddcf8f;padding:6px;background:#ffffed;font-family:verdana'>对不起,您的空间不支持adodb.stream功能,请与管理员联系!</div>" response.end end if '----------------------------------------------------------------------------- '函数名称:readtextfile '作用:利用adodb.stream对象来读取文本文件 '参数:fileurl文件相对路径,filecharset:文件编码 function readfromtextfile (fileurl,filecharset)'函数 dim str set stm=server.createobject("adodb.stream") stm.type=2 '指定或返回的数据类型, stm.mode=3 '指定打开模式,现在为可以读写模式,类似于word的只读或锁定功能 stm.charset=filecharset stm.open stm.loadfromfile server.mappath(fileurl) str=stm.readtext readfromtextfile=str end function '----------------------------------------------------------------------------- '函数名称:writetotextfile '作用:利用adodb.stream对象来写入文本文件 sub writetotextfile(fileurl,str,filecharset) '方法 set stm=server.createobject("adodb.stream") stm.type=2 stm.mode=3 stm.charset=filecharset stm.open stm.writetext str stm.savetofile server.mappath(fileurl),2 stm.flush end sub '----------------------------------------------------------------------------- '功能:自动创建文件夹 '创建一级或多级目录,可以创建不存在的根目录 '参数:要创建的目录名称,可以是多级 '返回逻辑值,true成功,false失败 '创建目录的根目录从当前目录开始 function createmultifolder(byval cfolder) dim objfso,phcreatefolder,createfolderarray,createfolder dim i,ii,createfoldersub,phcreatefoldersub,blinfo blinfo = false createfolder = cfolder on error resume next set objfso = server.createobject("scripting.filesystemobject") if err then err.clear() exit function end if createfolder = replace(createfolder,"","/") if left(createfolder,1)="/" then createfolder = right(createfolder,len(createfolder)-1) end if if right(createfolder,1)="/" then createfolder = left(createfolder,len(createfolder)-1) end if createfolderarray = split(createfolder,"/") for i = 0 to ubound(createfolderarray) createfoldersub = "" for ii = 0 to i createfoldersub = createfoldersub & createfolderarray(ii) & "/" next phcreatefoldersub = server.mappath(createfoldersub) if not objfso.folderexists(phcreatefoldersub) then objfso.createfolder(phcreatefoldersub) end if next if err then err.clear() else blinfo = true end if createmultifolder = blinfo end function '点击下载提示 function downloadfile(strfile) strfilename = server.mappath(strfile) response.buffer = true response.clear set s = server.createobject("adodb.stream") s.open s.type = 1 on error resume next set fso = server.createobject("scripting.filesystemobject") if not fso.fileexists(strfilename) then response.write("<h1>error:</h1>" & strfilename & " does not exist<p>") response.end end if set f = fso.getfile(strfilename) intfilelength = f.size s.loadfromfile(strfilename) if err then response.write("<h1>error: </h1>" & err.description & "<p>") response.end end if response.addheader "content-disposition", "attachment; filename=" & f.name response.addheader "content-length", intfilelength response.charset = "utf-8" response.contenttype = "application/octet-stream" response.binarywrite s.read response.flush s.close set s = nothing end function '----------------------------------------------------------------------------- if err then err.clear set conn = nothing response.write "<div style='color:#333;height:20px;line-height:20px;border:1px solid #ddcf8f;padding:6px;background:#ffffed;font-family:verdana'>网站异常出错,请与管理员联系,谢谢!</div>" response.end end if %>
<% on error resume next dim db_path,conn,connstr db_path = "data/data.mdb" set conn= server.createobject("adodb.connection") connstr = "provider=microsoft.jet.oledb.4.0;data source="&server.mappath(db_path) on error resume next conn.open connstr if err then err.clear set conn = nothing response.write "<script language=javascript> location.href='error.asp?msg=系统出错,请联系管理员!' </script>" response.end end if set rs=server.createobject("adodb.recordset") rs.open "select * from m_ss",conn,1,1 s=rs("s_main") all=split(s,"|||") for i=0 to 20 next if not (rs.eof and rs.bof) then dim ttxt,file,filepath,writefile ttxt="jb.csv" '为要写入的文件取个文件名,后缀可以是txt,xls,这里我用csv,这种文件打开也是excel表 set file = createobject("scripting.filesystemobject") application.lock '写入文件的存放路径,一定要开放这个路径下的读写权限 filepath=server.mappath(ttxt) set writefile = file.createtextfile(filepath,true) '在表格中写入第一行,字段描述,这个根据你实际的数据表字段来写 writefile.writeline "a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,aa,ab,ac,ad,ae,af,ag,ah,ai,aj,ak" do while not rs.eof writefile.writeline rs("s_id")&","&rs("s_no")&","&rs("s_top")&","&rs("s_title")&","&rs("s_name")&","&rs("s_add")&","&rs("s_ajlx")&","&rs("s_fy1")&","&rs("s_fy2")&","&rs("s_fy3")&","&rs("s_fg1")&","&rs("s_fg2")&","&rs("s_fg3")&","&rs("s_yg")&","&rs("s_bg")&","&all(0)&","&all(1)&","&all(2)&","&all(3)&","&all(4)&","&all(5)&","&all(6)&","&all(7)&","&all(8)&","&all(9)&","&all(10)&","&all(11)&","&all(12)&","&all(13)&","&all(14)&","&all(15)&","&all(16)&","&all(17)&","&all(18)&","&all(19)&","&rs("s_ly")&","&rs("s_bz")&","&rs("s_sfz")&","&rs("s_time") rs.movenext loop '以上三行作用是逐行将数据写入表中 writefile.close application.unlock rs.close set rs=nothing end if rs.close set rs=nothing response.write "数据导出成功!" response.end %>