classupload.asp

依蓝旅游网站管理系统Elan2008.SP2

<%
'==================================================
'                   文件上传
'==================================================



Class ClassUpload
   Private FileName, FileExt, FileSize, SaveFilePath, AllowFileExt, IsCover
   Private UploadMaxSize, AppProgressCacthName
   Private ChunkBytes '每块上传大小
   Public ErrorCode
   
   Private Sub Class_Initialize
      FileName = ""
	  FileExt = ""
	  FileSize = ""
	  SaveFilePath = ""
	  AllowFileExt = ""
	  ErrorCode = 0
	  UploadMaxSize = 1024 * 100
	  IsCover = True
	  ChunkBytes = 1024 * 10
	  AppProgressCacthName = Request.ServerVariables("REMOTE_ADDR") &"_"& Request.ServerVariables("REMOTE_HOST") &"_"& Request.ServerVariables("REMOTE_USER")
   End Sub
   
   Private Sub Class_Terminate
      Application.Contents.Remove("UploadProgress_"& AppProgressCacthName)
   End Sub
   
   Public Property Get GetFileName()
      GetFileName = FileName
   End Property	
   
   Public Property Get GetFileSize()
      GetFileSize = FileSize
   End Property
   
   Public Property Get GetFileExt()
      GetFileExt = FileExt
   End Property
   
   Public Property Let SetSaveFilePath(sSaveFilePath)
      Dim TempPath
	  TempPath = Replace(sSaveFilePath, "/", "\")
	  If Right(TempPath, 1) = "\" Then
	     SaveFilePath = TempPath
	  Else
	     SaveFilePath = TempPath &"\"
	  End If
   End Property
   
   Public Property Let SetAllowFileExt(sAllowFileExt)
      AllowFileExt = Replace(LCase(sAllowFileExt), " ", "")
   End Property
   
   Public Property Let SetUploadMaxSize(iUploadMaxSize)
      If IsNumeric(iUploadMaxSize) Then
	     UploadMaxSize = iUploadMaxSize
	  End If
   End Property
   
   Public Property Let SetChunkBytes(iChunkBytes)
      If IsNumeric(iChunkBytes) Then
	     ChunkBytes = iChunkBytes
	  End If
   End Property
   
   Public Property Let SetIsCover(bCover)
      If Trim(LCase(TypeName(bCover))) = "boolean" Then
	     IsCover = bCover
	  End If
   End Property
   
   Public Sub Upload(FileDataName)
      Dim RequestTotal, RequestBinaryData, ReadedBytes, BinaryData
	  Dim UploadStream, TempStream
	  Dim BinCrLf, Divider, StartPos, EndPos, BinContent, FieldName, FiledValue, HeadBinary
	  Dim Const_NameB, Const_FileNameB, Const_Empty
	  Dim i
	  Application("UploadProgress_"& AppProgressCacthName) = 0 '设置进度为0
	  RequestTotal = Request.TotalBytes
	  If RequestTotal < 1 Then
	     ErrorCode = 1 '无数据上传
		 Exit Sub
	  End If
	  If RequestTotal > UploadMaxSize Then
	     ErrorCode = 2 '上传文件大小超过限制
		 Exit Sub
	  End If
	  If SaveFilePath = "" Or CheckFolder(SaveFilePath) = False Then
	     ErrorCode = 4 '找不到路径
		 Exit Sub
	  End If
	  ReadedBytes = 0 '初始化已上传字节为0
	  Set UploadStream = Server.CreateObject("ADODB." & "Stream")
	  Set TempStream = Server.CreateObject("ADODB." & "Stream")
	  UploadStream.Type = 1
	  UploadStream.Mode = 3
	  UploadStream.Open 
	  Do While ReadedBytes < RequestTotal
	     BinaryData = Request.BinaryRead(ChunkBytes)
		 UploadStream.Write BinaryData
		 ReadedBytes = ReadedBytes + ChunkBytes
		 If ReadedBytes > RequestTotal Then ReadedBytes = RequestTotal
		 Application("UploadProgress_"& AppProgressCacthName) = Cint((ReadedBytes/RequestTotal)*100) '进度百分比		 
	  Loop
	  UploadStream.Position = 0
	  RequestBinaryData = UploadStream.Read
	  BinCrLf = ChrB(13) & ChrB(10)
	  Const_NameB = Str2Bin("name=""")
	  Const_FileNameB = Str2Bin("filename=""")
	  Const_Empty = Str2Bin("filename=""""") '判断空域，未知文件格式
	  Divider = LeftB(RequestBinaryData,Clng(InstrB(RequestBinaryData,BinCrLf))-1)
	  StartPos =  InstrB(RequestBinaryData, Divider) + LenB(Divider) + LenB(BinCrLf)
	  TempStream.Type = 1
	  TempStream.Mode = 3
	  Do		 
		 TempStream.Open
		 EndPos =  InstrB(StartPos, RequestBinaryData, Divider) - LenB(BinCrLf)
	     BinContent = MidB(RequestBinaryData, StartPos, EndPos - StartPos)	     		 
		 If InstrB(BinContent, Const_Empty) > 0 Then  '判断空域
			ErrorCode = 1 '无数据上传
			Exit Sub
		 End If
		 HeadBinary = MidB(BinContent, InstrB(BinContent, Const_NameB) + LenB(Const_NameB), InstrB(BinContent, BinCrLf) - InstrB(BinContent, Const_NameB) - LenB(Const_NameB) - 1)
		 If InstrB(HeadBinary, Const_FileNameB) = (Len(FileDataName) + 4) Then '判断是否是file类型		    
		    FieldName = LeftB(HeadBinary, InstrB(HeadBinary, Str2Bin(""";")) - 1)
	        If LCase(Bin2Str(FieldName)) = LCase(FileDataName) Then '取指定表单FileDataName，不区分大小写
		       FileExt = LCase(Trim(Bin2Str(RightB(HeadBinary, LenB(HeadBinary)-InstrB(HeadBinary, Str2Bin("."))))))
			   If CheckFileExt(FileExt) = False Then Exit Sub '判断文件类型
		       FiledValue = MidB(BinContent, InstrB(BinContent, BinCrLf&BinCrLf) + LenB(BinCrLf&BinCrLf), LenB(BinContent) - InstrB(BinContent, BinCrLf&BinCrLf) + LenB(BinCrLf&BinCrLf)) 
			   'If Instr("jpeg|jpg|bmp|gif|png|tif", FileExt) > 0 Then '判断图片木马  影响上传速度，暂时屏蔽
			      'If CheckPicHack(FiledValue) = True Then Exit Sub 
			   'End If
			   FileSize = LenB(FiledValue) '文件的实际大小
			   If FileSize < 1 Then
			      ErrorCode = 1
				  Exit Sub
			   ElseIf FileSize > UploadMaxSize Then
			      ErrorCode = 2 '上传文件大小超过限制
				  Exit Sub
			   End If
			   FileName = GetRndNumber() &"."& FileExt
		       StartPos = InstrB(RequestBinaryData, FiledValue)
		       UploadStream.Position = StartPos - 1
			   UploadStream.CopyTo TempStream,  EndPos - StartPos
			   If IsCover Then
			      TempStream.SaveToFile SaveFilePath & FileName, 2
			   Else
			      TempStream.SaveToFile SaveFilePath & FileName
			   End If
			   TempStream.Close()
			   Exit Do
		    End If	
		 End If	 
		 StartPos = EndPos + LenB(Divider) + LenB(BinCrLf)+2
		 TempStream.Close()
	  Loop Until (StartPos+2) >= RequestTotal
	  UploadStream.Close()
	  Set UploadStream = Nothing
	  Set TempStream = Nothing
   End Sub
   
   Private Function CheckFileExt(sFileExt)
      Dim ArrFileExt, i
	  ErrorCode = 3 '上传文件格式错误
	  CheckFileExt = False
	  If AllowFileExt = "" Or sFileExt = "" Then Exit Function  	  
	  ArrFileExt = Split(AllowFileExt, "|")
	  For i = 0 To UBound(ArrFileExt)
	     If ArrFileExt(i) = sFileExt Then
		    ErrorCode = 0
		    CheckFileExt = True
			Exit Function
		 End If
	  Next
   End Function
   
   Private Function CheckPicHack(ByVal sValue)
      Dim HackCode, i, l
	  CheckPicHack = False
	  HackCode = Split(EL_PicHack, ",")
	  l = Ubound(HackCode)
	  For i = 0 To l
	     If Instr(LCase(Bin2Str(sValue)), LCase(HackCode(i))) > 0 Then
		     CheckPicHack = True
			 ErrorCode = 5 
			 Exit Function
		 End If
	  Next
   End Function
   
   Private Function CheckFolder(sFolder)
      Dim FSO
	  If Trim(sFolder) = "" Then
	     CheckFolder = False
		 Exit Function
	  End If
	  Set FSO = Server.CreateObject("Scripting." & "FileSystemObject")
	  CheckFolder = FSO.FolderExists(sFolder)
	  Set FSO = Nothing
   End Function
   
   Private Function Str2Bin(varstr)      
	  Dim i, varchar, varasc, varlow, varhigh
	  Str2Bin = ""
      For i=1 To Len(varstr)
	     varchar = mid(varstr,i,1)
		 varasc = Asc(varchar)
		 If varasc<0 Then
		    varasc = varasc + 65535
		 End If
		 If varasc>255 Then
		    varlow = Left(Hex(Asc(varchar)),2)
			varhigh = right(Hex(Asc(varchar)),2)
			Str2Bin = Str2Bin & ChrB("&H" & varlow) & ChrB("&H" & varhigh)
		 Else
		    Str2Bin = Str2Bin & ChrB(Asc(varchar))
		 End If
	  Next
   End Function 
   
   Private Function Bin2Str(binData) 
      Dim i, iByt, sByt, bLen
	  bLen = LenB(binData)
	  For i = 1 To bLen 
	     sByt = MidB(binData, i, 1)
		 iByt = AscB(sByt)
		 If iByt < 128 Then
		    Bin2Str = Bin2Str & Chr(iByt)
		 Else
		    Bin2Str = Bin2Str & Chr(AscW(MidB(binData, i + 1, 1) & sByt))
			i = i + 1
		 End If 
      Next
   End Function 
   
   Private Function GetRndNumber()
      Dim RndN, DtNow
	  Randomize
	  DtNow = Now()
	  RndN=int(9999*rnd)+1000
	  GetRndNumber = year(DtNow) & right("0" & month(DtNow),2) & right("0" & day(DtNow),2) & right("0" & hour(DtNow),2) & right("0" & minute(DtNow),2) & right("0" & second(DtNow),2) & RndN
   End Function
   
End Class

%>