-
Option Explicit
-
-
''''''''''''''说明''''''''''''
-
'网盟-黑火制作，送给需要的朋友。
-
'配置文件“Listfile.ini”的格式如下：
-
'要删除什么(文件|目录)=要执行删除的文件夹=排除1;排除2;排除3............
-
'配置文件可以有多行，以便对多个目录进行操作。
-
'配置文件里以“/”开头的行为注释行。
-
'排除多个内容时，使用分号“;”进行分隔。
-
'↓↓↓ 配置文件例子：↓↓↓
-
'/配置文件开始
-
'目录=D:\=System Volume Information;网络游戏;单机游戏;小游戏
-
'目录=C:\Program Files=qq;WinRAR
-
'文件=D:\网络游戏=文件1.exe;文件2.exe
-
'/配置文件结束
-
'''''''''''''说明完''''''''''''
-
-
Dim Fso,Listfile,objListfile
-
Listfile = "" '设置配置文件路径,如果配置文件和脚本放在一起，请保持原样
-
-
If Listfile = "" Then Listfile = "Listfile.ini"
-
Set Fso = CreateObject("Scripting.FileSystemObject")
-
On Error Resume Next
-
Set objListfile = Fso.OpenTextFile(Listfile,1)
-
If Err Then
-
err.Clear
-
Msgbox "没有找到配置文件 "&Listfile,16,"错误"
-
WScript.quit
-
End If
-
On Error GoTo 0
-
-
Dim flnum,fdnum,t1,t2,tm
-
flnum=0
-
fdnum=0
-
t1 = timer()
-
-
Dim Myline,LineArr,ListArr
-
Do While objListfile.AtEndOfStream <> True
-
Myline = LCase(Replace(objListfile.ReadLine,"==","="))
-
If Left(Myline,1) = "/" Then
-
'objListfile.SkipLine
-
ElseIf CheckLine(Myline) = 2 Then
-
LineArr = Split(Myline,"=")
-
'DoFolder = LineArr(1)
-
ListArr = Split(LineArr(2),";")
-
'MsgBox LineArr(0)
-
If LineArr(0) = "目录" Then DelFolder LineArr(1),ListArr
-
If LineArr(0) = "文件" Then DelFile LineArr(1),ListArr
-
End If
-
Loop
-
-
t2 = timer()
-
tm=cstr(int(( (t2-t1)*10000 )+0.5)/10)
-
-
MsgBox "扫描完毕，共删除 "&fdnum&" 个目录, "&flnum& "个文件。"& vbCrLf &"耗时 "&tm&" 毫秒",64,"执行完毕"
-
'不需要显示报告的话，注释掉上面这一行
-
-
Set Fso=NoThing
-
WScript.quit
-
-
Sub DelFolder(Folder,ListArr)
-
Dim objFolder,subFolders,subFolder
-
Set objFolder=Fso.Getfolder(Folder)
-
Set subFolders=objFolder.subFolders
-
For Each subFolder In subFolders
-
If Not InArray(LIstArr,LCase(subFolder.name)) Then
-
On Error Resume Next
-
subfolder.Delete(True)
-
If Err Then
-
err.Clear
-
Msgbox "不能删除目录，请检查 "&subFolder,16,"错误"
-
Else
-
fdnum = fdnum + 1
-
End If
-
On Error GoTo 0
-
End If
-
Next
-
End Sub
-
-
Sub DelFile(Folder,ListArr)
-
Dim objFolder,Files,File
-
Set objFolder=Fso.Getfolder(Folder)
-
Set Files=objFolder.Files
-
For Each File In Files
-
If Not InArray(LIstArr,LCase(File.name)) Then
-
On Error Resume Next
-
File.Delete(True)
-
If Err Then
-
err.Clear
-
Msgbox "不能删除文件，请检查 "&File,16,"错误"
-
Else
-
flnum = flnum + 1
-
End If
-
On Error GoTo 0
-
End If
-
Next
-
End Sub
-
-
Function CheckLine(strLine)
-
Dim LineRegExp,Matches
-
Set LineRegExp = New RegExp
-
LineRegExp.Pattern = ".=."
-
LineRegExp.Global = True
-
Set Matches = LineRegExp.Execute(strLine)
-
CheckLine = Matches.count
-
End Function
-
-
Function InArray(Myarray,StrIn)
-
Dim StrTemp
-
InArray = True
-
For Each StrTemp In Myarray
-
If StrIn = StrTemp Then
-
Exit Function
-
Exit For
-
End If
-
Next
-
InArray = False
-
End Function
