⽤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 = unt
End Function
Function InArray(Myarray,StrIn)
Dim StrTemp
InArray = True
For Each StrTemp In Myarray
If StrIn = StrTemp Then
Exit Function
Exit For
vbs脚本怎么停止
End If
Next
InArray = False
End Function

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。