upfile.asp

来自「FLASH吧网站源码 v2.0栏目版： 功能不是很强大」· ASP 代码 · 共 259 行

<%
Dim oaStream
Class Upload
	Public Form,File,Ver,Err,AcceptExt,MaxSize,ChunkSize
	Private SavePath
	Private Sub Class_Initialize
		Ver = "Nowa Upload Class Ver 1.0"
		Err = -1
		AcceptExt = ""
		MaxSize = -1
		ChunkSize = 1024
		Set Form = Server.CreateObject ("Scripting.Dictionary")
		Set File = Server.CreateObject ("Scripting.Dictionary")
		Set oaStream = Server.CreateObject ("Adodb.Stream")
		Form.CompareMode = 1
		File.CompareMode = 1
		oaStream.Type = 1
		oaStream.Mode = 3
		oaStream.Open
	End Sub
	
	Private Sub Class_Terminate  
		Form.RemoveAll
		Set Form = Nothing
		File.RemoveAll
		Set File = Nothing
		oaStream.Close
		Set oaStream = Nothing
	End Sub
	
	Public Sub DisposeData()
	  Dim bData,sSpace,bCrLf,sInfo,iInfoEnd,tStream,iStart,oFileInfo,sFormValue,sFileName
	  Dim sFormName,bLength,iFindStart,iFindEnd,iFormStart,iFormEnd,FileFlag
	  bLength = Int(Request.TotalBytes)
	  If  bLength < 1 Then
		Err = 1
		Exit Sub
	  End If
	  Set tStream = Server.CreateObject ("Adodb.Stream")
	  Dim biData, ChunkBytes, ReadedBytes
	  ChunkBytes = 1 * 1024
	  ReadedBytes = 0
	

	  Application("UpStart")=Timer()
	  Application("TotalBytes")=bLength
	  Do While ReadedBytes < bLength
		  biData = Request.BinaryRead(ChunkBytes)
		  oaStream.Write biData 
		  ReadedBytes = ReadedBytes + ChunkBytes
		  If ReadedBytes > bLength Then ReadedBytes = bLength
		  Application("UpPercent") = Round(ReadedBytes/bLength,2)*100
		  Application("ReadBytes") = ReadedBytes
	  Loop
	  oaStream.Position = 0
	  bData = oaStream.Read
	  iFormEnd = oaStream.Size
	  
	  bCrLf = ChrB (13) & ChrB (10)
	  sSpace = MidB (bData,1, InStrB (1,bData,bCrLf)-1)
	  iStart = LenB  (sSpace)
	  iFormStart = iStart+2
	  Do
		iInfoEnd = InStrB (iFormStart,bData,bCrLf & bCrLf)+3
	    tStream.Type = 1
	    tStream.Mode = 3
	    tStream.Open
	    oaStream.Position = iFormStart
	    oaStream.CopyTo tStream,iInfoEnd-iFormStart
	    tStream.Position = 0
	    tStream.Type = 2
	    tStream.CharSet = "gb2312"
	    sInfo = tStream.ReadText
	    iFormStart = InStrB (iInfoEnd,bData,sSpace)-1
	    iFindStart = InStr(22,sInfo,"name=""",1)+6
	    iFindEnd = InStr(iFindStart,sInfo,"""",1)
	    sFormName = Mid(sinfo,iFindStart,iFindEnd-iFindStart)
		If InStr(45,sInfo,"filename=""",1) > 0 Then
			Set oFileInfo = new FileInfo_Class
			iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
			iFindEnd = InStr(iFindStart,sInfo,"""",1)
			sFileName = Mid(sinfo,iFindStart,iFindEnd-iFindStart)
			oFileInfo.FileName = Mid(sFileName,InStrRev(sFileName, "\")+1)
			oFileInfo.FilePath = Left(sFileName,InStrRev(sFileName, "\"))
			oFileInfo.FileExt = FixName(Lcase(Mid(sFileName,InStrRev(sFileName, ".")+1)))
			oFileInfo.RndName = FormatName(oFileInfo.FileExt)
			iFindStart = InStr (iFindEnd,sInfo,"Content-Type: ",1)+14
			iFindEnd = InStr (iFindStart,sInfo,vbCr)
			oFileInfo.FileType = Ucase(Mid(sinfo,iFindStart,iFindEnd-iFindStart))
			oFileInfo.FileStart = iInfoEnd
			oFileInfo.FileSize = iFormStart -iInfoEnd -2
			oFileInfo.FormName = sFormName
			If MaxSize > 0 Then
				If oFileInfo.FileSize > MaxSize Then
					Err = 2
					Exit Sub
				End If
			End If
			If CheckExt(oFileInfo.FileExt) = False Then
				Err=3
				Exit Sub
			End If
			File.Add sFormName,oFileInfo
		Else
			tStream.Close
			tStream.Type = 1
			tStream.Mode = 3
			tStream.Open
			oaStream.Position = iInfoEnd 
			oaStream.CopyTo tStream,iFormStart-iInfoEnd-2
			tStream.Position = 0
			tStream.Type = 2
			tStream.CharSet = "gb2312"
			sFormValue = tStream.ReadText
			If Form.Exists (sFormName) Then _
				Form (sFormName) = Form (sFormName) & ", " & sFormValue _
			Else _
				Form.Add sFormName,sFormValue
		End If
		tStream.Close
		iFormStart = iFormStart+iStart+2
	  Loop Until  (iFormStart+2) = iFormEnd
	  bData = ""
	  Set tStream = Nothing
	  Application("UpPercent")=0
	End Sub
	
	Private Function FormatName(Byval FileExt)
		Dim RanNum,TempStr
		Randomize
		RanNum = Int(90000*rnd)+10000
		TempStr = Year(now) & Month(now) & Day(now) & Hour(now) & Minute(now) & Second(now) & RanNum & "." & FileExt
		FormatName = TempStr
	End Function
	
	Private Function FixName(Byval UpFileExt)
		If IsEmpty(UpFileExt) Or IsNull(UpFileExt) Or UpFileExt="" Then Exit Function
		FixName = Lcase(UpFileExt)
		FixName = Replace(FixName,Chr(0),"")
		FixName = Replace(FixName,".","")
		FixName = Replace(FixName,"'","")
		FixName = Replace(FixName,"asp","")
		FixName = Replace(FixName,"asa","")
		FixName = Replace(FixName,"aspx","")
		FixName = Replace(FixName,"cer","")
		FixName = Replace(FixName,"cdx","")
		FixName = Replace(FixName,"htr","")
	End Function
	
	Private Function CheckExt(Byval ChkExt)
		Dim ChkStr,j
		CheckExt=False
		If AcceptExt = "" Then CheckExt=True:Exit Function
		If ChkExt="" Or IsNull(ChkExt) Or IsEmpty(ChkExt) Then Exit Function
		If ChkExt="asp" or ChkExt="asa" or ChkExt="aspx" Then Exit Function
		ChkStr = Split(AcceptExt,",")
		For j = 0 To UBound(ChkStr)
			If ChkExt = Trim(ChkStr(i)) Then
				CheckExt=True
				Exit Function
			End If
		Next
	End Function

	Private Function Bin2Str(Byval Bin)
		Dim i, Str, Sclow
		For i = 1 To LenB(Bin)
			Sclow = MidB(Bin,i,1)
			If ASCB(Sclow)<128 Then
				Str = Str & Chr(ASCB(Sclow))
			Else
				i = i+1
				If i <= LenB(Bin) Then Str = Str & Chr(ASCW(MidB(Bin,i,1)&Sclow))
			End If
		Next 
		Bin2Str = Str
	End Function
	
	Private Function BinVal(Byval bin)
		Dim ImageSize,i
		ImageSize = 0
		For i = lenb(bin) To 1 Step -1
			ImageSize = ImageSize *256 + ASCB(Midb(bin,i,1))
		Next
		BinVal = ImageSize
	End Function
	
End Class

Class FileInfo_Class
	Public FormName,FileName,FilePath,FileSize,FileType,FileStart,FileExt,FileWidth,FileHeight,RndName
	
	Private Sub Class_Initialize
		FileWidth=0
		FileHeight=0
	End Sub
	
	Public Sub SaveToFile (Byval Path)
		Dim Ext,oFileStream
		Ext = LCase(Mid(Path, InStrRev(Path, ".") + 1))
		If Ext <> FileExt Then Exit Sub
		If Trim(Path)="" or FileStart=0 or FileName="" or Right(Path,1)="/" Then Exit Sub
		'On Error Resume Next
		Set oFileStream = CreateObject ("Adodb.Stream")
		oFileStream.Type = 1
		oFileStream.Mode = 3
		oFileStream.Open
		oaStream.Position = FileStart
		oaStream.CopyTo oFileStream,FileSize
		oFileStream.SaveToFile Path,2
		oFileStream.Close
		Set oFileStream = Nothing 
	End Sub
	
	Public Function FileData
		oaStream.Position = FileStart
		FileData = oaStream.Read (FileSize)
	End Function
End Class

Dim oUp,Item,File
Set oUp=New Upload
oUp.AcceptExt=""
oUp.MaxSize=-1
'oup.Path="UploadFile"
Call oUp.DisposeData()
If oUp.Err>0 Then
	Select Case oUp.Err
		Case 1:Response.Write "<script>window.alert('非法的表单数据');window.location='upload.asp';</script>"
		Case 2:Response.Write "<script>window.alert('文件大小超过限制');window.location='upload.asp';</script>"
		Case 3:Response.Write "<script>window.alert('文件类型不正确');window.location='upload.asp';</script>"
	End Select
	Response.End()
End If

For Each Item In oUp.File
	Set File=oUp.File(Item)
     dim filelb,ranNum
     filename=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum
     filelb=lcase(Right(file.FileName, 3))
     if filelb="swf" then
     file.SaveToFile Server.mappath("../up/swf/"&filename&".swf")
     Response.Write "<SCRIPT>parent.document.form.urlb.value='"&filename&".swf';</script>"
     elseif  filelb="gif" then
     file.SaveToFile Server.mappath("../up/gif/"&filename&".gif")
     Response.Write "<SCRIPT>parent.document.form.img.value='up/gif/"&filename&".gif';</script>"
     elseif filelb="jpg" then
     file.SaveToFile Server.mappath("../up/jpg/"&filename&".jpg")
     Response.Write "<SCRIPT>parent.document.form.img.value='up/jpg/"&filename&".jpg';</script>"
     else
     Response.Write "<script>window.alert('请选择要上传的文件!(支持格式:swf,gif,jpg)');window.location='upload.asp';</script>"
     end if
	Set File=Nothing
Next

For Each Item In oUp.Form
Next
Set oUp=Nothing
%>