📄 cls_adminfile.asp
字号:
Private Sub DelFile()
Dim fso, i
Dim strFileName, strFilePath
Dim strFolderName, strFolderPath
'---- 删除文件
If Trim(Request("FileName")) <> "" Then
strFileName = Split(Request("FileName"), ",")
If UBound(strFileName) <> -1 Then '删除文件
Set fso = CreateObject(Newasp.FSO_ScriptName)
For i = 0 To UBound(strFileName)
strFilePath = Server.MapPath(FilePath & Trim(strFileName(i)))
If fso.FileExists(strFilePath) Then
fso.DeleteFile strFilePath, True
End If
Next
Set fso = Nothing
End If
End If
'---- 删除文件夹
If Trim(Request("FolderName")) <> "" Then
strFolderName = Split(Request("FolderName"), ",")
If UBound(strFolderName) <> -1 Then '删除文件
Set fso = CreateObject(Newasp.FSO_ScriptName)
For i = 0 To UBound(strFolderName)
strFolderPath = Server.MapPath(FilePath & Trim(strFolderName(i)))
If fso.FolderExists(strFolderPath) Then
fso.DeleteFolder strFolderPath, True
End If
Next
Set fso = Nothing
End If
End If
Response.Redirect (Request.ServerVariables("HTTP_REFERER"))
End Sub
'=================================================
'过程名:DelAllDirFile
'作 用:删除所有文件和文件夹
'=================================================
Private Sub DelAllDirFile()
Dim fso, oFolder
Dim DirFile, DirFolder
Dim tempPath
Set fso = CreateObject(Newasp.FSO_ScriptName)
If fso.FolderExists(fullPath) Then
Set oFolder = fso.GetFolder(fullPath)
'---- 删除所有文件
For Each DirFile In oFolder.Files
tempPath = fullPath & "\" & DirFile.Name
fso.DeleteFile tempPath, True
Next
'---- 删除所有子目录
For Each DirFolder In oFolder.SubFolders
tempPath = fullPath & "\" & DirFolder.Name
fso.DeleteFolder tempPath, True
Next
Set oFolder = Nothing
End If
Set fso = Nothing
Response.Redirect (Request.ServerVariables("HTTP_REFERER"))
End Sub
'=================================================
'过程名:DelThisAllFile
'作 用:删除当前目录所有文件
'=================================================
Private Sub DelThisAllFile()
Dim fso, oFolder
Dim DirFiles
Dim tempPath
Set fso = CreateObject(Newasp.FSO_ScriptName)
If fso.FolderExists(fullPath) Then
Set oFolder = fso.GetFolder(fullPath)
'---- 删除所有文件
For Each DirFiles In oFolder.Files
tempPath = fullPath & "\" & DirFiles.Name
fso.DeleteFile tempPath, True
Next
Set oFolder = Nothing
End If
Set fso = Nothing
Response.Redirect (Request.ServerVariables("HTTP_REFERER"))
End Sub
'=================================================
'过程名:DelEmptyFolder
'作 用:删除所有空文件夹
'=================================================
Private Sub DelEmptyFolder()
Dim fso, oFolder
Dim DirFolder, tempPath
Set fso = CreateObject(Newasp.FSO_ScriptName)
If fso.FolderExists(fullPath) Then
Set oFolder = fso.GetFolder(fullPath)
'---- 删除所有空子目录
For Each DirFolder In oFolder.SubFolders
If DirFolder.Size = 0 Then
tempPath = fullPath & "\" & DirFolder.Name
fso.DeleteFolder tempPath, True
End If
Next
Set oFolder = Nothing
End If
Set fso = Nothing
Response.Redirect (Request.ServerVariables("HTTP_REFERER"))
End Sub
'=================================================
'过程名:ShowUploadMain
'作 用:显示上传文件主页面
'=================================================
Private Sub ShowUploadMain()
Dim maxperpage, CurrentPage, TotalNumber, Pcount
Dim fso, FileCount, TotleSize, totalPut
maxperpage = 20 '###每页显示数
If IsNumeric(Request("page")) And Trim(Request("page")) <> "" Then
CurrentPage = CLng(Request("page"))
Else
CurrentPage = 1
End If
If CLng(CurrentPage) = 0 Then CurrentPage = 1
On Error Resume Next
If Not IsObjInstalled(Newasp.FSO_ScriptName) Then
Response.Write "<b><font color=red>你的服务器不支持 fso(Scripting.FileSystemObject)! 不能使用本功能</font></b>"
End If
Response.Write "<table border=0 align=center cellpadding=3 cellspacing=1 class=tableborder>"
Response.Write "<tr>"
Response.Write " <th colspan=""2"">文件目录</th>"
Response.Write "</tr>"
Response.Write "<tr>"
Response.Write " <td class=tablerow1 colspan=""2"">"
Call ShowChildFolder
Response.Write "</td>"
Response.Write "</tr>"
Response.Write "<tr>"
Response.Write " <td width=""50%"" class=tablerow2>当前目录:" & FilePath & "</td>"
Response.Write " <td width=""50%"" align=center class=tablerow2>"
Response.Write "<a href=""admin_UploadFile.asp?action=clear&ChannelID=" & ChannelID & "&UploadDir=" & Request("UploadDir") & """>清理无用文件</a> "
If Trim(Request("ThisDir")) <> "" Then
'Response.Write "<a href=""admin_UploadFile.asp?ChannelID=" & ChannelID & "&UploadDir=" & Request("UploadDir") & "&ThisDir=" & Left(Request("UploadDir"), InStrRev(Left(Request("ThisDir"), Len(Request("ThisDir")) - 1), "/")) & """>↑返回上一层目录</a>"
Response.Write "<a href=""admin_UploadFile.asp?ChannelID=" & ChannelID & "&UploadDir=" & Left(Request("UploadDir"),Len(Request("UploadDir"))-Len(Mid(Request("UploadDir"), InStrRev(Request("UploadDir"), "/")))) & "&ThisDir=" & Request("ThisDir") & """>↑返回上一层目录</a>"
End If
Response.Write "</td>"
Response.Write "</tr>"
Response.Write "</table><br>" & vbNewLine
Set fso = CreateObject(Newasp.FSO_ScriptName)
If fso.FolderExists(fullPath) Then
Dim fsoFile, fsoFileSize
Dim DirFiles, DirFolder
Set fsoFile = fso.GetFolder(fullPath)
'fsoFileSize = fsoFile.size '空间大小统计
Dim c
FileCount = fsoFile.Files.Count
TotleSize = GetFileSize(fsoFile.Size)
totalPut = fsoFile.Files.Count
If CurrentPage < 1 Then
CurrentPage = 1
End If
If (CurrentPage - 1) * maxperpage > totalPut Then
If (totalPut Mod maxperpage) = 0 Then
CurrentPage = totalPut \ maxperpage
Else
CurrentPage = totalPut \ maxperpage + 1
End If
End If
FileCount = 0
c = 0
Response.Write "<table border=0 align=center cellpadding=3 cellspacing=1 class=tableborder>" & vbNewLine
Response.Write "<tr><td colspan=4 class=tablerow1>" & vbNewLine
Response.Write showpage(CurrentPage, totalPut, maxperpage, TotleSize)
Response.Write "</td></tr>" & vbNewLine
Response.Write "<form name=""myform"" method=""post"" action='admin_uploadfile.asp'>" & vbCrLf
Response.Write "<tr>" & vbNewLine
Response.Write "<input type=hidden name=action value='del'>" & vbNewLine
Response.Write "<input type=hidden name=ChannelID value='" & ChannelID & "'>" & vbNewLine
Response.Write "<input type=hidden name=UploadDir value='" & Request("UploadDir") & "'>" & vbNewLine
Response.Write "<input type=hidden name=ThisDir value='" & Request("ThisDir") & "'>" & vbNewLine
For Each DirFiles In fsoFile.Files
c = c + 1
If c > maxperpage * (CurrentPage - 1) Then
Response.Write "<td class=tablerow2>"
Response.Write "<div align=center><a href='" & FilePath & DirFiles.Name & "'target=_blank><img src='" & GetFilePic(FilePath & DirFiles.Name) & "' width=140 height=100 border=0 alt='点此图片查看原始文件!'></a></div>"
Response.Write "文件名:<a href='" & FilePath & DirFiles.Name & "'target=_blank>" & DirFiles.Name & "</a><br>"
Response.Write "文件大小:" & GetFileSize(DirFiles.Size) & "<br>"
Response.Write "文件类型:" & DirFiles.Type & "<br>"
Response.Write "修改时间:" & DirFiles.DateLastModified & "<br>"
Response.Write "管理操作:<input type=checkbox name=FileName value='" & DirFiles.Name & "' checked> 选择 "
Response.Write "<a href='?action=del&ChannelID=" & ChannelID & "&UploadDir=" & Request("UploadDir") & "&ThisDir=" & Request("ThisDir") & "&FileName=" & DirFiles.Name & "' onclick=""return confirm('您确定要删除此文件吗!');"">×删除</a>"
FileCount = FileCount + 1
Response.Write "</td>" & vbNewLine
If (FileCount Mod 4) = 0 And FileCount < maxperpage And c < totalPut Then
Response.Write "</tr>" & vbNewLine & "<tr>" & vbNewLine
End If
End If
If FileCount >= maxperpage Then Exit For
Next
Response.Write "</tr>" & vbNewLine
Response.Write "<tr><td colspan=4 class=tablerow1>" & vbNewLine
Response.Write "<input class=Button type=button name=chkall value='全选' onClick=""CheckAll(this.form)""><input class=Button type=button name=chksel value='反选' onClick=""ContraSel(this.form)"">" & vbNewLine
Response.Write " <input class=Button type=submit name=Submit2 value='删除选中的文件' onClick=""return confirm('确定要删除选中的文件吗?')"">" & vbNewLine
Response.Write " <input class=Button type=submit name=Submit3 value='删除所有文件' onClick=""document.myform.action.value='DelThisAllFile';return confirm('确定要删除当前目录所有文件吗?')"">" & vbNewLine
Response.Write " <input class=Button type=submit name=Submit4 value='删除所有文件和文件夹' onClick=""document.myform.action.value='DelAllDirFile';return confirm('确定要删除当前目录所文件和文件夹吗?')"">" & vbNewLine
Response.Write " <input class=Button type=submit name=Submit5 value='删除所有空文件夹' onClick=""document.myform.action.value='DelEmptyFolder';return confirm('确定要删除当前目录所有空文件夹吗?')"">" & vbNewLine
Response.Write "</tr></form>" & vbNewLine
Response.Write "<tr><td colspan=4 class=tablerow1>" & vbNewLine
Response.Write showpage(CurrentPage, totalPut, maxperpage, TotleSize)
Response.Write "</td></tr>" & vbNewLine
Response.Write "</table>"
Else
Response.Write "此目录没有任何文件!"
End If
Set fsoFile = Nothing: Set fso = Nothing
End Sub
'=================================================
'过程名:ClearUploadFile
'作 用:清理无用的上传文件
'=================================================
Private Sub ClearUploadFile()
Response.Write "<table border=0 align=center cellpadding=3 cellspacing=1 class=tableborder>" & vbNewLine
Response.Write "<tr><th>" & vbNewLine
If LCase(Request("UploadDir")) = "uploadfile" Then
Response.Write "清理无用的上传文件"
Else
Response.Write "清理无用的上传图片"
End If
Response.Write "</th></tr>" & vbNewLine
Response.Write "<form name=""myform"" method=""post"" action='admin_uploadfile.asp'>" & vbCrLf
Response.Write "<input type=hidden name=action value='delete'>" & vbNewLine
Response.Write "<input type=hidden name=ChannelID value='" & ChannelID & "'>" & vbNewLine
Response.Write "<input type=hidden name=UploadDir value='" & Request("UploadDir") & "'>" & vbNewLine
Response.Write "<tr><td class=tablerow1>" & vbNewLine
Response.Write "<br> ①、你的网站在使用一段时间后,就会产生大量无用垃圾文件。所以需要定期使用本功能进行清理;<br>"
Response.Write "<br> ②、请确定你的上传目录(UploadPic、UploadFile)中没有使用的文件都是无用文件;<br>"
Response.Write "<br> ③、如果上传文件很多,或者数据库的信息量较多,执行本操作需要耗费相当长的时间,请在访问量少时执行本操作。<br>"
Response.Write "<br></td></tr>" & vbNewLine
Response.Write "<tr align=center><td class=tablerow2>请选择要清理的目录:"
Call ShowFolderPath
Response.Write "<input class=Button type=submit name=Submit2 value=' 开始清理垃圾文件 ' onclick=""return confirm('您确定要清除所有无用的文件吗?');"">"
Response.Write " <a href='?ChannelID=" & ChannelID & "&UploadDir=" & Request("UploadDir") & "'>返回上传管理</a>"
Response.Write "</td></tr></form>" & vbNewLine
Response.Write "</table>"
End Sub
'=================================================
'过程名:ShowFolderPath
'作 用:显示子目录菜单
'=================================================
Private Sub ShowFolderPath()
Dim fso, fsoFile, DirFolder
Dim strFolderPath
On Error Resume Next
strFolderPath = ChannelDir & Request("UploadDir")
strFolderPath = Server.MapPath(strFolderPath)
Set fso = CreateObject(Newasp.FSO_ScriptName)
If fso.FolderExists(strFolderPath) Then
Set fsoFile = fso.GetFolder(strFolderPath)
Response.Write "<select name=""path"">" & vbNewLine
For Each DirFolder In fsoFile.SubFolders
Response.Write " <option value=""" & DirFolder.Name & """>" & DirFolder.Name & "</option>" & vbNewLine
Next
Response.Write " <option value="""">上传根目录</option>" & vbNewLine
Response.Write "</select>" & vbNewLine
Set fsoFile = Nothing
Else
'Response.Write "没有找到文件夹!"
End If
Set fso = Nothing
End Sub
'=================================================
'过程名:DelUselessFile
'作 用:删除所有无用的上传文件
'=================================================
Private Sub DelUselessFile()
Dim SQL,Rs,i
Dim fso, fsoFile, DirFiles
Dim strFileName,strFolderPath
Dim strFilePath,strDirName
Server.ScriptTimeout = 9999999
On Error Resume Next
If Len(Request("path")) > 0 Then
strDirName = Request("path") & "/"
Else
strDirName = vbNullString
End If
strFolderPath = ChannelDir & UploadDir & strDirName
strFolderPath = Server.MapPath(strFolderPath)
Set fso = CreateObject(Newasp.FSO_ScriptName)
i = 0
If fso.FolderExists(strFolderPath) Then
Set fsoFile = fso.GetFolder(strFolderPath)
For Each DirFiles In fsoFile.Files
strFileName = strDirName & DirFiles.Name
strFilePath = strFolderPath & "\" & DirFiles.Name
Select Case CLng(modules)
Case 1
SQL = "SELECT TOP 1 ArticleID FROM [NC_Article] WHERE ChannelID=" & ChannelID & " And UploadImage like '%" & strFileName & "%'"
Case 2
If LCase(Request("UploadDir")) = "uploadfile" Then
'SQL = "SELECT TOP 1 softid FROM [NC_SoftList] WHERE ChannelID=" & ChannelID & " And DownAddress like '%" & strFileName & "%'"
SQL = "SELECT TOP 1 id FROM [NC_DownAddress] WHERE ChannelID=" & ChannelID & " And DownFileName like '%" & strFileName & "%'"
Else
SQL = "SELECT TOP 1 softid FROM [NC_SoftList] WHERE ChannelID=" & ChannelID & " And SoftImage like '%" & strFileName & "%'"
End If
Case 3
SQL = "SELECT TOP 1 shopid FROM [NC_ShopList] WHERE ChannelID=" & ChannelID & " And ProductImage like '%" & strFileName & "%'"
Case 5
If LCase(Request("UploadDir")) = "uploadfile" Then
SQL = "SELECT TOP 1 flashid FROM [NC_FlashList] WHERE ChannelID=" & ChannelID & " And showurl like '%" & strFileName & "%'"
Else
SQL = "SELECT TOP 1 flashid FROM [NC_FlashList] WHERE ChannelID=" & ChannelID & " And miniature like '%" & strFileName & "%'"
End If
Case Else
SQL = "SELECT TOP 1 id FROM [NC_Adlist] WHERE Picurl like '%" & strFileName & "%'"
End Select
Set Rs = Newasp.Execute(SQL)
If Rs.EOF Then
i = i + 1
fso.DeleteFile(strFilePath)
End If
Next
Set fsoFile = Nothing
End If
Set fso = Nothing
Succeed ("<li>文件清理完成!</li><li>一共清理了<font color=red><b>" & i & "</b></font>个垃圾文件")
End Sub
End Class
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -