"
Select Case Request("Action")
Case"deluphalfyear"
deluphalfyear
Case"delnovisit"
delnovisit
Case"delnouse"
delnouse
Case"delall"
DelAll
Case"DelOptFile"
DelOptFile
Case Else
UploadFile
end select
Footer()
Rem #核心函数(2005-5-27)
Function FileList(str)
Dim re,Test,temp
Dim LoopCount
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
LoopCount=0
Str = Replace(Str, chr(10), "")
Do While True
re.Pattern="\[upload=(.[^\[]*)\]"
Test=re.Test(Str)
If Test Then
re.Pattern="\[\/upload\]"
Test=re.Test(Str)
If Test Then
re.Pattern="(^.*)\[upload=(.[^\[]*)\](.[^\[]*)\[\/upload\](.*)"
Temp=Temp&re.Replace(Str,"$3")&","
Str=re.Replace(Str,"$1$4")
Else
Exit Do
End If
Else
Exit Do
End If
LoopCount=LoopCount + 1
If LoopCount>40 Then Exit Do'防止死循环
Loop
Set re=nothing
FileList=Temp
End Function
Sub UploadFile
Dim strPageInfo,arr_Rs,i,P,FileType
Response.Write""
End Sub
'记取帖子数据
Sub Delnouse
Dim go
go=Request("go")
If go="ok" Then
LoginTxt "正在读取数据,时间可能会很长"
Dim Alltable,i,temp
AllTable=Split(MNBoard.BBStable(0),",")
For i=0 To uBound(AllTable)
Set Rs=MNBoard.Execute("Select Content From [i_Bbs"&AllTable(i)&"]")
do while not rs.eof
Temp=Temp&FileList(rs(0))
rs.movenext
loop
rs.close
Next
ShowTable"清理无效上传文件 第二步",""
Else
ShowTable"清理无效上传文件 第一步","说明：检测在帖子上没有显示或连接的无用上传文件。 此操作将可能大量消耗服务器资源，建议暂时关闭论坛或在深夜人少时进行。 检测读取过程请不要刷屏或点击。
"
End If
End Sub
'清除无用
Sub DelAll
LoginTxt"正在处理文件"
Dim Fso,Folder,Files,upname,bbsfiles,Go,S
bbsFiles=Request.Form("files")
Go=Request.Form("Go")
If bbsFiles="" Then bbsFiles="0"
Set Fso=server.createobject("scripting.filesystemobject")
If not Fso.FolderExists(server.mappath(Del)) then Fso.CreateFolder(server.mappath(Del))
Set Folder=fso.Getfolder(server.MapPath(TopicFile))
Set files=folder.files
For Each Upname In files
If instr(LCase(bbsFiles),LCase(upname.name))<=0 then
MNBoard.execute("Delete * From [i_UpFile] Where FileName='"&upname.name&"'")
If Go="move" Then
Fso.MoveFile Server.mappath(TopicFile&upname.name),server.mappath(Del&upname.name)
Else
Fso.DeleteFile(Server.MapPath(TopicFile&Upname.name))
End If
End If
Next
Set Folder=nothing
Set Files=nothing
Set Fso=nothing
Response.Write""
If Go="move" Then
S="无用的上传文件已经被转移至"&Del&"目录下 !"
Else
S="无用的上传文件已经删除 !"
End If
MNBoard.netLog "操作后台_"&S
Suc"",S,"?"
End Sub
'批量清理
Sub Deluphalfyear
Dim Go,DelTime,Fso,Folder,Files,upname,S
Go=Request.Form("Go")
DelTime=Request.Form("DelTime")
If Go="" And DelTime="" Then
Response.Write""
Else
If Not isnumeric(DelTime) Then GoBack "","天数必需用数字填写！" :Exit Sub
LoginTxt "正在处理文件"
Set Fso=server.createobject("scripting.filesystemobject")
If not Fso.FolderExists(server.mappath(Del)) then Fso.CreateFolder(server.mappath(Del))
Set Folder=fso.Getfolder(server.MapPath(TopicFile))
Set Files=Folder.files
For Each upName In Files
MNBoard.execute("Delete * From [i_UpFile] Where FileName='"&upname.name&"'")
If datediff("D",upName.datecreated,now)>DelTime then
If Go="move" Then
Fso.MoveFile Server.mappath(TopicFile&upname.name),server.mappath(Del&upname.name)
Else
Fso.DeleteFile(Server.MapPath(TopicFile&Upname.name))
End If
End if
Next
Set Folder=nothing
Set Files=nothing
Set Fso=nothing
Response.Write""
If Go="move" Then
S="在"&DelTime&"天以前上传的文件已经被转移至"&Del&"目录下 !"
Else
S="在"&DelTime&"天以前上传的文件已经删除！"
End If
MNBoard.netLog "操作后台_"&S
Suc"",S,"?"
End IF
End Sub
'清理没有访问的文件
Sub DelNoVisit
Dim Go,DelTime,Fso,Folder,Files,upname,S
Go=Request.Form("Go")
DelTime=Request.Form("DelTime")
If Go="" And DelTime="" Then
Response.Write""
Else
If Not isnumeric(DelTime) Then GoBack"","天数必需用数字填写！":Exit Sub
LoginTxt"正在处理文件"
Set Fso=server.createobject("scripting.filesystemobject")
If not Fso.FolderExists(server.mappath(Del)) then Fso.CreateFolder(server.mappath(Del))
Set Folder=fso.Getfolder(server.MapPath(TopicFile))
Set Files=Folder.files
For Each Upname In Files
if Datediff("d",UpName.DateLastAccessed,now)>DelTime then
If Go="move" Then
Fso.MoveFile Server.mappath(TopicFile&upname.name),server.mappath(Del&upname.name)
Else
Fso.DeleteFile(Server.MapPath(TopicFile&Upname.name))
End If
End if
Next
Set Folder=nothing
Set Files=nothing
Set Fso=nothing
Response.Write""
If Go="move" Then
S="超过"&DelTime&"天以前没有访问的上传文件已经被转移至"&Del&"目录下 !"
Else
S="超过"&DelTime&"天以前没有访问的上传文件已经删除 !"
End If
MNBoard.netLog "操作后台_"&S
Suc"",S,"?"
End If
End Sub
'删除所选
Sub DelOptFile
Dim FileName,FSO,Folder,Files,Upname,Temp,i,S
On Error Resume Next
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
If Err Then
Goback"","操作失败，空间不支持FOS文件读写！。"
err.Clear
Exit Sub
End If
FileName=Request("ID")
If FileName="" Then GoBack"","请先选择项目。":Exit Sub
Temp=Split(FileName,",")
For i=0 To uBound(Temp)
MNBoard.execute("Delete * From [i_UpFile] Where FileName='"&Trim(Temp(i))&"'")
Next
Set Folder=fso.Getfolder(server.MapPath(MNBoard.Info(36)))
Set files=folder.files
For Each Upname In files
If instr(LCase(FileName),LCase(Upname.name))>0 then
FSO.DeleteFile(Server.MapPath(TopicFile&Upname.name))
End if
Next
Set Folder=nothing
Set Files=nothing
Set Fso=nothing
S="成功删除了所选的上传文件。"
MNBoard.netLog "操作后台_"&S
Suc"",S,"?"
End Sub
Sub LoginTxt(txt)
Response.Write"
