1

Тема: VBS: удаление файлов исключая...

Здравствйте!
На форме был скрипт по удалению старых файлов исключая 1 папку :

Option Explicit
'=======================================================
Sub ClearSubFolders(objFolder)
    Dim objSubFolder
    Dim objFile

    For Each objSubFolder In objFolder.SubFolders
        If strPathNoClear <> objFolder.Path & "\" Then
        ClearSubFolders objSubFolder
        End If
    Next

    For Each objFile In objFolder.Files

        If DateDiff("s", objFile.DateCreated, Now()) > 1 AND _
    strPathNoClear <> objFolder.Path & "\" Then
            objFile.Delete(True)

        End If
    Next
End Sub
'=======================================================

Dim objWshShell

Dim objFS
Dim objFolder

Const strPathToClear = "C:\1\"
Const strPathNoClear = "C:\1\2\"
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")

ClearSubFolders objFS.GetFolder(strPathToClear)

WScript.Quit

Помогите его модифицировать чтоб в исключение от удаления входила не только папка strPathNoClear, но и файл - C:\1\.htaccess
Было бы не плохо чтоб эти файл и папка исключения задавались списком(на 2-3 позиции)!
Спасибо!

2 (изменено: CAMITHbIK, 2011-08-04 10:30:08)

Re: VBS: удаление файлов исключая...

' VBScript
Option Explicit
'=======================================================
Sub ClearSubFolders(objFolder)
    Dim objSubFolder
    Dim objFile
    Dim boolExcept
    
    boolExcept = InStr(1, strPathNoClear, objFolder.Path & ";", 1) > 0
    
    ' путь папки в списке исключений
    If boolExcept Then 
        If boolNoDeepInExcept Then Exit Sub
    End If
    
    For Each objSubFolder In objFolder.SubFolders
        ClearSubFolders objSubFolder
    Next

    If boolExcept Then Exit Sub
    
    For Each objFile In objFolder.Files
        If InStr(1, strFileNoDel, objFile.Path, 1) = 0 Then
        ' путь файла НЕ в списке исключений - продолжаем
        
            If DateDiff("s", objFile.DateCreated, Now()) > 1 Then

                objFile.Delete(True)

            End If
        End If
    Next
End Sub
'=======================================================


Const strPathToClear = "C:\1"

' списки исключений, разделитель - точка с запятой
' в конце списка тоже точка с запятой
' (!) пути папок без завершающего бэкслэша
Const strPathExcept = "C:\1\2;C:\1\4;C:\1\12\1;"
Const strFileNoDel = "C:\1\.htaccess;C:\1\3\.htaccess;"

' следует ли исключать из обработки только папки из списка исключений,
' или также все их подпапки
' False: обрабатывать подпапки папок из списка исключений
' True:  не обрабатывать
Const boolNoDeepInExcept = True

Dim objFS

Set objFS = WScript.CreateObject("Scripting.FileSystemObject")

ClearSubFolders objFS.GetFolder(strPathToClear)

WScript.Quit
С уважением, CAMITHbIK