用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