2004-09-01 18:08
发一个经典的类，化境编程界无组件上传类。
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT> dim Data_5xsoft
'upload_5xsoft类 Class upload_5xsoft dim objForm,objFile,Version
Public function Form(strForm) strForm=lcase(strForm) if not objForm.exists(strForm) then Form="" else Form=objForm(strForm) end if end function
Public function File(strFile) strFile=lcase(strFile) if not objFile.exists(strFile) then set File=new FileInfo else set File=objFile(strFile) end if end function
Private Sub Class_Initialize '类初始化过程 dim RequestData,sStart,vbCrlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile dim iFileSize,sFilePath,sFileType,sFormValue,sFileName dim iFindStart,iFindEnd dim iFormStart,iFormEnd,sFormName Version="化境HTTP上传程序 Version 2.0" set objForm=Server.CreateObject("Scripting.Dictionary") set objFile=Server.CreateObject("Scripting.Dictionary") if Request.TotalBytes<1 then Exit Sub set tStream = Server.CreateObject("adodb.stream") set Data_5xsoft = Server.CreateObject("adodb.stream") Data_5xsoft.Type = 1 Data_5xsoft.Mode =3 Data_5xsoft.Open Data_5xsoft.Write Request.BinaryRead(Request.TotalBytes) Data_5xsoft.Position=0 RequestData =Data_5xsoft.Read
iFormStart = 1 iFormEnd = LenB(RequestData) vbCrlf = chrB(13) & chrB(10) sStart = MidB(RequestData,1, InStrB(iFormStart,RequestData,vbCrlf)-1) iStart = LenB (sStart) iFormStart=iFormStart+iStart+1 while (iFormStart + 10) < iFormEnd iInfoEnd = InStrB(iFormStart,RequestData,vbCrlf & vbCrlf)+3 tStream.Type = 1 tStream.Mode =3 tStream.Open Data_5xsoft.Position = iFormStart Data_5xsoft.CopyTo tStream,iInfoEnd-iFormStart tStream.Position = 0 tStream.Type = 2 tStream.Charset ="gb2312" sInfo = tStream.ReadText tStream.Close '取得表单项目名称 iFormStart = InStrB(iInfoEnd,RequestData,sStart) iFindStart = InStr(22,sInfo,"name=""",1)+6 iFindEnd = InStr(iFindStart,sInfo,"""",1) sFormName = lcase(Mid (sinfo,iFindStart,iFindEnd-iFindStart)) '如果是文件 if InStr (45,sInfo,"filename=""",1) > 0 then set theFile=new FileInfo '取得文件名 iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10 iFindEnd = InStr(iFindStart,sInfo,"""",1) sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart) theFile.FileName=getFileName(sFileName) theFile.FilePath=getFilePath(sFileName) '取得文件类型 iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14 iFindEnd = InStr(iFindStart,sInfo,vbCr) theFile.FileType =Mid (sinfo,iFindStart,iFindEnd-iFindStart) theFile.FileStart =iInfoEnd theFile.FileSize = iFormStart -iInfoEnd -3 theFile.FormName=sFormName if not objFile.Exists(sFormName) then objFile.add sFormName,theFile end if else '如果是表单项目 tStream.Type =1 tStream.Mode =3 tStream.Open Data_5xsoft.Position = iInfoEnd Data_5xsoft.CopyTo tStream,iFormStart-iInfoEnd-3 tStream.Position = 0 tStream.Type = 2 tStream.Charset ="gb2312" sFormValue = tStream.ReadText tStream.Close if objForm.Exists(sFormName) then objForm(sFormName)=objForm(sFormName)&", "&sFormValue else objForm.Add sFormName,sFormValue end if end if iFormStart=iFormStart+iStart+1 wend RequestData="" set tStream =nothing End Sub
Private Sub Class_Terminate '类的析构 if Request.TotalBytes>0 then objForm.RemoveAll objFile.RemoveAll set objForm=nothing set objFile=nothing Data_5xsoft.Close set Data_5xsoft =nothing end if End Sub Private function GetFilePath(FullPath) If FullPath <> "" Then GetFilePath = left(FullPath,InStrRev(FullPath, "\")) Else GetFilePath = "" End If End function Private function GetFileName(FullPath) If FullPath <> "" Then GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1) Else GetFileName = "" End If End function End Class
'FileInfo类 Class FileInfo dim FormName,FileName,FilePath,FileSize,FileType,FileStart Private Sub Class_Initialize FileName = "" FilePath = "" FileSize = 0 FileStart= 0 FormName = "" FileType = "" End Sub Public function SaveAs(FullPath) dim dr,ErrorChar,i SaveAs=true if trim(fullpath)="" or FileStart=0 or FileName="" or right(fullpath,1)="/" then exit function set dr=CreateObject("Adodb.Stream") dr.Mode=3 dr.Type=1 dr.Open Data_5xsoft.position=FileStart Data_5xsoft.copyto dr,FileSize dr.SaveToFile FullPath,2 dr.Close set dr=nothing SaveAs=false end function End Class </SCRIPT>
[此贴子已经被作者于2004-09-01 22:04:46编辑过]
2004-09-01 21:59
2004-09-01 21:59
这是使用这个类的例子
<%OPTION EXPLICIT%> <%Server.ScriptTimeOut=5000%> <!--#include FILE="upload_5xsoft.inc"--> <html> <head> <title>文件上传</title> </head> <body> <br>化境文件上传!<hr size=1 noshadow width=300 align=left><br><br> <% dim upload,file,formName,formPath,iCount set upload=new upload_5xsoft ''建立上传对象
response.write upload.Version&"<br><br>" ''显示上传类的版本
if upload.form("filepath")="" then ''得到上传目录 HtmEnd "请输入要上传至的目录!" set upload=nothing response.end else formPath=upload.form("filepath") ''在目录后加(/) if right(formPath,1)<>"/" then formPath=formPath&"/" end if
iCount=0 for each formName in upload.objForm ''列出所有form数据 response.write formName&"="&upload.form(formName)&"<br>" next
response.write "<br>" for each formName in upload.objFile ''列出所有上传了的文件 set file=upload.file(formName) ''生成一个文件对象 if file.FileSize<100*1024 then ''如果 FileSize > 0 说明有文件数据 file.SaveAs Server.mappath(formPath&file.FileName) ''保存文件 response.write file.FilePath&file.FileName&" ("&file.FileSize&") => "&formPath&File.FileName&"成功!" response.Write "<a href='" & formPath&File.FileName & "' target='_blank'>查看</a><br>" iCount=iCount+1 else response.write file.FilePath&file.FileName&" ("&file.FileSize&") => "&formPath&File.FileName&" <font color=red>失败!文件太大</font>" end if set file=nothing next
set upload=nothing ''删除此对象 Htmend iCount&" 个文件上传结束!"
sub HtmEnd(Msg) set upload=nothing response.write "<br>"&Msg&" [<a href=""javascript:history.back();"">返回</a>]</body></html>" response.end end sub %> </body> </html>
2004-09-01 22:00
