ASP图片上传处理模块

<!--＃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 
%>