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