ixs_clsupload.asp

这个是一个<图片系统>,但是又是不能用的..所以..上传上来..等你们改良一下

		End If
	End Function
	' ============================================
	' 检测是否Bool型
	' ============================================
	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
	' ============================================
	' 日期时间定义文件名()
	' FormatType说明：
	'   0 = 自动生成14位时间＋5位随机数命名
	'   1 = 使用文件原名称命名
	'   2 = 使用指定的名称命名（自定义命名）
	' ============================================
	Private Function FormatName(Byval FileExt)
		Dim RanNum, TempStr
		Select Case FormatType
			Case 1 ' 原文件名
				TempStr = OldFileName
			'Case 2 ' 自定义文件名
			'	TempStr = DiyFileName
			Case Else ' 自动文件名
				TempStr = OldFileName
		End Select
		' 添加文件名前缀
		If RName_Str <> "" Then TempStr =  TempStr
		FormatName = TempStr
	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
	' ============================================
	' 判断文件类型
	' ============================================
	Private Function CheckFiletype(Byval FileExt)
		FileExt = "|" & LCase(Replace(FileExt, ".", "")) & "|"
		FileExt_1 = "|" & LCase(FileExt_1) & "|"
		FileExt_2 = "|" & LCase(FileExt_2) & "|"
		FileExt_3 = "|" & LCase(FileExt_3) & "|"
		FileExt_4 = "|" & LCase(FileExt_4) & "|"
		FileExt_5 = "|" & LCase(FileExt_5) & "|"
		FileExt_6 = "|" & LCase(FileExt_6) & "|"
		If InStr(FileExt_1, FileExt) > 0 Then
			CheckFiletype = 1 ' 图像类
			Exit Function
		ElseIf InStr(FileExt_2, FileExt) > 0 Then
			CheckFiletype = 2 ' 动画类
			Exit Function
		ElseIf InStr(FileExt_3, FileExt) > 0 Then
			CheckFiletype = 3 ' 音频类 全部采用Windows Media Player播放
			Exit Function
		ElseIf InStr(FileExt_4, FileExt) > 0 Then
			CheckFiletype = 4 ' RealPlayer 文件类型
			Exit Function
		ElseIf InStr(FileExt_5, FileExt) > 0 Then
			CheckFiletype = 5 ' Windows Media 视频文件类型
			Exit Function
		ElseIf InStr(FileExt_6, FileExt) > 0 Then
			CheckFiletype = 6 ' 其他类
			Exit Function
		Else
			CheckFiletype = 0 ' 未知
			Exit Function
		End If
	End Function
	' ============================================
	' 执行保存上传文件
	' ============================================
	Public Sub SaveUpFile()
		On Error Resume Next
		Select Case CInt(Upload_Type)
			Case 0
				ObjName = "爱雪儿无组件上传类 Version 1.1.0" ' 爱雪儿无组件上传类 Version 1.1.0
				Set UploadObj = New iXs_ClsUp
				If Err.Number<>0 Then
					ErrCodes = 1
				Else
					SaveFile_0
				End If
			Case 1
				ObjName = "Aspupload3.0组件"
				Set UploadObj = Server.CreateObject(ServerObject_011) 
				If Err.Number<>0 Then
					ErrCodes = 1
				Else
					SaveFile_1
				End If
			Case 2
				ObjName = "SA-FileUp 4.0组件"
				Set UploadObj = Server.CreateObject(ServerObject_013)
				If Err.Number<>0 Then
					ErrCodes = 1
				Else
					SaveFile_2
				End If
			Case 3
				ObjName = "DvFile.Upload V1.0组件"
				Set UploadObj = Server.CreateObject(ServerObject_014)
				If Err.Number<>0 Then
					ErrCodes = 1
				Else
					SaveFile_3
				End If
			Case Else
				ErrCodes = 2
		End Select
	End Sub
	' ========================================================================================
	' 上传处理过程
	' ========================================================================================
	' ============================================
	' 爱雪儿无组件上传类 Version 1.1.0
	' ============================================
	Private Sub SaveFile_0()
		Dim i
		Dim FormName,Item, File
		Dim FileExt, FileName, FileType, FileToBinary, FileSize
		' 设置属性
		UploadObj.MaxSize 	= FileMaxSize	' 单文件大小
		UploadObj.FileType  = Replace(InceptFile, ",", "/")	' 文件类型
		UploadObj.SavePath 	= FilePath	' 保存路径
		UploadObj.UpLoadPID = p_UpLoadPID ' 上传进度数据文件名称
		UploadObj.UpLoaddingDataDir = UpLoaddingDataDir
		UploadObj.AutoSave 	= 2 ' 设置为手动保存
		UploadObj.Open() ' 打开对象
		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.Error > 0 then
			Select Case UploadObj.Error
				Case 1 : ErrCodes = 4
				Case 2 : ErrCodes = 5
				Case 3 : ErrCodes = 8
				Case 4 : ErrCodes = 9
			End Select
			Exit Sub
		Else
			' 执行保存
			For i = 1 To UBound(UploadObj.FileItem) 		''列出所有上传了的文件
				FormName = UploadObj.FileItem(i)
				If Count > MaxFile Then
					ErrCodes = 6
					Exit Sub
				End If
				OldFileName = UploadObj.Form(FormName & "_Name") ' 原文件名
				FileExt = LCase(UploadObj.Form(FormName & "_Ext")) ' 检测文件扩展名
				FileName = FormatName(FileExt) ' 检测文件名
				FileType = CheckFiletype(FileExt) ' 检测文件类型
				If IsBinary Then
					FileToBinary = UploadObj.GetData(FormName)
				End If
				FileSize = ChkNumeric(UploadObj.Form(FormName & "_Size"))
				If FileSize > 0 Then
					UploadObj.Save FormName, FileName
					AddData FormName , _ 
							FileName , _
							FilePath , _
							FileSize , _
							UploadObj.Form(FormName & "_Type") , _
							FileType , _
							FileToBinary , _
							FileExt , _
							UploadObj.Form(FormName & "_Width") , _
							UploadObj.Form(FormName & "_Height")
					Count = Count + 1
					CountSize = CountSize + UploadObj.Form(FormName & "_Size")
				End If
			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
			' 清理上传进度数据
			Call DeleteUpDateFile(UpLoaddingDataDir)
			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.ProgressID = p_UploadPID
		UploadObj.OverwriteFiles = False		'不能复盖
		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
					OldFileName = File.FileName' 原文件名
					FileName = FormatName(FileExt)
					FileType = CheckFiletype(FileExt)
					If IsBinary Then
						FileToBinary = File.Binary
					End If
					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
						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 = False
					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
						Exit Sub
					End If
					FileName	= UploadObj.Form(FormName).ShortFileName	 '原文件名
					OldFileName = FileName
					FileExt		= Mid(Filename, InStrRev(Filename, ".")+1)
					FileExt		= FixName(FileExt)
					If CheckFileExt(FileExt) = False then
						ErrCodes = 5
						Exit Sub
					End If
					FileName = FormatName(FileExt)
					FileType = CheckFiletype(FileExt)
					'If IsBinary Then
						'FileToBinary = UploadContents (2)
					'End If
					'保存文件
					If Filesize>0 Then
						UploadObj.Form(FormName).SaveAs Server.MapPath(FilePath & FileName)
						AddData FormName , _ 
								FileName , _
								FilePath , _
								FileSize , _
								UploadObj.Form(FormName).ContentType , _
								FileType , _
								FileToBinary , _
								FileExt , _
								-1 , _
								-1
						Count = Count + 1
						CountSize = CountSize + Filesize
					End If
				Else
					ErrCodes = 3
					Exit Sub
				End If
			Else
				If UploadObj.FormEx(FormName).Count > 1 Then
					For Each FormNames In UploadObj.FormEx(FormName)