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

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

Итак, я отвлекся.
А речь пойдет вот о чём:
Появилась задача очистки каталогов от устаревших файлов.
Общий ресурс на сервере.
Структура вида:
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
Оу, vbs, давно дело было :)) Если будет еще актуально - вечером после работы гляну.
Вернуться к началу

LoD
Думаю тут главное не торопиться :)
Особенно с удалением :)
Вернуться к началу