<% Dim G_Msg, G_Script MainTop If Dvbbs.boardid>0 And Dvbbs.userid>0 Then If Request("t")="1" Then Upfile_Main Main Else response.write "版面参数错误，或您尚未登陆。" End If MainBottom Dvbbs.PageEnd() Sub ShowUploadSuc(str) G_Msg = G_Msg&""&str&"" End Sub Sub ShowUploadErr(str) G_Msg = G_Msg&""&str&"" End Sub Sub InsertUploadInfoToEdit(iFtype,sExt,sOldName,sShowName,iDownid) G_Script=G_Script&"DvFileInput_OnUpload('"&iFtype&"','"&sExt&"','"&sOldName&"','"&sShowName&"','"&iDownid&"');" End Sub '返回状态 Sub Upfile_Main() Dvbbs.ShowErr() Server.ScriptTimeOut=999999'要是你的论坛支持上传的文件比较大，就必须设置。 '----------------------------------------------------------------------------- '提交验证 '----------------------------------------------------------------------------- If Not Dvbbs.ChkPost Then Exit Sub End If If Dvbbs.Userid=0 Then ShowUploadErr "您还未登陆,不能上传！" Exit Sub End If If Cint(Dvbbs.GroupSetting(7))=0 then ShowUploadErr "您没有在本论坛上传文件的权限" Exit Sub End If UploadFile End Sub Sub UploadFile() Dim Upload,FormName,FilePath,ChildFilePath Dim File,F_FileName,F_ViewName,F_Filesize,F_FileExt,F_Type Dim Previewpath,DrawInfo,InceptMaxFile Dim OnceUPCount OnceUPCount = Request.Cookies("upNum") If OnceUPCount = "" or Not Isnumeric(OnceUPCount) Then OnceUPCount = 0 Else OnceUPCount = Clng(OnceUPCount) End If If OnceUPCount >= Clng(Dvbbs.GroupSetting(40)) then ShowUploadErr "一次只能上传"&Dvbbs.GroupSetting(40)&"个文件！" Exit Sub Else InceptMaxFile = Clng(Dvbbs.GroupSetting(40)) - OnceUPCount End If If Not IsNumeric(Dvbbs.UserToday(2)) Then Dvbbs.UserToday(2) = 0 If Clng(Dvbbs.UserToday(2))>Clng(Dvbbs.GroupSetting(50)) Then ShowUploadErr "已超出了你在论坛每天上传的文件个数"&Dvbbs.GroupSetting(50)&"个！" Exit Sub Else If Clng(Dvbbs.GroupSetting(50))-Clng(Dvbbs.UserToday(2))"" or Dvbbs.Forum_UploadSetting(18)<>"0" Then Upload.TransitionColor = Dvbbs.Forum_UploadSetting(18) '透明度颜色设置 End If '执行上传 Upload.SaveUpFile If Upload.ErrCodes<>0 Then ShowUploadErr "错误："& Upload.Description & "" Exit Sub End If If Upload.Count > 0 Then For Each FormName In Upload.UploadFiles Set File = Upload.UploadFiles(FormName) F_FileName = FilePath & File.FileName '创建预览及水印图片 If Upload.PreviewType<>999 and File.FileType=1 then F_Viewname = Previewpath & "pre" & Replace(File.FileName,File.FileExt,"") & "jpg" '创建预览图片:Call CreateView(原始文件的路径,预览文件名及路径,原文件后缀) Upload.CreateView F_FileName,F_Viewname,File.FileExt End If UploadSave F_FileName,ChildFilePath&File.FileName,File.FileExt,F_Viewname,File.FileSize,File.FileType,File.FileOldName Set File = Nothing Next Else ShowUploadErr "请正确选择要上传的文件。" Exit Sub End If Call Suc_upload(Upload.Count,OnceUPCount) Set Upload = Nothing End Sub '保存上传数据并返回附件ID Sub UploadSave(FileName,ChildFileName,FileExt,ViewName,FileSize,F_Type,F_OldName) Dim ShwoFileName ShwoFileName = Dvbbs.Checkstr(Replace(FileName,CheckFolder,"UploadFile/")) ChildFileName = Dvbbs.Checkstr(ChildFileName) Dvbbs.Execute("Insert into Dv_upFile (F_BoardID,F_UserID,F_Username,F_Filename,F_Viewname,F_FileType,F_Type,F_FileSize,F_Flag,F_OldName) values ("&Dvbbs.BoardID&","&Dvbbs.UserID&",'"&Dvbbs.Membername&"','"&ChildFileName&"','"&ViewName&"','"&FileExt&"',"&F_Type&","&FileSize&",4,'"&Left(Dvbbs.Checkstr(F_OldName),50)&"')") Dim Rs,DownloadID Set Rs=Dvbbs.Execute("Select top 1 F_ID From Dv_upFile order by F_ID desc") DownloadID=rs(0) Rs.Close Set Rs=Nothing InsertUploadInfoToEdit F_Type,FileExt,F_OldName,ShwoFileName,DownloadID End Sub Sub Suc_upload(UpCount,upNum) upNum = upNum + UpCount Response.Cookies("upNum") = upNum Dim iUserInfo Dvbbs.UserToday(2) = Dvbbs.UserToday(2)+UpCount iUserInfo = Dvbbs.UserToday(0) & "|" & Dvbbs.UserToday(1) & "|" & Dvbbs.UserToday(2) & "|" & Dvbbs.UserToday(3) & "|" & Dvbbs.UserToday(4) iUserInfo=Dvbbs.Checkstr(iUserInfo) If upNum < Clng(Dvbbs.GroupSetting(40)) And Dvbbs.UserToday(2) < Clng(Dvbbs.GroupSetting(50)) Then ShowUploadSuc UpCount & "个文件上传成功,目前今天总共上传了" & Dvbbs.UserToday(2) & "个附件。" Else ShowUploadSuc UpCount & "个文件上传成功!本次已达到上传数上限。" End If Dvbbs.Execute("UPDATE [Dv_user] SET UserToday = '" & iUserInfo &"' WHERE UserID = " & Dvbbs.UserID) Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usertoday").text=iUserInfo 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 '按月份自动明名上传文件夹,需要ＦＳＯ组件支持。 Function CreatePath(PathValue) Dim objFSO,Fsofolder,uploadpath '以年月创建上传文件夹，格式：2003－8 uploadpath = year(now) & "-" & month(now) If Right(PathValue,1)<>"/" Then PathValue = PathValue&"/" On Error Resume Next Set objFSO = Dvbbs.iCreateObject("Scripting.FileSystemObject") If objFSO.FolderExists(Server.MapPath(PathValue & uploadpath))=False Then objFSO.CreateFolder Server.MapPath(PathValue & uploadpath) End If If Err.Number = 0 Then CreatePath = PathValue & uploadpath & "/" Else CreatePath = PathValue End If Set objFSO = Nothing End Function Sub MainTop() %> <% End Sub Sub MainBottom() %> <% End Sub Sub Main() %> <% If ""<>G_Msg Then response.write "" If ""<>G_Script Then response.write "" End Sub %>