?? upload_class.asp
字號:
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)
ChkBoolean = CBool(Values)
Else
ChkBoolean = False
End If
End Function
'-----------------------------------------------------------------------------------
'日期時間定義文件名
'-----------------------------------------------------------------------------------
Private Function FormatName(Byval FileExt)
Dim RanNum,TempStr
Randomize
RanNum = Int(90000*rnd)+10000
TempStr = Year(now) & Month(now) & Day(now) & Hour(now) & Minute(now) & Second(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","")
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" 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)
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -