?? wap_upfile.asp
字號:
<!--#include FILE="conn.asp"-->
<!--#include FILE="inc/const.asp"-->
<!--#include file="inc/Class_Mobile.asp"-->
<!-- #include File="inc/Upload_Class.asp" -->
<%
Dim FoundErr
Dim Upload_type,Forum_Url
Forum_Url = Dvbbs.Get_ScriptNameUrl
FoundErr = False
'---------------------------------------------------------------
'上傳組件選擇:Upload_type=參數(shù)
Upload_type = Cint(Dvbbs.Forum_UploadSetting(2))
DvbbsWap.ShowXMLStar
ChkUpfile
If Not FoundErr Then
If Upload_type=999 Then
DvbbsWap.ShowErr 0,"系統(tǒng)已關閉上傳附件的功能!"
Else
Upload_Main
End If
End If
DvbbsWap.ShowXMLEnd
'驗證用戶上傳權限
Sub ChkUpfile()
If Dvbbs.UserID = 0 Then
DvbbsWap.ShowErr 0,"只允許論壇用戶才能上傳附件!"
FoundErr = True
Exit Sub
End If
If Dvbbs.GroupSetting(7) = "0" Then
DvbbsWap.ShowErr 0,"你沒有上傳附件的權限!"
FoundErr = True
Exit Sub
End If
If Clng(Dvbbs.UserToday(2))>=Clng(Dvbbs.GroupSetting(50)) Then
DvbbsWap.ShowErr 0,"系統(tǒng)限制會員每天只能上傳"&Dvbbs.GroupSetting(50)&"個附件!"
FoundErr = True
Exit Sub
End If
If Request("t")="1" Then
DvbbsWap.ShowErr 1,"系統(tǒng)支持上傳附件。"
FoundErr = True
Exit Sub
End If
End Sub
Sub Upload_Main()
Dim FormPath,Upload,FormName,File,F_FileName
Dim TempData
FormPath=CheckFolder&CreatePath() '上傳目錄路徑
Set Upload = New UpFile_Cls
Upload.UploadType = Upload_type '設置上傳組件類型
Upload.UploadPath = FormPath '設置上傳路徑
Upload.InceptFileType = "gif,jpg,bmp,jpeg,png" '設置上傳文件限制
Upload.MaxSize = Int(Dvbbs.GroupSetting(44)) '單位 KB
Upload.InceptMaxFile = 1 '每次上傳文件個數(shù)上限
'執(zhí)行上傳
Upload.SaveUpFile
If Upload.Count > 0 Then
For Each FormName In Upload.UploadFiles
Set File = Upload.UploadFiles(FormName)
F_FileName = FormPath & File.FileName
Response.Write "<fileurl>"
Response.Write Forum_Url &"/"& F_FileName
Response.Write "</fileurl>"
Set File = Nothing
Next
Else
DvbbsWap.ShowErr 0,"請正確選擇要上傳的文件。[ 重新上傳 ]"
Exit Sub
End If
If Upload.ErrCodes<>0 Then
DvbbsWap.ShowErr 0,"錯誤:"& Upload.Description & "[ 重新上傳 ]"
Exit Sub
End If
TempData = Dvbbs.UserToday(0) & "|" & Dvbbs.UserToday(1) & "|" & Clng(Dvbbs.UserToday(2))+Upload.Count &"|"& Dvbbs.UserToday(3) &"|"& Dvbbs.UserToday(4)
Set Upload = Nothing
Dvbbs.Execute("UPDATE [Dv_user] SET UserToday = '" & Dvbbs.Checkstr(TempData) &"' WHERE UserID = " & Dvbbs.UserID)
DvbbsWap.ShowErr 1,"上傳成功!"
End Sub
'讀取上傳目錄
Function CheckFolder()
If Dvbbs.Forum_Setting(76)="" Or Dvbbs.Forum_Setting(76)="0" Then Dvbbs.Forum_Setting(76)="UploadFile/"
CheckFolder = Replace(Replace(Dvbbs.Forum_Setting(76),Chr(0),""),".","")
'在目錄后加(/)
If Right(CheckFolder,1)<>"/" Then CheckFolder=CheckFolder&"/"
End Function
'按月份自動明名上傳文件夾,需要FSO組件支持。
Private Function CreatePath()
Dim objFSO,Fsofolder,uploadpath
uploadpath=year(now)&"-"&month(now) '以年月創(chuàng)建上傳文件夾,格式:2003-8
Fsofolder = Server.MapPath(CheckFolder & uploadpath)
On Error Resume Next
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(Fsofolder) = False Then
objFSO.CreateFolder Fsofolder
End If
If Err.Number = 0 Then
CreatePath = uploadpath & "/"
Else
CreatePath = ""
End If
Set objFSO = Nothing
End Function
%>
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -