ixs_clsupload.asp

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

						FormNames = FormNames & ", " & FormNames
					Next
					UploadForms.Add FormName , FormNames
				Else
					UploadForms.Add FormName , UploadObj.Form(FormName)
				End If
			End If
		Next
		If Not IsEmpty(SessionName) Then Session(SessionName) = Empty
	End Sub
	' ============================================
	' DvFile.Upload V1.0组件上传
	' ============================================
	Private Sub SaveFile_3()
		Dim FormName, Item, File
		Dim FileExt, FileName, FileType, FileToBinary
		UploadObj.InceptFileType = InceptFile
		UploadObj.MaxSize = FileMaxSize
		UploadObj.Install
		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
				Case 4 : ErrCodes = 5
				Case 5 : ErrCodes = -1
			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)
				OldFileName = File.FileName ' 原文件名
				FileType = CheckFiletype(FileExt)
				If IsBinary Then
					FileToBinary = File.FileData
				End If
				If File.FileSize>0 Then
					UploadObj.SaveToFile Server.mappath(FilePath & FileName), FormName
					AddData FormName , _ 
							FileName , _
							FilePath , _
							File.FileSize , _
							File.FileType , _
							FileType , _
							FileToBinary , _
							FileExt , _
							File.FileWidth , _
							File.FileHeight
					Count = Count + 1
					CountSize = CountSize + File.FileSize
				End If
				Set File=Nothing
			Next
			For Each Item in UploadObj.Form
				UploadForms.Add Item.Name , Item.Value
			Next
			If Not IsEmpty(SessionName) Then Session(SessionName) = Empty
		End If
	End Sub

	Private Sub AddData( Form_Name, File_Name, File_Path, File_Size, File_ContentType, File_Type, File_Data, File_Ext, File_Width, File_Height )
		Set FileInfo = New FileInfo_Cls
			FileInfo.FormName = Form_Name
			FileInfo.FileName = File_Name
			FileInfo.FilePath = File_Path
			FileInfo.FileSize = File_Size
			FileInfo.FileType = File_Type
			FileInfo.FileContentType = File_ContentType
			FileInfo.FileExt = File_Ext
			FileInfo.FileData = File_Data
			FileInfo.FileHeight = File_Height
			FileInfo.FileWidth = File_Width
			UploadFiles.Add Form_Name , FileInfo
		Set FileInfo = Nothing
	End Sub

	'创建预览图片:Call CreateView(原始文件的路径,预览文件名及路径,原文件后缀)
	Public Sub CreateView(Imagename, TempFilename, FileExt)
		If ErrCodes <>0 Then Exit Sub
		Select Case Preview_Type
			Case 0
				Image_Obj_0 Imagename, TempFilename, FileExt
			Case 1
				Image_Obj_1 Imagename, TempFilename, FileExt
			Case 2
				Image_Obj_2 Imagename, TempFilename, FileExt
			Case Else
				Preview_Type = 999
		End Select
	End Sub

	Sub Image_Obj_0(Imagename,TempFilename,FileExt)
			ImageObj.SetSavePreviewImagePath = Server.MapPath(TempFilename)			'预览图存放路径
			ImageObj.SetPreviewImageSize = SetPreviewImageSize						'预览图宽度
			ImageObj.SetImageFile = Trim(Server.MapPath(Imagename))					'Imagename原始文件的物理路径
			'创建预览图的文件
			If ImageObj.DoImageProcess = False Then
				ErrCodes = -1
				Response.Write "生成预览图错误: " & ImageObj.GetErrString
			End If
	End Sub

	'---------------------AspJpegV1.2---------------
	Sub Image_Obj_1(Imagename,TempFilename,FileExt)
			' 读取要处理的原文件
			Dim Draw_X,Draw_Y,Logobox
			Draw_X = 0
			Draw_Y = 0
			FileExt = LCase(FileExt)
			ImageObj.Open Trim(Server.MapPath(Imagename))
			If ImageObj.OriginalWidth<View_ImageWidth or ImageObj.Originalheight<View_ImageHeight Then
				TempFilename = ""
				Exit Sub
			Else
				If FileExt<>"gif" and ImageObj.OriginalWidth > Draw_ImageWidth * 2 and Draw_Type >0 Then
					Draw_X = DrawImage_X(ImageObj.OriginalWidth,Draw_ImageWidth,2)
					Draw_Y = DrawImage_y(ImageObj.Originalheight,Draw_ImageHeight,2)
					If Draw_Type=2 Then
						Set Logobox = Server.CreateObject(ServerObject_016)
						'*添加水印图片	添加时请关闭水印字体*
						'//读取添加的图片
						Logobox.Open Server.MapPath(Draw_Info)
						Logobox.Width = Draw_ImageWidth								'// 加入图片的原宽度
						Logobox.Height = Draw_ImageHeight							'// 加入图片的原高度
						ImageObj.DrawImage Draw_X, Draw_Y, Logobox, Draw_Graph,Transition_Color,90	'// 加入图片的位置价坐标（添加水印图片）
						'ImageObj.Sharpen 1, 130
						ImageObj.Save Server.MapPath(Imagename)
						Set Logobox=Nothing
					Else
						'//关于修改字体及文字颜色的
						ImageObj.Canvas.Font.Color		= Draw_FontColor	'// 文字的颜色
						ImageObj.Canvas.Font.Family		= Draw_FontFamily	'// 文字的字体
						ImageObj.Canvas.Font.Bold		= Draw_FontBold
						ImageObj.Canvas.Font.Size		= Draw_FontSize					'//字体大小
						' Draw frame: black, 2-pixel width
						ImageObj.Canvas.Print Draw_X, Draw_Y, Draw_Info	'// 加入文字的位置坐标
						ImageObj.Canvas.Pen.Color		= &H000000		'// 边框的颜色
						ImageObj.Canvas.Pen.Width		= 1				'// 边框的粗细
						ImageObj.Canvas.Brush.Solid	= False			'// 图片边框内是否填充颜色
						'ImageObj.Canvas.Bar 0, 0, ImageObj.Width, ImageObj.Height	'// 图片边框线的位置坐标
						ImageObj.Save Server.MapPath(Imagename)
					End If
				End If
				If ImageObj.Width > ImageObj.height Then
					ImageObj.Width = View_ImageWidth
					ImageObj.Height = ViewImage_Height(ImageObj.OriginalWidth,ImageObj.Originalheight,View_ImageWidth,View_ImageHeight)
				Else
					ImageObj.Width = ViewImage_Width(ImageObj.OriginalWidth,ImageObj.Originalheight,View_ImageWidth,View_ImageHeight)
					ImageObj.Height = View_ImageHeight
				End If
				ImageObj.Sharpen 1, 120
				ImageObj.Save Server.MapPath(TempFilename)		'// 生成预览文件
			End If
	End Sub

	'SoftArtisans ImgWriter V1.21
	Public Sub Image_Obj_2(Imagename,TempFilename,FileExt)
			'定义变量
			Dim Draw_X,Draw_Y
			FileExt = LCase(FileExt)
			Draw_X = 0
			Draw_Y = 0
			' 读取要处理的原文件
			ImageObj.LoadImage Trim(Server.MapPath(Imagename))
			If ImageObj.ErrorDescription <> "" Then
				TempFilename = ""
				ErrCodes = -1
				Response.Write "生成预览图错误: " &ImageObj.ErrorDescription
				Exit Sub
			End If
			If ImageObj.Width<Cint(View_ImageWidth) or ImageObj.Height<Cint(View_ImageHeight) Then
				TempFilename=""
				Exit Sub
			Else
				IF FileExt<>"gif" and ImageObj.Width > Draw_ImageWidth * 2 and Draw_Type>0 Then
					Draw_X = DrawImage_X(ImageObj.Width,Draw_ImageWidth,2)
					Draw_Y = DrawImage_y(ImageObj.Height,Draw_ImageHeight,2)
					Dim saiTopMiddle
					Select Case Draw_XYType
						Case "0" '左上
							saiTopMiddle = 3
						Case "1" '左下
							saiTopMiddle = 5
						Case "2" '居中
							saiTopMiddle = 1
						Case "3" '右上
							saiTopMiddle = 6
						Case "4" '右下
							saiTopMiddle = 8
						Case Else '不显示
							saiTopMiddle = 0
					End Select
					If Draw_Type=2 Then
						ImageObj.AddWatermark Server.MapPath(Draw_Info), saiTopMiddle, Draw_Graph,Transition_Color,True
						'ImageObj.AddWatermark Server.MapPath(Request.QueryString("mimg")), 0, 0.3
					Else
						ImageObj.Font.Italic	= False			'斜体
						ImageObj.Font.height	= Draw_FontSize
						ImageObj.Font.name		= Draw_FontFamily
						ImageObj.Font.Color		= Draw_FontColor
						ImageObj.Text			= Draw_Info
						ImageObj.DrawTextOnImage Draw_X, Draw_Y, ImageObj.TextWidth, ImageObj.TextHeight
					End If
					ImageObj.SaveImage 0, ImageObj.ImageFormat, Server.MapPath(Imagename)
				End If
				'ImageObj.SharpenImage 100
				ImageObj.ColorResolution = 24	'24色保存
				ImageObj.ResizeImage View_ImageWidth,View_ImageHeight,0,0
				'0=saiFile,1=saiMemory,2=saiBrowser,4=saiDatabaseBlob
				'saiBMP=1,saiGIF=2,saiJPG=3,saiPNG=4,saiPCX=5,saiTIFF=6,saiWMF=7,saiEMF=8,saiPSD=9 
				ImageObj.SaveImage 0, 3, Server.MapPath(TempFilename)
			End If
	End Sub

	'比例或固定缩小
	Private Function ViewImage_Width(Image_W,Image_H,xView_W,xView_H)
		If Draw_SizeType = "1" Then
			ViewImage_Width = Image_W * xView_H / Image_H
		Else
			ViewImage_Width = xView_W
		End If
	End Function


	Private Function ViewImage_Height(Image_W,Image_H,xView_W,xView_H)
		If Draw_SizeType = "1" Then
			ViewImage_Height = xView_W * Image_H / Image_W
		Else
			ViewImage_Height = xView_H
		End If
	End Function

	'SpaceVal X轴坐标边缘距离
	Private Function DrawImage_X(xImage_W,xLogo_W,SpaceVal)
		Select Case Draw_XYType
			Case "0" '左上
				DrawImage_X = SpaceVal
			Case "1" '左下
				DrawImage_X = SpaceVal
			Case "2" '居中
				DrawImage_X = (xImage_W + xLogo_W) / 2 - xLogo_W ' By:Guidy
			Case "3" '右上
				DrawImage_X = xImage_W - xLogo_W - SpaceVal
			Case "4" '右下
				DrawImage_X = xImage_W - xLogo_W - SpaceVal
			Case Else '不显示
				DrawImage_X = 0
		End Select
	End Function

	'SpaceVal Y轴坐标边缘距离
	Private Function DrawImage_Y(yImage_H,yLogo_H,SpaceVal)
		Select Case Draw_XYType
			Case "0" '左上
				DrawImage_Y = SpaceVal
			Case "1" '左下
				DrawImage_Y = yImage_H - yLogo_H - SpaceVal
			Case "2" '居中
				DrawImage_Y = (yImage_H + yLogo_H) / 2 - yLogo_H ' By:Guidy
			Case "3" '右上
				DrawImage_Y = SpaceVal
			Case "4" '右下
				DrawImage_Y = yImage_H - yLogo_H - SpaceVal
			Case Else '不显示
				DrawImage_Y = 0
		End Select
	End Function
	' ============================================
	' 检测文件夹是否存在 如果不存在就自动创建
	' ============================================
	Function CreatePath(StrPath)
		Dim ObjFSO, Fsofolder, UpLoadPath
		UpLoadPath = FormatTime(Now(), AutoDir)
		On Error Resume Next
		If Right(StrPath, 1) <> "/" Then StrPath = StrPath & "/"
		Set ObjFSO = Server.CreateObject(ServerObject_005)
			If ObjFSO.FolderExists(Server.MapPath(StrPath & UpLoadPath)) = False Then
				ObjFSO.CreateFolder Server.MapPath(StrPath & UpLoadPath)
			End If
			If Err.Number = 0 Then
				CreatePath = StrPath & UpLoadPath & "/"
			Else
				Err.Clear
				CreatePath = StrPath
			End If
		Set ObjFSO = Nothing
	End Function
