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 html教程
