• 企业400电话
  • 微网小程序
  • AI电话机器人
  • 电商代运营
  • 全 部 栏 目

    企业400电话 网络优化推广 AI电话机器人 呼叫中心 网站建设 商标✡知产 微网小程序 电商运营 彩铃•短信 增值拓展业务
    用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
    上一篇:vbs实现右键菜单中添加CMD HERE
    下一篇:用VBS记录客户机操作的代码
  • 相关文章
  • 

    © 2016-2020 巨人网络通讯 版权所有

    《增值电信业务经营许可证》 苏ICP备15040257号-8

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