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
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
