用VBS脚本删除指定以外的文件或文件夹

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