Option Explicit

''''''''''''''說(shuō)明''''''''''''
'網(wǎng)盟-黑火制作，送給需要的朋友。
'配置文件“Listfile.ini”的格式如下：
'要?jiǎng)h除什么(文件|目錄)=要執(zhí)行刪除的文件夾=排除1;排除2;排除3............
'配置文件可以有多行，以便對(duì)多個(gè)目錄進(jìn)行操作。
'配置文件里以“/”開(kāi)頭的行為注釋行。
'排除多個(gè)內(nèi)容時(shí)，使用分號(hào)“;”進(jìn)行分隔。
'↓↓↓ 配置文件例子：↓↓↓
'/配置文件開(kāi)始
'目錄=D:\=System Volume Information;網(wǎng)絡(luò)游戲;單機(jī)游戲;小游戲
'目錄=C:\Program Files=qq;WinRAR
'文件=D:\網(wǎng)絡(luò)游戲=文件1.exe;文件2.exe
'/配置文件結(jié)束
'''''''''''''說(shuō)明完''''''''''''

Dim Fso,Listfile,objListfile
Listfile = ""           '設(shè)置配置文件路徑,如果配置文件和腳本放在一起，請(qǐng)保持原樣

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 "沒(méi)有找到配置文件 "&Listfile,16,"錯(cuò)誤"
     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&" 個(gè)目錄, "&flnum& "個(gè)文件。"& vbCrLf &"耗時(shí) "&tm&" 毫秒",64,"執(zhí)行完畢"
'不需要顯示報(bào)告的話(huà)，注釋掉上面這一行

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 "不能刪除目錄，請(qǐng)檢查 "&subFolder,16,"錯(cuò)誤"
         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 "不能刪除文件，請(qǐng)檢查 "&File,16,"錯(cuò)誤"
         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

最新評(píng)論