📄 cls_upload.asp
字号:
<!--#include file="Cls_UpLoadClass.asp" -->
<!--#include file="Cls_Image.asp" -->
<%
'==============================================================================
'软件名称：拓网文件上传提取系统
'当前版本：拓网文件上传提取系统1.0(TopWang Upload V1.0)
'Copyright (C) 2003-2006 TopWang.Com All rights reserved.
'产品咨询QQ：36355735
'程序开发：拓网产品开发组
'Email:Service@TopWang.Com
'官方网站：www.TopWang.com
'论坛支持：拓网在线论坛(http://bbs.TopWang.com)
'免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接
'==============================================================================
'==============================================================================
'文件名:Cls_UpLoad.asp
'摘 要:上传处理类,此类修改自动网论坛
'作 者:拓网产品开发组
'更 新:2006-2-10
'==============================================================================
Class Cls_Upload
Private UploadObj, ImageObj
Private FilePath, InceptFile, FileMaxSize, MaxFile, Upload_Type, FileInfo, IsBinary, SessionName,FileField,RanNums
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
Public p_UpLoadPID, OldFileName, DiyFileName, FormatType, AutoDir
Public FileExt_1, FileExt_2, FileExt_3, FileExt_4, FileExt_5, FileExt_6
' ============================================
' 返回版本信息
' ============================================
Public Property Get Version
Version = "拓网文件上传类V1.0"
End Property
' ============================================
' 初始化类
' ============================================
Private Sub Class_Initialize
FileField="strFile"
RanNums=5
SessionName = Empty
IsBinary = False
ErrCodes = 0
Count = 0
AutoDir = 0
CountSize = 0
FilePath = "./"
InceptFile = ""
OldFileName = ""
FormatType = 0
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.TopWang.com)"
Draw_Type = -1
FileExt_1 = "jpg|jpeg|gif|bmp|png|tif|iff" ' 图像类文件类型
FileExt_2 = "swf|swi" ' 动画文件类型
FileExt_3 = "mp3|m3u|wav|wma|wax|asx|asf|mp2|au|aif|aiff|mid|midi|rmi" ' 音频文件类型 全部采用Windows Media Player播放
FileExt_4 = "rm|rmvb|ram|ra|mov" ' RealPlayer 文件类型
FileExt_5 = "mpg|mpeg|mpv|mps|m2v|m1v|mpe|mpa|avi|wmv|wm|wmx|wvx" ' Windows Media 视频文件类型
FileExt_6 = "asa|asp|bat|cmd|code|com|db|dll|doc|exe|fla|ftp|h|hlp|htm|html|inc|info|ini|js|log|mdb|pdf|php|pic|ppt|rar|real|torrent|txt|xls|xml|zip" ' 其他文件类型
Set UploadFiles = Server.CreateObject(ServerObject_004)
Set UploadForms = Server.CreateObject(ServerObject_004)
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 FileFieldName(Byval Values)
FileField = Values
End Property
' ============================================
' GetFileId随机数位数
' ============================================
Public Property Let SetRanNums(Byval Values)
RanNums = Values
End Property
' ============================================
' 设置上传是否返回文件数据流
' ============================================
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
' ============================================
' 设置上传ID，用户进度条
' ============================================
Public Property Let UpLoadPID(Byval ID)
p_UpLoadPID = ID
End Property
Public Property Get UpLoadPID()
UpLoadPID = p_UpLoadPID
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 8 : Description = "数据大小超过限制，并包含非法文件类型，上传失败！"
Case 9 : Description = "数据总数量超过限制，上传失败！"
Case 10 : Description = "上传失败！"
Case 11 : 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(ServerObject_015)
Case 1
'---------------------AspJpegV1.2---------------
ObjName = "AspJpegV1.2组件"
Set ImageObj = Server.CreateObject(ServerObject_016)
Case 2
'---------------------SoftArtisans ImgWriter V1.21---------------
ObjName = "SoftArtisans ImgWriter V1.21组件"
Set ImageObj = Server.CreateObject(ServerObject_017)
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
' ============================================
' 检测是否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
' ============================================
' 定义文件名(组成：前缀+年+月+日+小时+分钟+秒+N位随机数)
' ============================================
Private Function FormatName(Byval FileExt)
Dim TempVal, TempStr
TempVal=Clng(Trim(FormatType))
Select Case TempVal
Case 999 ' 原文件名
TempStr = OldFileName
'Case ' 自定义文件名
' TempStr = DiyFileName
Case Else ' 自动文件名
TempStr=ClsPub.CreateId(1,TempVal)
End Select
If RName_Str <> "" Then TempStr = RName_Str & TempStr
FormatName = TempStr & "." & FileExt
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, "cgi", "")
FixName = Replace(FixName, "jsp", "")
FixName = Replace(FixName, "php", "")
FixName = Replace(FixName, "pl", "")
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 = "php" or FileExt = "cgi" or FileExt = "jsp" 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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -