cls_upload.asp

后台管理系统

					UploadForms.Add i, FileField&i
				End If
				Set File=Nothing
			Next
			If Not IsEmpty(SessionName) Then Session(SessionName) = Empty
		End If
	End Sub

	' ============================================
	' LyfUpload.UploadFile组件
	' ============================================
	Private Sub SaveFile_5()
		On Error Resume Next
		Dim File,i,FileExt_a,TempExt,FileSize,F_Type
		Dim FileExt, FileName, FileType, FileToBinary,ClsImage,ImageWidth,ImageHeight
		UploadObj.MaxSize = FileMaxSize
		UploadObj.ExtName = InceptFile
		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 i=1 To UploadObj.Request("upcount")			
			If Count>MaxFile Then
				ErrCodes = 6
				Exit Sub
			End If
			FileExt_a=Split(UploadObj.Request(FileField&i),"""")
			TempExt	=FileExt_a(1)
			If TempExt="" or isnull(TempExt) then
				ErrCodes=3
				Exit Sub
			End If
			FileExt	=Mid(TempExt, InStrRev(TempExt, ".")+1)
			FileExt	=FixName(FileExt)
			FileType=CheckFiletype(FileExt)
			FileName = FormatName(FileExt)
			If CheckFileExt(FileExt)=False then
				ErrCodes=5
				Exit Sub
			End If
			File = UploadObj.SaveFile(FileField&i,Server.MapPath(FilePath),False,FileName)
			FileSize=UploadObj.FileSize 
			Select Case File
				Case ""
					ErrCodes=10
					Exit Sub
				Case "0"
					ErrCodes=4
					Exit Sub
				Case "1"
					ErrCodes=5
					Exit Sub
				Case "2"
					ErrCodes=11
					Exit Sub
				Case Else
					If IsBinary Then
						FileToBinary = UploadObj.SaveFiletodb(FileField&i)
					End If
					If FileType="1" Then
						Set ClsImage = New NetBuilderImage
						ClsImage.LoadFromFile(Server.MapPath(FilePath&FileName))
						ImageWidth=ClsImage.Width
						ImageHeight=ClsImage.Height
					Else
						ImageWidth=0
						ImageHeight=0
					End If
					AddData FileField&i , _ 
						FileName , _
						FilePath , _
						FileSize , _
						Trim(UploadObj.FileType(FileField&i)) , _
						FileType , _
						FileToBinary , _
						FileExt , _
						ImageHeight , _
						ImageWidth,_
						ClsPub.CreateId(0,RanNums)
					Count=Count+1
					CountSize = CountSize + FileSize
			End Select
			UploadForms.Add i, FileField&i
		Next
		If Not IsEmpty(SessionName) Then Session(SessionName) = Empty
	End Sub

	' ============================================
	' W3.UploadFile组件
	' ============================================
	Private Sub SaveFile_6()
		On Error Resume Next
		Dim i,File,UploadField,FileSize
		Dim FileExt, FileName, FileType, FileToBinary,ClsImage,ImageWidth,ImageHeight
		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 i=1 To UploadObj.Form("Upcount")
				If Count>MaxFile Then
					ErrCodes = 6
					Exit Sub
				End If
				Set UploadField=UploadObj.Form(FileField&i).Field(0)
				If UploadField.IsFile Then
					FileSize=UploadField.Size
					If FileSize>FileMaxSize Then
						ErrCodes=4
						Exit Sub
					End If
					FileName	= UploadField.FileName	
					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 = File.BinaryData
					End If
					If Not UploadField.IsEmpty Then
						UploadField.SaveToFile(Server.MapPath(FilePath&FileName))
						If FileType="1" Then
							Set ClsImage = New NetBuilderImage
							ClsImage.LoadFromFile(Server.MapPath(FilePath&FileName))
							ImageWidth=ClsImage.Width
							ImageHeight=ClsImage.Height
						Else
							ImageWidth=0
							ImageHeight=0
						End If
						AddData UploadField.Field(0).Name , _ 
							FileName , _
							FilePath , _
							FileSize , _
							UploadField.ContentType , _
							FileType , _
							FileToBinary , _
							FileExt , _
							ImageHeight , _
							ImageWidth,_
							ClsPub.CreateId(0,RanNums)
						Count=Count+1
						CountSize = CountSize + FileSize
					End If
					UploadForms.Add i, UploadField.Field(0).Name
				End If
			Next
	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,GetFile_Id )
		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
			FileInfo.GetFileId=GetFile_Id
			UploadFiles.Add Form_Name , FileInfo
		Set FileInfo = Nothing
	End Sub

	'创建预览图片:Call CreateView(原始文件的路径,预览文件名及路径,原文件后缀)
	Public Sub CreateView(Imagename, TempFilename, FileExt,IsCreatePreview,IsCreateLogoBox)
		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,IsCreatePreview,IsCreateLogoBox
			Case 2
				Image_Obj_2 Imagename, TempFilename, FileExt,IsCreatePreview,IsCreateLogoBox
			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,IsCreatePreview,IsCreateLogoBox)
			' 读取要处理的原文件
			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 IsCreateLogoBox=True Then
					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
				End If
				If IsCreatePreview=True Then
					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 If
	End Sub

	'SoftArtisans ImgWriter V1.21
	Public Sub Image_Obj_2(Imagename,TempFilename,FileExt,IsCreatePreview,IsCreateLogoBox)
			'定义变量
			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 IsCreateLogoBox=True Then
					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
				End If
				If IsCreatePreview=True Then
					'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 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(cType,StrPath)
		If cType=0 Then
			Dim UploadRootPathTemp,UploadRootPath,ObjFSO, Fsofolder, UpLoadPath,FormatTemplate,TempPath1,TempPath2,TempPath3,X
			Select Case AutoDir
				Case "0"
					FormatTemplate="[Y]-[M]-[D]"
				Case "1"
					FormatTemplate="[Y]-[M]"
				Case "2"
					FormatTemplate="[Y]-[M]-[D]-[H]"
				Case "3"
					FormatTemplate="[Y][M]"
				Case Else
					FormatTemplate=AutoDir
			End Select
			UpPathTemp=Trim(ClsPub.TW_Config(23))
			If Left(UpPathTemp,1)="/" Then UpPathTemp=Right(UpPathTemp,Len(UpPathTemp)-1) 
			UploadRootPath=SysPath&UpPathTemp
			If Right(UploadRootPath, 1) <> "/" Then UploadRootPath = UploadRootPath & "/"
			If ClsPub.CheckDir(UploadRootPath)=False Then
				ClsPub.MakeDir(UploadRootPath)
			End If
			If Right(StrPath, 1) <> "/" Then StrPath = StrPath & "/"
			TempPath1=Split(ClsPub.FormatMyDate(Now(),FormatTemplate),"-")
			For X=0 To Ubound(TempPath1)
				TempPath2=TempPath2&Trim(TempPath1(X))&"/"
				If ClsPub.CheckDir(StrPath&TempPath2)=False Then
					If ClsPub.MakeDir(StrPath&TempPath2)=False Then
						TempPath3=StrPath
						Exit For
					Else
						TempPath3=TempPath3&TempPath1(X)&"/"
					End If
				Else
					TempPath3=TempPath3&TempPath1(X)&"/"
				End If
			Next
			TempPath3=StrPath&TempPath3
			CreatePath=TempPath3
		ElseIf cType=1 Then
			Dim PreImgPathTemp,PreImgPath
			If Left(StrPath,1)="/" Then StrPath=Right(StrPath,Len(StrPath)-1)
			If Right(StrPath, 1) <> "/" Then StrPath = StrPath & "/"
			PreImgPath=SysPath&Trim(StrPath)
			If ClsPub.CheckDir(PreImgPath)=False Then
				ClsPub.MakeDir(PreImgPath)
			End If
			CreatePath=StrPath
		End If
	End Function
End Class

Class FileInfo_Cls
	Public FormName, FileName, FilePath, FileSize, FileContentType, FileType, FileData, FileExt, FileWidth, FileHeight,GetFileId
	Private Sub Class_Initialize
		FileWidth = -1
		FileHeight = -1
	End Sub
End Class
%>