End Class

Class FileInfo_Cls
	Public FormName, FileName, FilePath, FileSize, FileContentType, FileType, FileData, FileExt, FileWidth, FileHeight
	Private Sub Class_Initialize
		FileWidth = -1
		FileHeight = -1
	End Sub
End Class
' ============================================
' 删除指定文件夹下的所有文件
' 这里用来删除"UpLoadData/"文件夹下面的文件
' ============================================
Function DeleteUpDateFile(FilePath)
	On Error Resume Next
	If Right(FilePath, 1) <> "/" Then FilePath = FilePath & "/"
	DeleteUpDateFile = False
	Dim Fso, F, F1, Fc, S
	Set Fso = CreateObject(ServerObject_005)
	If Err Then Err.Clear : Exit Function
	Set F = Fso.GetFolder(Server.MapPath(FilePath))
	Set Fc = F.Files
	For Each F1 In Fc
		Fso.DeleteFile(Server.MapPath(FilePath & F1.Name))
	Next
	Set Fc = Nothing
	Set Fso = Nothing
	DeleteUpDateFile = True
End Function
' ============================================
' 格式化时间(用于显示)
' ============================================
Public Function FormatTime(s_Time, n_Flag)
	If Not IsDate(s_Time) Then Exit Function
	Dim y, m, d, h, mi, s, w
	
	FormatTime = ""
	
	y = CStr(Year(s_Time))
	m = CStr(Month(s_Time))
	If Len(m) = 1 Then m = "0" & m
	d = CStr(Day(s_Time))
	If Len(d) = 1 Then d = "0" & d
	h = CStr(Hour(s_Time))
	If Len(h) = 1 Then h = "0" & h
	mi = CStr(Minute(s_Time))
	If Len(mi) = 1 Then mi = "0" & mi
	s = CStr(Second(s_Time))
	If Len(s) = 1 Then s = "0" & s
	
	Select Case n_Flag
		Case 1 ' yyyymmddhhmmss
			FormatTime = y & m & d & h & mi & s
		Case 2 ' yyyy-mm-dd
			FormatTime = y & "-" & m & "-" & d
		Case 3 ' YYYY-mm
			FormatTime = Y & "-" & m
		Case Else ' YYYY-mm
			FormatTime = Y & "-" & m
	End Select
End Function
%>