VBS. Рекурсивное удаление файлов и папок

LoD
Сообщения: 2
Зарегистрирован: 07 апр 2011
Доброго времени суток.
Т.к. сам с Воронежа, поэтому взял патриотизм и решил написать здесь, чем где то еще.
Воронежские программисты лучшие программисты страны :)

Итак, я отвлекся.
А речь пойдет вот о чём:
Появилась задача очистки каталогов от устаревших файлов.
Общий ресурс на сервере.
Структура вида:
Change
- IT-отдел
- Экономический отдел
- Отдел кадров
- Директор

В каждом отделе пользуны хранят непойми что. Так как в отделе могут находится бесчисленное множество вложенных подкаталогов, необходимо использовать рекурсию.

Ниже код на VBS:

Код: Выделить всё

Set objFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = "d:\Test\" 'папка которую очищаем
arrPath =array("d:\Test\","d:\Test\Test1","d:\Test\Test2","d:\Test\Test3") 'не удаляемые папки (содержимое удалится)

On Error Resume Next
Const Age = 10 'возраст файла

Set objFolder = objFSO.GetFolder(objstartfolder)
Set colFiles = objFolder.Files
For Each objFile in colFiles
   If DateDiff("D", objFile.DateLastModified, Now) > Age Then ' проверка файлов на старость
      Log (objFolder.Path & "\" & objFile.Name & " - " & objFile.DateLastModified)
      objFile.Attributes = 0
      objFile.Delete
   End If
Next

ShowSubfolders objFSO.GetFolder(objStartFolder)

Sub ShowSubFolders(Folder)
   For Each Subfolder in Folder.SubFolders
      Set objFolder = objFSO.GetFolder(subfolder.Path)
      p=false
      i=lbound(arrPath)
      WHILE (p=false) and (i<=ubound(arrPath))
         If (objfolder.path=arrPath(i) ) then
            p=true
         End if
         i=i+1
      WEND
      If (not p) Then
         'Wscript.Echo objfolder.path & " - " & "udalat` mozna"
         ' 1) проверить файлы на старость
         Set colFiles = objFolder.Files
         For Each objFile in colFiles
            If DateDiff("D", objFile.DateLastModified, Now) > Age Then ' проверка файлов на старость
               Log (objFolder.Path & "\" & objFile.Name & " - " & objFile.DateLastModified)
               objFile.Attributes = 0
               objFile.Delete
            End If
         Next
         ' 2) проверить каталог на пустоту
         If objFolder.Subfolders.Count > 0 Then
            ShowSubFolders SubFolder
         End If
         If subFolder.Files.Count > 0 AND subFolder.Subfolders.Count > 0 Then
            WScrip.echo "test"
            'MsgBox "Directory " & subFolder & "- ne pusta."
         Else
            Log(subFolder.Path & " - " & subFolder.Datecreated)
            objFSO.DeleteFolder(subFolder.Path)   
         End If
      End If
   Next
End Sub

'функция для создания log-файла. он создается рядом со скриптом, имя - дата запуска скрипта.
Function Log(strLineToLog)
   Const ForReading = 1, ForWriting = 2
   Dim fso, f, FileLog
   Set fso = CreateObject("Scripting.FileSystemObject")
   FileLog = Left(WScript.ScriptName,(Len(WScript.ScriptName)-4)) & "_" & DatePart("yyyy",Date) & "_" & DatePart("m",Date) & "_" & DatePart("d",Date) & "." & "log"
   Set f = fso.OpenTextFile(FileLog, 8, True)
   f.Write strLineToLog & vbCrLf
   f.Close
End Function


Т.е. нам нужно удалить все файлы из отделов (и их подпапок) которые старше 10 дней.
Если папка пуста, то удаляем папку и не важно когда она была создана. Папки исключения (названия отделов и корень) НЕ удаляем в любом случае.
Если подпапка не пуста (в ней новый файл), то такая подпапка НЕ удаляется вне зависимости от даты создания папки.


Проблема с этим скриптом в том, что он корректно срабатывает только в корне при операциях с файлами.
Папки (в том числе и исключения!) он трет, даже если в них лежит свежий файл..

Помогите найти косяки в коде.

Заранее благодарен

Аватара пользователя
AgentSIB
Администратор
Сообщения: 329
Зарегистрирован: 17 май 2010
Оу, vbs, давно дело было :)) Если будет еще актуально - вечером после работы гляну.
Frustra fit per plura quod potest fieri per pauciora © Закон "Бритвы Оккама"

LoD
Сообщения: 2
Зарегистрирован: 07 апр 2011
Думаю тут главное не торопиться :)
Особенно с удалением :)


Вернуться в «Вопросы по программированию»