Ждать завершения процесса + ошибка архивации пустой папки

[vavun]

Здравствуйте.

Имеется скрипт следующего вида

Спойлер: Код

strComputer = "Vavun-Desktop"
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcesses = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = 'firefox.exe'")
Set objArgs = WScript.Arguments
DIM fso  
Set fso = CreateObject("Scripting.FileSystemObject")

If Not (fso.FileExists("D:\BACKUP\Mozilla\Mozilla " & date & ".zip")) Then
   If colProcesses.Count = 0 Then
      InputFolder = "C:\Users\Vavun\AppData\Roaming\Mozilla\"
      ZipFile = "D:\BACKUP\Mozilla\Mozilla " & date & ".zip" 'папка BACKUP синхронизируется с облаками
      CreateObject("Scripting.FileSystemObject").CreateTextFile(ZipFile, True).Write "PK" & Chr(5) & Chr(6) & String(18, vbNullChar)
      Set objShell = CreateObject("Shell.Application")
      Set source = objShell.NameSpace(InputFolder).Items
      objShell.NameSpace(ZipFile).CopyHere(source)
 
      Do Until objShell.NameSpace(ZipFile).Items.Count = objShell.NameSpace(InputFolder).Items.Count
         WScript.Sleep 500
      Loop
   End If
End If

По нему имеется два вопроса:
1) Как заставить скрипт ожидать завершения процесса firefox.exe ?
2) Почему я получаю ошибку

Проблема в папке C:\Users\Vavun\AppData\Roaming\Mozilla\Extensions
Появляется во время работы браузера
При ее удалении ошибок нет (она пустая)

 

[Dragokas]

Здравствуйте, vavun !

Задача оказалась немного нетривиальной. Да и в интернете решений нет.
Проблема связана с багом метода CopyHere и стандартными способами его обойти нельзя.
При попытке архивации пустой папки получаем ошибку "Windows не удалось добавить один или несколько пустых каталогов в сжатую папку".

Решений несколько:
1) временно удалить папку;
2) временно скопировать что-нибудь в эту папку. Можно даже другую пустую папку.
Оба метода ведут к возможным проблемам с правами.
3) установить фильтр по белому списку для объекта FolderItems, чем я и занялся.

Заодно добавил несколько рюшек. Полный код класса можно получить здесь.

Для архивирования папки достаточно только этой части класса:

Спойлер

Set fso = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("WScript.Shell")

'Дата, отформатированная в виде DD.MM.YYYY
FormattedDate = Right(0 & Day(now),2) & "." & Right(0 & Month(now),2) & "." & Year(now)

' ===========================================================================================================================
' архив
ZipFile = "D:\BACKUP\Mozilla\Mozilla " & FormattedDate & ".zip" 'папка BACKUP синхронизируется с облаками
' папка для архивации
InputFolder = oShell.ExpandEnvironmentStrings("%AppData%") & "\Mozilla" '"C:\Users\Vavun\AppData\Roaming\Mozilla\"
' ===========================================================================================================================

'Ожидание завершения процесса Firefox
call WaitProcess("firefox.exe")

If fso.FileExists(ZipFile) Then WScript.Quit ' Выйти, если архив был создан ранее

call CopyFolderToArchive(ZipFile, InputFolder)


Sub CopyFolderToArchive(ZipFile, InputFolder)
    Const SHCONTF_FILES_AND_FOLDERS = &H100E0& 'SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN or SHCONTF_INCLUDESUPERHIDDEN
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set oShApp = CreateObject("Shell.Application")
    fso.CreateTextFile(ZipFile, True).Write "PK" & Chr(5) & Chr(6) & String(18, vbNullChar) 'создаю заготовку пустого архива ZIP
    WScript.Sleep(300) ' нужна задержка, чтобы скрипт успел закрыть запись
    Set oArchive = oShApp.NameSpace(ZipFile)
    set oFolderItems = oShApp.NameSpace(InputFolder).Items
    oFolderItems.Filter SHCONTF_FILES_AND_FOLDERS, "*" 'включаем в архив скрытые файлы
    For each oFolderItem in oFolderItems ' поиск пустых папок
        isEmptyFolder = false
        if oFolderItem.IsFolder then if oFolderItem.GetFolder.Items.Count = 0 then isEmptyFolder = true
        if not isEmptyFolder then sFilter = sFilter & ";" & replace(oFolderItem.Name, ";", "?") ' белый список объектов для фильтра
    Next
    oFolderItems.Filter SHCONTF_FILES_AND_FOLDERS, mid(sFilter, 1) 'применяю фильтр
    ArcItemsNewCount = oArchive.Items.Count + oFolderItems.Count ' расчетное кол-во файлови папок, которые окажутся в архиве
    oArchive.CopyHere oFolderItems ' архивирую
    Do: Wscript.Sleep 200: Loop Until oArchive.Items.Count => ArcItemsNewCount 'Выжидаем пока кол-во объектов в ZIP-архиве станет >= копируемым в него
End Sub

Sub WaitProcess(ProcessName)
    strComputer = "." 'Vavun-Desktop (точка - текущий ПК)
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Do while objWMIService.ExecQuery("Select * from Win32_Process Where Name = '" & ProcessName & "'").Count <> 0: WScript.Sleep(200): Loop
End Sub

По вопросу № 1 ответил в коде.

 

[vavun]

Dragokas, большое спасибо !
И отдельное спасибо за комментарии в коде

 

[Dragokas]

Это даже не комментарии (я себе писал, чтоб не забыть, зачем оно нужно )

 

[vavun]

Dragokas, Тем не менее лишний раз в гугл не пришлось ходить )