1 Тема от Liga010 (изменено: Liga010, 2011-11-04 13:13:40)

  • Liga010
  • Участник
  • Неактивен

Тема: VBS: Поиск файлов по маске и их удаление..

Здравствуйте, уважаемые форумчане.
Мне нужна ваша помощь в написании скрипта на VBS. Задача состоит в том, чтобы скрипт искал файлы по маске в заданной директории и подпапки, затем удалял файлы и пустые подпапки, и создавал log с названиями файлов и папок которые были удалены. Порылся в инете, но дельных скритов не нашел.:( Может у кого есть уже готовый скрипт. Буду очень благодарен, за помощь!

2 Ответ от Xameleon

  • Xameleon
  • Разработчик
  • Неактивен

Re: VBS: Поиск файлов по маске и их удаление..

2 Liga010: Позвольте поинтересоваться, какие запросы вы делали в поисковике (google например) ?

Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !

3 Ответ от Liga010 (изменено: Liga010, 2011-11-04 20:46:52)

  • Liga010
  • Участник
  • Неактивен

Re: VBS: Поиск файлов по маске и их удаление..

Такие запросы: удаление файлов по маске на VBS
                        удаление файлов в подпапках на VBS

4 Ответ от Xameleon

  • Xameleon
  • Разработчик
  • Неактивен

Re: VBS: Поиск файлов по маске и их удаление..

Прекрасно. Я тоже самое спросил у googl-а.

Первые же 2 ссылки

1) КЦ КЕЙ • Просмотр темы - Подскажите скрипт для удаления файл...
2) VBS/WSH/JS - [решено] WSH скрипт для удаления файлов (логика скрипта внутри)

Посмотрел код. Рекурсивный обход папок есть. Поиск по маске есть. Почему не подошло ?

Дальше сделал поиск по форуму запросом "Поиск файлов по маске" (с которого как раз было предпочтительнее начинать)

1)WSH: Поиск файлов по маске на сервере
2)VBS: поиск по маске в одном каталоге
3)VBS: Удаление файлов по маске

И Вы утверждаете, что ничего не нашли ? )

Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !

5 Ответ от Liga010 (изменено: Liga010, 2011-11-07 10:12:43)

  • Liga010
  • Участник
  • Неактивен

Re: VBS: Поиск файлов по маске и их удаление..

To Xameleon: Спасибо за ссылки. Я нашел такой скрипт VBS, как к нему прикрутить маску удаляемых файлов?? Я в этом полный 0, help!

Set objFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = "D:\Test\" 'папка которую очищаем
arrPath =array("d:\Test\","d:\Test\test1","d:\Test\test2", "d:\Test\test3") 'папки которые исключаем

Set objFolder = objFSO.GetFolder(objstartfolder)
Set colFiles = objFolder.Files
For Each objFile in colFiles
    If DateDiff("D", objFile.DateLastModified, Now) > 10 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) > 10 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
'    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

6 Ответ от Liga010

  • Liga010
  • Участник
  • Неактивен

Re: VBS: Поиск файлов по маске и их удаление..

Если кого не затруднит помогите пожалуйста со скриптом, очень надо.( Спасибо!

7 Ответ от alexii

  • alexii
  • Разработчик
  • Неактивен

Re: VBS: Поиск файлов по маске и их удаление..

Liga010, вот Вам без лог-файла:

Option Explicit

Dim objFSO
Dim intErrorLevel

Dim strPathToClear
Dim strFileMask


intErrorLevel = 0

With WScript.Arguments.Named
    If .Exists("PathToClear") And .Exists("FileMask") Then
        strPathToClear = .Item("PathToClear")
        strFileMask    = .Item("FileMask")
        
        WScript.Echo strPathToClear
        WScript.Echo strFileMask
        
        Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
        
        If objFSO.FolderExists(strPathToClear) Then
            ClearSubFolders objFSO.GetFolder(strPathToClear), strFileMask
        Else
            intErrorLevel = 2
        End If
        
        Set objFSO = Nothing
    Else
        intErrorLevel = 1
    End If
End With

WScript.Quit intErrorLevel
'=============================================================================

'=============================================================================
Sub ClearSubFolders(objFolder, strMask)
    Dim objSubFolder
    
    For Each objSubFolder In objFolder.SubFolders
        ClearSubFolders objSubFolder, strMask
    Next
    
    On Error Resume Next
    objFSO.DeleteFile objFSO.BuildPath(objFolder, strMask), True
    On Error Goto 0
    
    If (objFolder.Files.Count = 0) And (objFolder.SubFolders.Count = 0) Then
        If Not (objFolder.Path = strPathToClear) Then
            objFolder.Delete True
        End If
    End If
End Sub
'=============================================================================