upload_class.asp

学校管理源码

	'-----------------------------------------------------------------------------------
	'生成预览图片大小规则："0"=固定缩小，"1"=等比例缩小
	'-----------------------------------------------------------------------------------
	Public Property Let DrawSizeType(Byval Values)
		Draw_SizeType = Values
	End Property

	Private Function ChkNumeric(Byval Values)
		If Values<>"" and Isnumeric(Values) Then
			ChkNumeric = Int(Values)
		Else
			ChkNumeric = 0
		End If
	End Function

	Private Function ChkBoolean(Byval Values)
		If Typename(Values)="Boolean" or IsNumeric(Values) or Lcase(Values)="false" or Lcase(Values)="true" Then
			ChkBoolean = CBool(Values)
		Else
			ChkBoolean = False
		End If
	End Function

	'-----------------------------------------------------------------------------------
	'日期时间定义文件名
	'-----------------------------------------------------------------------------------
	Private Function FormatName(Byval FileExt,Byval FileName)
		If ReName=1 Then
			FormatName = FixFileName(FileName)
			Exit Function
		End If
		Dim RanNum,TempStr
		Randomize
		RanNum = Int(90000*rnd)+10000
		TempStr = Year(now) & Month(now) & Day(now) & Hour(now) & Minute(now) & Second(now) & RanNum & "." & FileExt
		If RName_Str<>"" Then
			TempStr = RName_Str & TempStr
		End If
		FormatName = TempStr
	End Function
	'-----------------------------------------------------------------------------------
	'格式后缀
	'-----------------------------------------------------------------------------------
	Private Function FixFileName(Byval FName)
		If IsEmpty(FName) Then Exit Function
		FixFileName = Lcase(Trim(FName))
		FixFileName = Replace(FixFileName,Chr(0),"")
		FixFileName = Replace(FixFileName,"..","")
		FixFileName = Replace(FixFileName,"'","")
		FixFileName = Replace(FixFileName,"/","")
		FixFileName = Replace(FixFileName,"\","")
		FixFileName = Replace(FixFileName,"[","")
		FixFileName = Replace(FixFileName,"]","")
		FixFileName = Replace(FixFileName,"<","")
		FixFileName = Replace(FixFileName,">","")
	End Function
	'-----------------------------------------------------------------------------------
	'格式后缀
	'-----------------------------------------------------------------------------------
	Private Function FixName(Byval UpFileExt)
		If IsEmpty(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 CheckFileExt(FileExt)
		Dim Forumupload,i
		CheckFileExt=False
		If FileExt="" or IsEmpty(FileExt) Then
			CheckFileExt = False
			Exit Function
		End If
		If FileExt="asp" or FileExt="asa" or FileExt="aspx" Then
			CheckFileExt = False
			Exit Function
		End If
		Forumupload = Split(InceptFile,",")
		For i = 0 To ubound(Forumupload)
			If FileExt = Trim(Forumupload(i)) Then
				CheckFileExt = True
				Exit Function
			Else
				CheckFileExt = False
			End If
		Next
	End Function

	'-----------------------------------------------------------------------------------
	'判断文件类型:0=其它,1=图片,2=FLASH,3=音乐,4=电影
	'-----------------------------------------------------------------------------------
	Private Function CheckFiletype(Byval FileExt)
		FileExt = Lcase(Replace(FileExt,".",""))
		Select Case FileExt
				Case "gif", "jpg", "jpeg","png","bmp","tif","iff"
					CheckFiletype=1
				Case "swf", "swi"
					CheckFiletype=2
				Case "mid", "wav", "mp3","rmi","cda"
					CheckFiletype=3
				Case "avi", "mpg", "mpeg","ra","ram","wov","asf"
					CheckFiletype=4
				Case Else
					CheckFiletype=0
		End Select
	End Function

	'-----------------------------------------------------------------------------------
	'执行保存上传文件
	'-----------------------------------------------------------------------------------
	Public Sub SaveUpFile()
		On Error Resume Next
		Select Case (Upload_Type)
			Case 0
				ObjName = "无组件"
				Set UploadObj = New UpFile_Class
				If Err.Number<>0 Then
					ErrCodes = 1
				Else
					SaveFile_0
				End If
			Case 1
				ObjName = "Aspupload3.0组件"
				Set UploadObj = Server.CreateObject("Persits.Upload") 
				If Err.Number<>0 Then
					ErrCodes = 1
				Else
					SaveFile_1
				End If
			Case 2
				ObjName = "SA-FileUp 4.0组件"
				Set UploadObj = Server.CreateObject("SoftArtisans.FileUp")
				If Err.Number<>0 Then
					ErrCodes = 1
				Else
					SaveFile_2
				End If
			Case 3
				ObjName = "DvFile.Upload V1.0组件"
				Set UploadObj = Server.CreateObject("DvFile.Upload")
				If Err.Number<>0 Then
					ErrCodes = 1
				Else
					SaveFile_3
				End If
			Case Else
				ErrCodes = 2
		End Select
	End Sub

	''-----------------------------------------------------------------------------------
	' 上传处理过程
	''-----------------------------------------------------------------------------------
	''-----------------------------------------------------------------------------------
	''无组件上传
	''-----------------------------------------------------------------------------------
	Private Sub SaveFile_0()
		Dim FormName,Item,File
		Dim FileExt,FileName,FileType,FileToBinary
		UploadObj.InceptFileType = InceptFile
		UploadObj.MaxSize = FileMaxSize
		UploadObj.GetDate()	'取得上传数据
		
		If Err <> 0 Then
			ErrCodes = -1
			Response.Write "错误信息: " & Err.Description
			EXIT SUB
		End If
		FileToBinary = Null
		If Not IsEmpty(SessionName) Then
			If Session(SessionName) <> UploadObj.Form(SessionName) or Session(SessionName) = Empty Then
				ErrCodes = 7
				Exit Sub
			End If
		End If
		If UploadObj.Err > 0 then
			Select Case UploadObj.Err
				Case 1 : ErrCodes = 3
				Case 2 : ErrCodes = 4
				Case 3 : ErrCodes = 5
			End Select
			Exit Sub
		Else
			For Each FormName In UploadObj.File		''列出所有上传了的文件
				If Count>MaxFile Then
					ErrCodes = 6
					Exit Sub
				End If
				Set File = UploadObj.File(FormName)
				FileExt = FixName(File.FileExt)
				If CheckFileExt(FileExt) = False then
					ErrCodes = 5
					EXIT SUB
				End If
				FileName = FormatName(FileExt,File.FileName)
				FileType = CheckFiletype(FileExt)
				If IsBinary Then
					FileToBinary = File.FileData
				End If
				If File.FileSize>0 Then
					File.SaveToFile Server.Mappath(FilePath & FileName)
					AddData FormName , _ 
							FileName , _
							FilePath , _
							File.FileSize , _
							File.FileType , _
							FileType , _
							FileToBinary , _
							FileExt , _
							File.FileWidth , _
							File.FileHeight, _
							FixFileName(File.FileName)

					Count = Count + 1
					CountSize = CountSize + File.FileSize
				End If
				Set File=Nothing
			Next
			For Each Item in UploadObj.Form
				If UploadForms.Exists (Item) Then _
					UploadForms(Item) = UploadForms(Item) & ", " & UploadObj.Form(Item) _
				Else _
				UploadForms.Add Item , UploadObj.Form(Item)
			Next
			If Not IsEmpty(SessionName) Then Session(SessionName) = Empty
		End If
	End Sub
	''-----------------------------------------------------------------------------------
	''Aspupload3.0组件上传
	''-----------------------------------------------------------------------------------
	Private Sub SaveFile_1()
		Dim FileCount
		Dim FormName,Item,File
		Dim FileExt,FileName,FileType,FileToBinary
		UploadObj.OverwriteFiles = True		'不能复盖
		UploadObj.IgnoreNoPost = True
		UploadObj.SetMaxSize FileMaxSize, True	'限制大小
		FileCount = UploadObj.Save
		FileToBinary = Null
		If Not IsEmpty(SessionName) Then
			If Session(SessionName) <> UploadObj.Form(SessionName) or Session(SessionName) = Empty Then
				ErrCodes = 7
				Exit Sub
			End If
		End If

		If Err.Number = 8 Then
				ErrCodes = 4
				EXIT SUB
		Else 
				If Err <> 0 Then
					ErrCodes = -1
					Response.Write "错误信息: " & Err.Description
					EXIT SUB
				End If
				If FileCount < 1 Then 
					ErrCodes = 3
					EXIT SUB
				End If
				For Each File In UploadObj.Files	'列出所有上传文件
					If Count>MaxFile Then
						ErrCodes = 6
						Exit Sub
					End If
					FileExt = FixName(Replace(File.Ext,".",""))
					If CheckFileExt(FileExt) = False then
						ErrCodes = 5
						EXIT SUB
					End If
					FileName = FormatName(FileExt,File.FileName)
					FileType = CheckFiletype(FileExt)
					If IsBinary Then
						FileToBinary = File.Binary
					End If
					'File.Filename
					If File.Size>0 Then
						File.SaveAs Server.Mappath(FilePath & FileName)
						AddData File.Name , _ 
							FileName , _
							FilePath , _
							File.Size , _
							File.ContentType , _
							FileType , _
							FileToBinary , _
							FileExt , _
							File.ImageWidth , _
							File.ImageHeight, _
							FixFileName(File.FileName)
						Count = Count + 1
						CountSize = CountSize + File.Size
					End If
				Next
				For Each Item in UploadObj.Form
					If UploadForms.Exists (Item) Then _
						UploadForms(Item) = UploadForms(Item) & ", " & Item.Value _
					Else _
						UploadForms.Add Item.Name , Item.Value
				Next
				If Not IsEmpty(SessionName) Then Session(SessionName) = Empty
		End If
	End Sub
	''-----------------------------------------------------------------------------------
	''SA-FileUp 4.0组件上传FileUpSE V4.09
	''-----------------------------------------------------------------------------------
	Private Sub SaveFile_2()
		Dim FormName,Item,File,FormNames
		Dim FileExt,FileName,FileType,FileToBinary
		Dim Filesize
		FileToBinary = Null
		If Not IsEmpty(SessionName) Then
			If Session(SessionName) <> UploadObj.Form(SessionName) or Session(SessionName) = Empty Then
				ErrCodes = 7
				Exit Sub
			End If
		End If
		For Each FormName In UploadObj.Form
			FormNames = ""
			If IsObject(UploadObj.Form(FormName)) Then
				If Not UploadObj.Form(FormName).IsEmpty Then
					UploadObj.Form(FormName).Maxbytes = FileMaxSize	'限制大小
					UploadObj.OverWriteFiles = True	'复盖原文件
					Filesize = UploadObj.Form(FormName).TotalBytes
					If Err.Number<>0 Then
						ErrCodes = -1
						Response.Write "错误信息: " & Err.Description
						EXIT SUB
					End If
					If Filesize>FileMaxSize then
						ErrCodes = 4