<% Head() Dim path Dim objFSO Dim uploadfolder Dim uploadfiles Dim upname Dim UpFolder Dim upfilename Dim admin_flag admin_flag=",35," Dim sfor(30,2) Dim seachstr,sqlstr,delsql Dim currentpage,page_count,Pcount Dim totalrec,endpage Dim SysFilePath If Dvbbs.Forum_Setting(76)="0" Or Dvbbs.Forum_Setting(76)="" Then Dvbbs.Forum_Setting(76)="../UploadFile/" Else Dvbbs.Forum_Setting(76) = "../"& Dvbbs.Forum_Setting(76) End If SysFilePath = Dvbbs.Forum_Setting(76) if Request("path")<>"" then path = Request("path") else path = SysFilePath end if currentPage=Request("currentpage") if currentpage="" or not IsNumeric(currentpage) then currentpage=1 else currentpage=clng(currentpage) if err then currentpage=1 err.clear end if end if if Request("filesearch")<>"" and IsNumeric(Request("filesearch")) then seachstr="&filesearch="&Request("filesearch") end if '---------------------------------- '多条件查询表单处理开始 '---------------------------------- if Request("filesearch")=7 and IsNumeric(Request("filesearch")) then '所属版块条件 if Request("class")<>"" and IsNumeric(Request("class")) and Request("class")<>0 then seachstr=seachstr+"&class="&cint(Request("class")) sqlstr=" and F_BoardID="&cint(Request("class")) end if '附件分类条件 if Request("f_type")<>"" and IsNumeric(Request("f_type")) then seachstr=seachstr+"&f_type="&cint(Request("f_type")) sqlstr=sqlstr+" and f_type="&cint(Request("f_type")) end if '附件类型条件 if Request("f_filetype")<>"" then seachstr=seachstr+"&f_filetype="&Request("f_filetype") sqlstr=sqlstr+" and f_filetype='"&dvbbs.checkstr(Request("f_filetype"))&"'" end if '下载次数条件f_downnum if Request("f_downnum")<>"" and IsNumeric(Request("f_downnum")) then if Request("downtype")="more" then sqlstr=sqlstr+" and f_downnum>="&clng(Request("f_downnum")) else sqlstr=sqlstr+" and f_downnum<="&clng(Request("f_downnum")) end if seachstr=seachstr+"&f_downnum="&cint(Request("f_downnum"))&"&downtype="&Request("downtype") end if '浏览次数条件f_viewnum if Request("f_viewnum")<>"" and IsNumeric(Request("f_viewnum")) then if Request("viewtype")="more" then sqlstr=sqlstr+" and f_viewnum>="&clng(Request("f_viewnum")) else sqlstr=sqlstr+" and f_viewnum<="&clng(Request("f_viewnum")) end if seachstr=seachstr+"&f_viewnum="&cint(Request("f_viewnum"))&"&viewtype="&Request("viewtype") end if '附件大小条件f_size if Request("f_size")<>"" and IsNumeric(Request("f_size")) then if Request("sizetype")="more" then sqlstr=sqlstr+" and F_FileSize>="&clng(Request("f_size"))*1024 else sqlstr=sqlstr+" and F_FileSize<="&clng(Request("f_size"))*1024 end if seachstr=seachstr+"&f_size="&cint(Request("f_size"))&"&sizetype="&Request("sizetype") end if '多少天内发布条件f_adddatenum if Request("f_adddatenum")<>"" and IsNumeric(Request("f_adddatenum")) then If IsSqlDataBase=1 Then if Request("timetype")="more" then sqlstr=sqlstr+" and datediff(day,F_AddTime,"&SqlNowString&") >= "&clng(Request("f_adddatenum")) else sqlstr=sqlstr+" and datediff(day,F_AddTime,"&SqlNowString&") <= "&clng(Request("f_adddatenum")) end if Else if Request("timetype")="more" then sqlstr=sqlstr+" and datediff('d',F_AddTime,"&SqlNowString&") >= "&clng(Request("f_adddatenum")) else sqlstr=sqlstr+" and datediff('d',F_AddTime,"&SqlNowString&") <= "&clng(Request("f_adddatenum")) end if End If seachstr=seachstr+"&f_adddatenum="&cint(Request("f_adddatenum"))&"&timetype="&Request("timetype") end if '附件作者: if Request("f_username")<>"" then if Request("usernamechk")="yes" then sqlstr=sqlstr+" and f_username='"&dvbbs.checkstr(Request("f_username"))&"'" else sqlstr=sqlstr+" and f_username like '%"&dvbbs.checkstr(Request("f_username"))&"%'" end if seachstr=seachstr+"&f_username="&Request("f_username")&"&usernamechk="&Request("usernamechk") end if '附件说明: if Request("f_readme")<>"" then if Request("f_readmechk")="yes" then sqlstr=sqlstr+" and f_readme='"&dvbbs.checkstr(Request("f_readme"))&"'" else sqlstr=sqlstr+" and f_readme like '%"&dvbbs.checkstr(Request("f_readme"))&"%'" end if seachstr=seachstr+"&f_readme="&Request("f_readme")&"&f_readmechk="&Request("f_readmechk") end if end if '---------------------------------- '多条件查询表单处理结束 '---------------------------------- if not Dvbbs.master or instr(","&session("flag")&",",admin_flag)=0 then Errmsg=ErrMsg + "
  • 本页面为管理员专用,请登录后进入。
  • 您没有管理本页面的权限。" dvbbs_error() else %>
    论坛上传附件管理
    注意事项: ①、本功能必须服务器支持FSO权限方能使用,FSO使用帮助请浏览微软网站。如果您服务器不支持FSO请手动管理。
    ②、新版(DV6)之后的版本上传目录强制定义为UploadFile,只有该目录下文件可进行文件自动清理工作,新版之前的版本上传文件只能手动清除垃圾上传文件;(DV6.1)版后所有上传附件会自动存放到新自定义的文件夹中,文件目录以当年月明名。(需要空间支持FSO读写权限)
    ③、自动清理文件:将对所有上传文件进行核实,如发现文件没有被相关帖子所使用,将执行自动清除命令
    快速查询:
    <% if Request("Submit")="清理所有上传记录" then call delall() elseif Request("Submit")="清除未记录文件" then call delall1() elseif Request("Submit")="清理当前列表记录" then call delall() elseif Request("action")="FileSearch" then call FileSearch() elseif Request("action")="delfiles" then call delfiles() else call main() end if Footer() end if sub main() %>
    高级查询
    注意事项 在记录很多的情况下搜索条件越多查询越慢,请尽量减少查询条件;
    所属版块:
    文件下载次数:  多于   少于
    附件浏览次数:  多于   少于
    上传天数:  多于   少于
    附件作者:  用户名完整匹配
    附件说明:  说明内容完整匹配
    附件大小:  (单位:K)  大于   小于
    附件分类:
    附件类型:
    <% end sub sub FileSearch() %>
    <% Set rs= Server.CreateObject("ADODB.Recordset") sql="select F_ID,F_AnnounceID,F_BoardID,F_Filename,F_Username,F_FileType,F_Type,F_FileSize,F_DownNum,F_ViewNum,F_AddTime ,B.Boardtype from [DV_Upfile] U inner join dv_Board B on B.boardid=U.F_BoardID where F_Flag=0 " '条件查询 select case Request("FileSearch") case 1 sql=sql+" order by F_ID desc" case 2 If IsSqlDataBase=1 Then sql=sql+" and datediff(hour,F_AddTime,"&SqlNowString&")<25" else sql=sql+" and datediff('h',F_AddTime,"&SqlNowString&")<25" end if sql=sql+" order by F_ID desc" case 3 If IsSqlDataBase=1 Then sql=sql+" and datediff(month,F_AddTime,"&SqlNowString&")<1" else sql=sql+" and datediff('m',F_AddTime,"&SqlNowString&")<1" end if sql=sql+" order by F_ID desc" case 4 If IsSqlDataBase=1 Then sql=sql+" and datediff(month,F_AddTime,"&SqlNowString&")<3" else sql=sql+" and datediff('m',F_AddTime,"&SqlNowString&")<3" end if sql=sql+" order by F_ID desc" case 5 sql="select top 100 F_ID,F_AnnounceID,F_BoardID,F_Filename,F_Username,F_FileType,F_Type,F_FileSize,F_DownNum,F_ViewNum,F_AddTime ,B.Boardtype from [DV_Upfile] U inner join dv_Board B on B.boardid=U.F_BoardID where F_Flag=0 and F_BoardID<>0" sql=sql+" order by F_DownNum Desc,F_ID desc" case 6 sql="select top 100 F_ID,F_AnnounceID,F_BoardID,F_Filename,F_Username,F_FileType,F_Type,F_FileSize,F_DownNum,F_ViewNum,F_AddTime ,B.Boardtype from [DV_Upfile] U inner join dv_Board B on B.boardid=U.F_BoardID where F_Flag=0 and F_BoardID<>0" sql=sql+" order by F_ViewNum Desc,F_ID desc" case 7 sql=sql+sqlstr sql=sql+" order by F_ID desc" case else sql=sql+" order by F_ID desc" end select 'response.write SQL rs.open sql,conn,1 if rs.eof and rs.bof then response.write "" else rs.PageSize = Cint(Dvbbs.Forum_Setting(11)) rs.AbsolutePage=currentpage page_count=0 totalrec=rs.recordcount while (not rs.eof) and (not page_count = Cint(Dvbbs.Forum_Setting(11))) '列表内容''''''''''''''''''''' %> <% page_count = page_count + 1 rs.movenext wend Pcount=rs.PageCount end if rs.close if Request("FileSearch")=1 then sql="" if Request("FileSearch")=7 and sqlstr="" then sql="" %> <% Response.Write "
    上传文件管理 -->搜索结果
    类型 用户名 文 件 名 所属版块 大小 时间/点击/下载 分类 删除
    没有找到相关记录。
    .gif" border=0> <%=rs("F_Username")%> " target=_blank><%=rs("F_Filename")%> <%=rs("Boardtype")%> <%=getsize(rs("F_FileSize"))%> <%=formatdatetime(rs("F_AddTime"),1)%>/ <%=rs("F_ViewNum")%>/ <%=rs("F_DownNum")%> <%=filetypename(rs("F_Type"))%> " >
    文件记录库清理操作
  • 请选取要删除的文件,然后执行删除操作,附件将直接从服务器上删除并不能恢复!
  • 清理同时是否直接从服务器上删除文件,删除的文件将不能恢复 !
  • 是 
  • 根据当前列表数据进行清理,清除其中所属的帖子已删改的附件。
  • 从上传记录中,根据相关发表的帖子内容进行清除所有已删改的附件。
  • 空间附件清理操作
  • 清除存在服务器空间而没有记录到上传库中的所有上传附件。
  • 请填写清理的上传目录,默认根目录为:“<%=SysFilePath%>”。
  • 目录格式规定:年-月(如:2003-8)。
  • 需要清理的上传目录:
    " call list() Response.Write "
    " end sub SUB LIST() '分页代码 If totalrec="" Then totalrec=0:Pcount=0 response.write "
    "&totalrec&"个文件,共分"&Pcount&"页:" if currentpage > 4 then response.write "[1] ..." end if if Pcount>currentpage+3 then endpage=currentpage+3 else endpage=Pcount end if for i=currentpage-3 to endpage if not i<1 then if i = clng(currentpage) then response.write " ["&i&"]" else response.write " ["&i&"]" end if end if next if currentpage+3 < Pcount then response.write "... ["&Pcount&"]" end if response.write " 转到:" response.write "
    " END SUB SUB delfiles() Dim delid,F_filename if instrRev(path,"/")=0 then path=path&"/" response.write "
    " delid=replace(Request.form("delid"),"'","") if delid="" then response.write "请选择要删除的文件!" else Set objFSO = Server.CreateObject("Scripting.FileSystemObject") Set rs= Server.CreateObject("ADODB.Recordset") sql="select F_id,F_Filename from DV_Upfile where F_ID in ("&delid&")" rs.open sql,conn,1 if not rs.eof then response.write "总共删除记录和文件"&rs.recordcount&"个。
    " do while not rs.eof if InStr(rs(1),":")=0 or InStr(rs(1),"//")=0 then '判断文件是否本论坛,若不是则采用表中的记录. F_filename=path&rs(1) else F_filename=rs(1) end if if objFSO.fileExists(Server.MapPath(F_filename)) then objFSO.DeleteFile(Server.MapPath(F_filename)) end if Dvbbs.Execute("delete from DV_Upfile where F_ID="&rs(0)) response.write "已经删除文件"&F_filename&" !
    " rs.movenext loop end if rs.close set rs=nothing set objFSO=nothing end if response.write "
    " END SUB '清理所有记录 sub delall() Server.ScriptTimeout=9999999 response.write "
    " Dim TempFileName Dim F_ID,F_AnnounceID,F_boardid,F_filename Dim S_AnnounceID,s_Rootid Dim drs,delfile Dim delinfo delfile=trim(Request.form("delfile")) if cint(delfile)=1 then delinfo="已被删除!" else delinfo="未被删除!" end if if Request.form("delsql")<>"" then If Dvbbs.chkpost=False Then Dvbbs.AddErrmsg "您提交的数据不合法,请不要从外部提交发言。" exit sub else delsql=Request.form("delsql") End If end if i=0 Set objFSO = Server.CreateObject("Scripting.FileSystemObject") If Delsql = "" Then Set Rs = Dvbbs.Execute("SELECT F_ID, F_AnnounceID, F_BoardID, F_Filename, F_Type FROM [DV_Upfile] WHERE F_Flag = 4 ORDER BY F_ID DESC ") Else Set Rs = Dvbbs.Execute(Delsql) End If 'response.write delsql if rs.eof then response.write "还未有" else do while not rs.eof F_ID=rs(0) F_boardid=rs(2) if InStr(rs(3),":")=0 or InStr(rs(3),"//")=0 then '判断文件是否本论坛,若不是则采用表中的记录. F_filename=path&rs(3) else F_filename=rs(3) end if 'Response.Write Rs("F_Type")&"
    " If Rs("F_Type")<>1 Then '除图片文件外 TempFileName="viewfile.asp?ID="&F_ID Else TempFileName=F_filename End If TempFileName=Lcase(TempFileName) if rs(1)="" or isnull(rs(1)) then if InStr(rs(3),":")=0 or InStr(rs(3),"//")=0 then '判断文件是否本论坛,若不是则采用表中的记录. if objFSO.fileExists(Server.MapPath(F_filename)) then if delfile=1 then Dvbbs.Execute("delete from DV_Upfile where F_ID="&F_ID) objFSO.DeleteFile(Server.MapPath(F_filename)) end if response.write "文件未写帖子,"&F_filename&" "&delinfo&"
    " else response.write "文件未写帖子,"&F_filename&" 已不存在!
    " end if else response.write "外部文件"&F_filename&" "&delinfo&"
    " end if i=i+1 else if isnumeric(rs(1)) then S_AnnounceID=rs(1) else F_AnnounceID=split(rs(1),"|") s_Rootid=F_AnnounceID(0) S_AnnounceID=F_AnnounceID(1) end if 'Response.Write rs(1)&"
    " If S_AnnounceID="" Then Response.Write F_filename &"文件数据有问题
    " Else '取出所属帖子表名 Dim PostTablename set drs=Dvbbs.Execute("select PostTable from dv_topic where TopicID="&s_Rootid) if not drs.eof then PostTablename=drs(0) else PostTablename=AllPostTable(0) end if drs.close '找出相应的帖子进行判断文件是否存在帖子内容 'Response.Write "select body from "&PostTablename&" where AnnounceID="&S_AnnounceID&"
    " set drs=Dvbbs.Execute("select body from "&PostTablename&" where AnnounceID="&S_AnnounceID) if drs.eof then if delfile=1 then Dvbbs.Execute("delete from DV_Upfile where F_ID="&F_ID) end if if objFSO.fileExists(Server.MapPath(F_filename)) then if delfile=1 then objFSO.DeleteFile(Server.MapPath(F_filename)) end if response.write "帖子未找到,"&F_filename&" "&delinfo&"
    " else response.write "帖子未找到,"&F_filename&" 已不存在!
    " end if i=i+1 else 'Response.Write TempFileName&"
    " If Instr(Lcase(drs(0)),TempFileName)=0 Then if objFSO.fileExists(Server.MapPath(F_filename)) then if delfile=1 then objFSO.DeleteFile(Server.MapPath(F_filename)) Dvbbs.Execute("delete from DV_Upfile where F_ID="&F_ID) end if response.write "帖子内容不符,"&F_filename&" "&delinfo&"[查看相关讨论 | 编辑]
    " else response.write "帖子内容不符,"&F_filename&" 已不存在![查看相关讨论 | 编辑]
    " end if i=i+1 end if end if drs.close End If End If rs.movenext loop end if rs.close set drs=nothing set rs=nothing set objFSO=nothing response.write"共清理 "&i&" 个无用文件 [返回]" response.write "
    " end sub '删除所有未记录到上传库中的文件 Sub Delall1() REM 防脚本超时 2004-8-26.Dv.Yz Server.ScriptTimeout = 9999999 response.write "
    " Dim delfile,delinfo,datepath delfile=dvbbs.checkStr(trim(Request.form("delfile"))) if cint(delfile)=1 then delinfo="目前已被删除!" else delinfo="目前未被删除!" end if if instrRev(path,"/")=0 then path=path&"/" If instr(path,SysFilePath)=0 Then datepath=path path=SysFilePath&path End If Set objFSO = Server.CreateObject("Scripting.FileSystemObject") if objFSO.FolderExists(Server.MapPath(path))=false then response.write "路径:"&Path&"不存在!" else Set uploadFolder=objFSO.GetFolder(Server.MapPath(path)) Set uploadFiles=uploadFolder.Files i=0 For Each Upname In uploadFiles upfilename=path&upname.name 'Response.Write "select top 1 F_ID from DV_Upfile where F_Filename = '"&datepath&upname.name&"'
    " set rs=Dvbbs.Execute("SELECT TOP 1 F_ID FROM Dv_Upfile WHERE F_Filename = '"&datepath&upname.name&"'") if rs.eof then i=i+1 if delfile=1 then objFSO.DeleteFile(Server.MapPath(upfilename)) end if response.write "" response.write upfilename&"在库中没有记录!"&delinfo&"
    " end if rs.close set rs=nothing next response.write"共删除 "&i&" 个无用文件 [返回]" set uploadFolder=nothing set uploadFiles=nothing end if set objFSO=nothing response.write "
    " end sub function folder(path) on error resume next Set objFSO = Server.CreateObject("Scripting.FileSystemObject") Set uploadFolder=objFSO.GetFolder(Server.MapPath(path)) if err.number<>"0" then response.write Err.Description response.end end if For Each UpFolder In uploadFolder.SubFolders response.write "『"&upfolder.name&"』 | " next set uploadFolder=nothing end function function procGetFormat(sName) Dim str procGetFormat=0 if instrRev(sName,".")=0 then exit function str=lcase(mid(sName,instrRev(sName,".")+1)) for i=0 to uBound(sFor,1) if str=sFor(i,0) then procGetFormat=sFor(i,1) exit for end if next end function function filetypename(stype) if isempty(stype) or not isnumeric(stype) then exit function select case cint(stype) case 1 filetypename="图片集" case 2 filetypename="FLASH集" case 3 filetypename="音乐集" case 4 filetypename="电影集" case else filetypename="文件集" end select end function function getsize(size) if isEmpty(size) then exit function if size>1024 then size=(size\1024) getsize=size & " KB" else getsize=size & " B" end if if size>1024 then size=(size/1024) getsize=formatnumber(size,2) & " MB" end if if size>1024 then size=(size/1024) getsize=formatnumber(size,2) & " GB" end if end function %>