<!--＃i nclude FILE="Upload.inc"--> <% '----------------------------------------------------------------------- '--- 上传处理类模块 '--- Copyright (c) 2004 Aspsky, Inc. '--- Mail: Sunwin@artbbs.net http://www.aspsky.net '--- 2004-12-18 '----------------------------------------------------------------------- '----------------------------------------------------------------------- '-- InceptFileType : 设置上传类型属性 (以逗号分隔多个文件类型) String '-- MaxSize : 设置上传文件大小上限 (单位：kb) Long '-- InceptMaxFile : 设置一次上传文件最大个数 Long '-- UploadPath : 设置保存的目录相对路径 String '-- UploadType : 设置上传组件类型 （0=无组件上传类，1=Aspupload3.0 ,2=SA-FileUp 4.0 ,3=DvFile.Upload V1.0） '-- SaveUpFile : 执行上传 '-- GetBinary : 设置上传是否返回文件数据流 Bloon值 : True/False '-- ChkSessionName : 设置SESSION名，防止重复提交，SESSION名与提交的表单名要一致。 '-- RName设置文件名 : 定义文件名前缀 (如默认生成的文件名为200412230402587123.jpg ' 设置：RName="PRE_",生成的文件名为：PRE_200412230402587123.jpg) '----------------------------------------------------------------------- '-- 设置图片组件属性 '-- PreviewType : 设置组件(0=CreatePreviewImage组件，1=AspJpegV1.2 ,2=SoftArtisans ImgWriter V1.21) '-- PreviewImageWidth : 设置预览图片宽度 '-- PreviewImageHeight : 设置预览图片高度 '-- DrawImageWidth : 设置水印图片或文字区域宽度 '-- DrawImageHeight : 设置水印图片或文字区域高度 '-- DrawGraph : 设置水印图片或文字区域透明度 '-- DrawFontColor : 设置水印文字颜色 '-- DrawFontFamily : 设置水印文字字体格式 '-- DrawFontSize : 设置水印文字字体大小 '-- DrawFontBold : 设置水印文字是否粗体 '-- DrawInfo : 设置水印文字信息或图片信息 '-- DrawType : 设置加载水印模式：0=不加载水印 ，1=加载水印文字 ，2=加载水印图片 '-- DrawXYType : 图片添加水印LOGO位置坐标："0" =左上，"1"=左下,"2"=居中,"3"=右上,"4"=右下 '-- DrawSizeType : 生成预览图片大小规则："0"=固定缩小，"1"=等比例缩小 '----------------------------------------------------------------------- '-- 获取上传信息 '-- ObjName : 采用的组件名称 '-- Count : 上传文件总数 '-- CountSize : 上传总大小字节数 '-- ErrCodes : 错误NUMBER (默认为0) '-- Description : 错误描述 '----------------------------------------------------------------------- '-- CreateView Imagename,TempFilename,FileExt ' 创建预览图片过程: 原始文件的相对路径,生成预览文件相对路径,原文件后缀 '----------------------------------------------------------------------- '----------------------------------------------------------------------- '-- 获取文件对象属性 : UploadFiles '-- FormName : 表单名称 '-- FileName : 生成的文件名称 '-- FilePath : 保存文件的相对路径 '-- FileSize : 文件大小 '-- FileContentType : ContentType文件类型 '-- FileType : 0=其它,1=图片,2=FLASH,3=音乐,4=电影 '-- FileData : 文件数据流 (若组件不支持直接获取，则返回Null) '-- FileExt : 文件后缀 '-- FileWidth : 图片/Flash文件宽度 （其他文件默认=-1） '-- FileHeight : 图片/Flash文件高度 （其他文件默认=-1） '----------------------------------------------------------------------- '----------------------------------------------------------------------- '-- 获取表单对象属性 : UploadForms '-- Count : 表单数 '-- key : 表单内容 '----------------------------------------------------------------------- '----------------------------------------------------------------------- Class UpFile_Cls Private UploadObj,ImageObj Private FilePath,InceptFile,FileMaxSize,MaxFile,Upload_Type,FileInfo,IsBinary,SessionName Private Preview_Type,View_ImageWidth,View_ImageHeight,Draw_ImageWidth,Draw_ImageHeight,Draw_Graph Private Draw_FontColor,Draw_FontFamily,Draw_FontSize,Draw_FontBold,Draw_Info,Draw_Type,Draw_XYType,Draw_SizeType Private RName_Str,Transition_Color Public ErrCodes,ObjName,UploadFiles,UploadForms,Count,CountSize '----------------------------------------------------------------------------------- '初始化类 '----------------------------------------------------------------------------------- Private Sub Class_Initialize SessionName = Empty IsBinary = False ErrCodes = 0 Count = 0 CountSize = 0 FilePath = "./" InceptFile = "" FileMaxSize = -1 MaxFile = 1 Upload_Type = -1 Preview_Type = 999 ObjName = "未知组件" View_ImageWidth = 0 View_ImageHeight = 0 Draw_FontColor = &H000000 Draw_FontFamily = "Arial" Draw_FontSize = 10 Draw_FontBold = False Draw_Info = "WWW.OIOJ.NET" Draw_Type = -1 Set UploadFiles = Server.CreateObject ("Scripting.Dictionary") Set UploadForms = Server.CreateObject ("Scripting.Dictionary") UploadFiles.CompareMode = 1 UploadForms.CompareMode = 1 End Sub '----------------------------------------------------------------------------------- '销毁类 '----------------------------------------------------------------------------------- Private Sub Class_Terminate If IsObject(UploadObj) Then Set UploadObj = Nothing End If If IsObject(ImageObj) Then Set ImageObj = Nothing End If UploadFiles.RemoveAll UploadForms.RemoveAll Set UploadForms = Nothing Set UploadFiles = Nothing End Sub '----------------------------------------------------------------------------------- '设置上传是否返回文件数据流 '----------------------------------------------------------------------------------- Public Property Let GetBinary(Byval Values) IsBinary = Values End Property '----------------------------------------------------------------------------------- '设置上传类型属性 (以逗号分隔多个文件类型) '----------------------------------------------------------------------------------- Public Property Let InceptFileType(Byval Values) InceptFile = Lcase(Values) End Property '----------------------------------------------------------------------------------- '设置上传类型属性 (以逗号分隔多个文件类型) '----------------------------------------------------------------------------------- Public Property Let ChkSessionName(Byval Values) SessionName = Values End Property '----------------------------------------------------------------------------------- '设置上传文件大小上限 (单位：kb) '----------------------------------------------------------------------------------- Public Property Let MaxSize(Byval Values) FileMaxSize = ChkNumeric(Values) * 1024 End Property Public Property Get MaxSize MaxSize = FileMaxSize End Property '----------------------------------------------------------------------------------- '设置每次上传文件上限 '----------------------------------------------------------------------------------- Public Property Let InceptMaxFile(Byval Values) MaxFile = ChkNumeric(Values) End Property '----------------------------------------------------------------------------------- '设置上传目录路径 '----------------------------------------------------------------------------------- Public Property Let UploadPath(Byval Path) FilePath = Replace(Path,Chr(0),"") If Right(FilePath,1)<>"/" Then FilePath = FilePath & "/" End Property Public Property Get UploadPath UploadPath = FilePath End Property '----------------------------------------------------------------------------------- '获取错误信息 '----------------------------------------------------------------------------------- Public Property Get Description Select Case ErrCodes Case 1 : Description = "不支持 " & ObjName & " 上传，服务器可能未安装该组件。" Case 2 : Description = "暂未选择上传组件！" Case 3 : Description = "请先选择你要上传的文件!" Case 4 : Description = "文件大小超过了限制 " & (FileMaxSize 1024) & "KB!" Case 5 : Description = "文件类型不正确!" Case 6 : Description = "已达到上传数的上限！" Case 7 : Description = "请不要重复提交！" Case Else Description = Empty End Select End Property '----------------------------------------------------------------------------------- '设置文件名前缀 '----------------------------------------------------------------------------------- Public Property Let RName(Byval Values) RName_Str = Values End Property '----------------------------------------------------------------------------------- '设置上传组件属性 '----------------------------------------------------------------------------------- Public Property Let UploadType(Byval Types) Upload_Type = Types If Upload_Type = "" or Not IsNumeric(Upload_Type) Then Upload_Type = -1 End If End Property '----------------------------------------------------------------------------------- '设置上传图片组件属性 '----------------------------------------------------------------------------------- Public Property Let PreviewType(Byval Types) Preview_Type = Types On Error Resume Next If Preview_Type = "" or Not IsNumeric(Preview_Type) Then Preview_Type = 999 Else If PreviewType <> 999 Then Select Case Preview_Type Case 0 '---------------------CreatePreviewImage--------------- ObjName = "CreatePreviewImage组件" Set ImageObj = Server.CreateObject("CreatePreviewImage.cGvbox") Case 1 '---------------------AspJpegV1.2--------------- ObjName = "AspJpegV1.2组件" Set ImageObj = Server.CreateObject("Persits.Jpeg") Case 2 '---------------------SoftArtisans ImgWriter V1.21--------------- ObjName = "SoftArtisans ImgWriter V1.21组件" Set ImageObj = Server.CreateObject("SoftArtisans.ImageGen") Case Else Preview_Type = 999 End Select If Err.Number<>0 Then ErrCodes = 1 End If End If End If End Property Public Property Get PreviewType PreviewType = Preview_Type End Property '----------------------------------------------------------------------------------- '设置预览图片宽度属性 '----------------------------------------------------------------------------------- Public Property Let PreviewImageWidth(Byval Values) View_ImageWidth = ChkNumeric(Values) End Property '----------------------------------------------------------------------------------- '设置预览图片高度属性 '----------------------------------------------------------------------------------- Public Property Let PreviewImageHeight(Byval Values) View_ImageHeight = ChkNumeric(Values) End Property '----------------------------------------------------------------------------------- '设置水印图片或文字区域宽度属性 '----------------------------------------------------------------------------------- Public Property Let DrawImageWidth(Byval Values) Draw_ImageWidth = ChkNumeric(Values) End Property '----------------------------------------------------------------------------------- '设置水印图片或文字区域高度属性 '----------------------------------------------------------------------------------- Public Property Let DrawImageHeight(Byval Values) Draw_ImageHeight = ChkNumeric(Values) End Property '----------------------------------------------------------------------------------- '设置水印图片或文字区域透明度属性 '----------------------------------------------------------------------------------- Public Property Let DrawGraph(Byval Values) If IsNumeric(Values) Then Draw_Graph = Formatnumber(Values,2) Else Draw_Graph = 1 End If End Property '----------------------------------------------------------------------------------- '设置水印图片透明度去除底色值 '----------------------------------------------------------------------------------- Public Property Let TransitionColor(Byval Values) If Values<>"" or Values<>"0" Then Transition_Color = Replace(Values,"#","&h") End If End Property '----------------------------------------------------------------------------------- '设置水印文字颜色 '----------------------------------------------------------------------------------- Public Property Let DrawFontColor(Byval Values) If Values<>"" or Values<>"0" Then Draw_FontColor = Replace(Values,"#","&h") End If End Property '----------------------------------------------------------------------------------- '设置水印文字字体格式 '----------------------------------------------------------------------------------- Public Property Let DrawFontFamily(Byval Values) Draw_FontFamily = Values End Property '----------------------------------------------------------------------------------- '设置水印文字字体大小 '----------------------------------------------------------------------------------- Public Property Let DrawFontSize(Byval Values) Draw_FontSize = Values End Property '----------------------------------------------------------------------------------- '设置水印文字是否粗体 Boolean '----------------------------------------------------------------------------------- Public Property Let DrawFontBold(Byval Values) Draw_FontBold = ChkBoolean(Values) End Property '----------------------------------------------------------------------------------- '设置水印文字信息或图片信息 '----------------------------------------------------------------------------------- Public Property Let DrawInfo(Byval Values) Draw_Info = Values End Property '----------------------------------------------------------------------------------- '加载模式：0=不加载水印 ，1=加载水印文字 ，2=加载水印图片 '----------------------------------------------------------------------------------- Public Property Let DrawType(Byval Values) Draw_Type = ChkNumeric(Values) End Property '----------------------------------------------------------------------------------- '图片添加水印LOGO位置坐标："0" =左上，"1"=左下,"2"=居中,"3"=右上,"4"=右下 '----------------------------------------------------------------------------------- Public Property Let DrawXYType(Byval Values) Draw_XYType = Values End Property '----------------------------------------------------------------------------------- '生成预览图片大小规则："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) Dim RanNum,TempStr Randomize RanNum = Int(9000*rnd)+1000 TempStr = Year(now) & Month(now) & Day(now) & RanNum & "." & FileExt If RName_Str<>"" Then TempStr = RName_Str & TempStr End If 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","") FixName = Replace(FixName,"shtml","") 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" or FileExt="shtml" 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 () '取得上传数据 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) 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 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 = 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 FileName = FormatName(FileExt) 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 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 '原文件名 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) 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) 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 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("Persits.Jpeg") '*添加水印图片 添加时请关闭水印字体* '//读取添加的图片 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 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 Case "3" '右上 DrawImage_Y = SpaceVal Case "4" '右下 DrawImage_Y = yImage_H - yLogo_H - SpaceVal Case Else '不显示 DrawImage_Y = 0 End Select 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 %>