IMAT(梁无惧) 的无组件上传类

  1<script language="VBSCRIPT" runat="SERVER">   
  2'----------------------------------------------------------------------   
  3'******************* 无组件上传类 ********************************   
  4'修改者:梁无惧   
  5'电子邮件:[email protected]   
  6'网站:http://asp.25cn.com   
  7'原作者:稻香老农   
  8'原作者网站:http://www.5xsoft.com   
  9'声明:此上传类是在化境编程界发布的无组件上传类的基础上修改的.   
 10'在与化境编程界无组件上传类相比,速度快了将近50倍,当上传4M大小的文件时   
 11'服务器只需要10秒就可以处理完,是目前最快的无组件上传程序,当前版本为0.93   
 12'源代码公开,免费使用,对于商业用途,请与作者联系   
 13'**********************************************************************   
 14'----------------------------------------------------------------------   
 15dim oUpFileStream   
 16  
 17Class upload_file   
 18  
 19dim Form,File,Version   
 20  
 21Private Sub Class_Initialize   
 22dim RequestBinDate,sStart,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo   
 23dim iFileSize,sFilePath,sFileType,sFormValue,sFileName   
 24dim iFindStart,iFindEnd   
 25dim iFormStart,iFormEnd,sFormName   
 26Version="无组件上传类 Version 0.93"   
 27set Form=Server.CreateObject("Scripting.Dictionary")   
 28set File=Server.CreateObject("Scripting.Dictionary")   
 29if Request.TotalBytes<1 then Exit Sub   
 30set tStream = Server.CreateObject("adodb.stream")   
 31set oUpFileStream = Server.CreateObject("adodb.stream")   
 32oUpFileStream.Type = 1   
 33oUpFileStream.Mode =3   
 34oUpFileStream.Open   
 35oUpFileStream.Write Request.BinaryRead(Request.TotalBytes)   
 36oUpFileStream.Position=0   
 37RequestBinDate =oUpFileStream.Read   
 38iFormStart = 1   
 39iFormEnd = LenB(RequestBinDate)   
 40bCrLf = chrB(13) & chrB(10)   
 41sStart = MidB(RequestBinDate,1, InStrB(iFormStart,RequestBinDate,bCrLf)-1)   
 42iStart = LenB (sStart)   
 43iFormStart=iFormStart+iStart+1   
 44while (iFormStart + 10) < iFormEnd   
 45iInfoEnd = InStrB(iFormStart,RequestBinDate,bCrLf & bCrLf)+3   
 46tStream.Type = 1   
 47tStream.Mode =3   
 48tStream.Open   
 49oUpFileStream.Position = iFormStart   
 50oUpFileStream.CopyTo tStream,iInfoEnd-iFormStart   
 51tStream.Position = 0   
 52tStream.Type = 2   
 53tStream.Charset ="gb2312"   
 54sInfo = tStream.ReadText   
 55'取得表单项目名称   
 56iFormStart = InStrB(iInfoEnd,RequestBinDate,sStart)   
 57iFindStart = InStr(22,sInfo,"name=""",1)+6   
 58iFindEnd = InStr(iFindStart,sInfo,"""",1)   
 59sFormName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)   
 60'如果是文件   
 61if InStr (45,sInfo,"filename=""",1) > 0 then   
 62set oFileInfo=new FileInfo   
 63'取得文件名   
 64iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10   
 65iFindEnd = InStr(iFindStart,sInfo,"""",1)   
 66sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)   
 67oFileInfo.FileName=getFileName(sFileName)   
 68oFileInfo.FilePath=getFilePath(sFileName)   
 69'取得文件类型   
 70iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14   
 71iFindEnd = InStr(iFindStart,sInfo,vbCr)   
 72oFileInfo.FileType =Mid (sinfo,iFindStart,iFindEnd-iFindStart)   
 73oFileInfo.FileStart =iInfoEnd   
 74oFileInfo.FileSize = iFormStart -iInfoEnd -3   
 75oFileInfo.FormName=sFormName   
 76file.add sFormName,oFileInfo   
 77else   
 78'如果是表单项目   
 79tStream.Close   
 80tStream.Type =1   
 81tStream.Mode =3   
 82tStream.Open   
 83oUpFileStream.Position = iInfoEnd   
 84oUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-3   
 85tStream.Position = 0   
 86tStream.Type = 2   
 87tStream.Charset ="gb2312"   
 88sFormValue = tStream.ReadText   
 89form.Add sFormName,sFormValue   
 90end if   
 91tStream.Close   
 92iFormStart=iFormStart+iStart+1   
 93wend   
 94RequestBinDate=""   
 95set tStream =nothing   
 96End Sub   
 97  
 98Private Sub Class_Terminate   
 99if not Request.TotalBytes<1 then   
100form.RemoveAll   
101file.RemoveAll   
102set form=nothing   
103set file=nothing   
104oUpFileStream.Close   
105set oUpFileStream =nothing   
106end if   
107End Sub   
108  
109  
110Private function GetFilePath(FullPath)   
111If FullPath <> "" Then   
112GetFilePath = left(FullPath,InStrRev(FullPath, "\"))   
113Else   
114GetFilePath = ""   
115End If   
116End function   
117  
118Private function GetFileName(FullPath)   
119If FullPath <> "" Then   
120GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)   
121Else   
122GetFileName = ""   
123End If   
124End function   
125  
126End Class   
127  
128Class FileInfo   
129dim FormName,FileName,FilePath,FileSize,FileType,FileStart   
130Private Sub Class_Initialize   
131FileName = ""   
132FilePath = ""   
133FileSize = 0   
134FileStart= 0   
135FormName = ""   
136FileType = ""   
137End Sub   
138  
139Public function SaveToFile(FullPath)   
140dim oFileStream,ErrorChar,i   
141SaveToFile=1   
142if trim(fullpath)="" or right(fullpath,1)="/" then exit function   
143set oFileStream=CreateObject("Adodb.Stream")   
144oFileStream.Type=1   
145oFileStream.Mode=3   
146oFileStream.Open   
147oUpFileStream.position=FileStart   
148oUpFileStream.copyto oFileStream,FileSize   
149oFileStream.SaveToFile FullPath,2   
150oFileStream.Close   
151set oFileStream=nothing   
152SaveToFile=0   
153end function   
154End Class   
155</script>