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
Появляется во время работы браузера
При ее удалении ошибок нет (она пустая)
Задача оказалась немного нетривиальной. Да и в интернете решений нет.
Проблема связана с багом метода CopyHere и стандартными способами его обойти нельзя.
При попытке архивации пустой папки получаем ошибку "Windows не удалось добавить один или несколько пустых каталогов в сжатую папку".
Решений несколько:
1) временно удалить папку;
2) временно скопировать что-нибудь в эту папку. Можно даже другую пустую папку.
Оба метода ведут к возможным проблемам с правами.
3) установить фильтр по белому списку для объекта FolderItems, чем я и занялся.
Заодно добавил несколько рюшек. Полный код класса можно получить здесь.
Для архивирования папки достаточно только этой части класса:
VB.NET / VBA:
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