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

1. Option Explicit 
2.  
3. ''''''''''''''说明'''''''''''' 
4. '网盟-黑火制作，送给需要的朋友。 
5. '配置文件“Listfile.ini”的格式如下： 
6. '要删除什么(文件|目录)=要执行删除的文件夹=排除1;排除2;排除3............ 
7. '配置文件可以有多行，以便对多个目录进行操作。 
8. '配置文件里以“/”开头的行为注释行。 
9. '排除多个内容时，使用分号“;”进行分隔。 
10. '↓↓↓ 配置文件例子：↓↓↓ 
11. '/配置文件开始 
12. '目录=D:\=System Volume Information;网络游戏;单机游戏;小游戏 
13. '目录=C:\Program Files=qq;WinRAR 
14. '文件=D:\网络游戏=文件1.exe;文件2.exe 
15. '/配置文件结束 
16. '''''''''''''说明完'''''''''''' 
17.  
18. Dim Fso,Listfile,objListfile 
19. Listfile = ""           '设置配置文件路径,如果配置文件和脚本放在一起，请保持原样 
20.  
21. If Listfile = "" Then Listfile = "Listfile.ini" 
22. Set Fso = CreateObject("Scripting.FileSystemObject") 
23. On Error Resume Next 
24. Set objListfile = Fso.OpenTextFile(Listfile,1) 
25. If Err Then 
26.      err.Clear 
27.      Msgbox "没有找到配置文件 "&Listfile,16,"错误" 
28.      WScript.quit 
29. End If 
30. On Error GoTo 0 
31.  
32. Dim flnum,fdnum,t1,t2,tm 
33. flnum=0 
34. fdnum=0 
35. t1 = timer() 
36.  
37. Dim Myline,LineArr,ListArr 
38. Do While objListfile.AtEndOfStream <> True 
39.      Myline = LCase(Replace(objListfile.ReadLine,"==","=")) 
40.      If Left(Myline,1) = "/" Then 
41.      'objListfile.SkipLine 
42.      ElseIf CheckLine(Myline) = 2 Then 
43.          LineArr = Split(Myline,"=") 
44.          'DoFolder = LineArr(1) 
45.          ListArr = Split(LineArr(2),";") 
46.    'MsgBox LineArr(0) 
47.          If LineArr(0) = "目录" Then DelFolder LineArr(1),ListArr 
48.          If LineArr(0) = "文件" Then DelFile LineArr(1),ListArr 
49.      End If 
50. Loop 
51.  
52. t2 = timer() 
53. tm=cstr(int(( (t2-t1)*10000 )+0.5)/10) 
54.  
55. MsgBox "扫描完毕，共删除 "&fdnum&" 个目录, "&flnum& "个文件。"& vbCrLf &"耗时 "&tm&" 毫秒",64,"执行完毕" 
56. '不需要显示报告的话，注释掉上面这一行 
57.  
58. Set Fso=NoThing 
59. WScript.quit 
60.  
61. Sub DelFolder(Folder,ListArr) 
62. Dim objFolder,subFolders,subFolder 
63.      Set objFolder=Fso.Getfolder(Folder) 
64.      Set subFolders=objFolder.subFolders 
65.      For Each subFolder In subFolders 
66.      If Not InArray(LIstArr,LCase(subFolder.name)) Then 
67.      On Error Resume Next 
68.          subfolder.Delete(True) 
69.          If Err Then 
70.              err.Clear 
71.              Msgbox "不能删除目录，请检查 "&subFolder,16,"错误" 
72.          Else 
73.          fdnum = fdnum + 1 
74.          End If 
75.          On Error GoTo 0 
76.      End If 
77.      Next 
78. End Sub 
79.  
80. Sub DelFile(Folder,ListArr) 
81. Dim objFolder,Files,File 
82.      Set objFolder=Fso.Getfolder(Folder) 
83.      Set Files=objFolder.Files 
84.      For Each File In Files 
85.      If Not InArray(LIstArr,LCase(File.name)) Then 
86.      On Error Resume Next 
87.          File.Delete(True) 
88.          If Err Then 
89.              err.Clear 
90.              Msgbox "不能删除文件，请检查 "&File,16,"错误" 
91.          Else  
92.          flnum = flnum + 1 
93.          End If 
94.          On Error GoTo 0 
95.      End If 
96.      Next 
97. End Sub 
98.  
99. Function CheckLine(strLine) 
100. Dim LineRegExp,Matches 
101. Set LineRegExp = New RegExp 
102. LineRegExp.Pattern = ".=." 
103. LineRegExp.Global = True 
104. Set Matches = LineRegExp.Execute(strLine) 
105. CheckLine = Matches.count 
106. End Function 
107.  
108. Function InArray(Myarray,StrIn) 
109. Dim StrTemp 
110. InArray = True 
111. For Each StrTemp In Myarray 
112.      If StrIn = StrTemp Then 
113.          Exit Function 
114.          Exit For 
115.      End If 
116. Next 
117. InArray = False 
118. End Function