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

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

时间2024-02-11 09:30:02发布访客分类脚本浏览612
导读:收集整理的这篇文章主要介绍了用VBS脚本删除指定以外的文件或文件夹,觉得挺不错的,现在分享给大家,也给大家做个参考。 Option ExplicIT ''''''''''''''说明''...
收集整理的这篇文章主要介绍了用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

声明:本文内容由网友自发贡献,本站不承担相应法律责任。对本内容有异议或投诉,请联系2913721942#qq.com核实处理,我们将尽快回复您,谢谢合作!


若转载请注明出处: 用VBS脚本删除指定以外的文件或文件夹
本文地址: https://pptw.com/jishu/609621.html
vbs实现右键菜单中添加CMD HERE 用VBS记录客户机操作的代码

游客 回复需填写必要信息