赤月屠龙元宝无限手游:VBS脚本删除指定以外的文件或文件夹
来源:百度文库 编辑:九乡新闻网 时间:2024/04/27 16:42:23
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
''''''''''''''说明''''''''''''
'网盟-黑火制作,送给需要的朋友。
'配置文件“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
VBS脚本删除指定以外的文件或文件夹
怎样用VBS的脚本来删除文件
vbs删除多个文件夹内的多个文件
用vbs删除某文件夹下的所有文件怎么写?
系统提示无法删除文件或文件夹的解决
系统提示无法删除文件或文件夹的解决办法
系统提示无法删除文件或文件夹的解决办法
怎样禁止别人删除“文件”或“文件夹”?
无法删除文件夹 文件正在被另一个人或程序使用,无法删除文件夹 目录不是空的
删除文件或者文件夹的另一种方法
无法删除文件、文件夹无法删除的解决方法
因找不到指定文件无法删除
“无法删除 文件:无法读源文件或磁盘”1-文件夹无法删除的最终而有效的解决方法 - powered by Discuz!
“无法删除 文件:无法读源文件或磁盘”.-文件夹无法删除的最终而有效的解决方法 - powered by Discuz!
加密文件或文件夹
asp.net?如何定时删除某文件夹下的文件
各种顽固文件及文件夹的删除方法
数据恢复、还原删除的文件及文件夹
用vbs删除前一天创建的备份文件
转贴:无法删除文件_找不到指定文件--解决办法
windows文件夹中的哪些文件可以删除
剑思庭--VBS脚本宝典教程
隐藏文件或文件夹的四种常用方法
清除电脑上奇怪的顽固文件或文件夹