Скрипт VBS для обслуживания 1с 8.2

Делюсь своими наработками, может кому пригодится:

On Error Resume Next 'Если ошибка трудимся дальше

'Соединители с системой
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
Set objShellApp = CreateObject("Shell.Application")
Set objEmail = CreateObject("CDO.Message")
Set objNet = CreateObject("WScript.Network")

'Переменные - то что можно менять!
BkPath = "c:\backup1c" 'Папка для архивации
Server1c = objNet.ComputerName 'Сервер 1с, если этот компьютер - оставляем. Если нет, то пишем имя сервера.
ServerPort = 1541 'Порт кластера
ClasterAdminName = "Администратор" 'Имя администратора консоли сервера 1с
ClasterAdminPass = "Welcome1c82" 'Пароль администратора консоли сервера 1с
DbUser = "backup" 'Имя пользователя, который делает обслуживание баз
DbPass = "rgn357plm" 'Пароль пользавотеля, который делает обслуживание баз
WorkProccess = 2 'Количество рабочих процессов
AdressUpdate = "Ленинградская 77" 'Адрес обслуживания

EmailServer = "192.168.0.100" 'Адрес smtp IP или имя(smtp.mail.ru)
SmtpPort = 25 'Порт smtp
AuthServ = 1 'smtp сервак просит аутентификации(1 - да, 0 - нет)
EmailUser = "it" 'Логин для почты
EmailPass = "jrbf34dujh243" 'Пароль для почты
MailTo = "it@marten.ru" 'Кому пишем письмо
MailFrom = "1cUpdateLen@marten.ru " 'От кого пишем письмо

ClusterPort = ServerPort - 1 'Порт для COM соединителя
ServerName = Server1c & ":" & ClusterPort 'Переменная для поиска имён баз

'Чистим временную папку бекапа от мусора
sDirectoryPath = BkPath
set oFolder = FSO.GetFolder(sDirectoryPath)
set oFolderCollection = oFolder.SubFolders
set oFileCollection = oFolder.Files
For each oFile in oFileCollection
oFile.Delete(True)
Next
For each oDelFolder in oFolderCollection
oDelFolder.Delete(True)
Next

'Проверяем путь до программы 1с
'PathProg = WshShell.ExpandEnvironmentStrings("%PROGRAMFILES%")
PathExe = "c:\Program Files\1cv82\common\1cestart.exe"
Path1cExeC = "c:\Program Files (x86)\1cv82\common\1cestart.exe"
If (FSO.FileExists(PathExe)) Then
Path1C = """c:\Program Files\1cv82\common\1cestart.exe"""
End if
If (FSO.FileExists(PathExeC)) Then
Path1C = """c:\Program Files (x86)\1cv82\common\1cestart.exe"""
End if

'Имя архива
NameArch = Day(date) & "-" & MonthName(Month(date),true) & "-" & Year(date) & "_" & WeekdayName (Weekday(date))

'Создаем файл лога
FSO.CreateTextFile (BkPath & "\" & NameArch & ".log")
Set File =FSO.GetFile (BkPath & "\" & NameArch & ".log")
Set TextStream = File.OpenAsTextStream(8)
TextStream.WriteLine Date & " - Обновление и исправление баз 1с. <hr> "
TextStream.Close

'Создаем файл лога от 1с
FSO.CreateTextFile (BkPath & "\" & NameArch & "-1c.log")
Set File =FSO.GetFile (BkPath & "\" & NameArch & "-1c.log")
Set TextStream = File.OpenAsTextStream(8)
TextStream.WriteLine Date
TextStream.Close

'Проверка на существование локальных папок и их создания в случае отсутствия
If Not FSO.FolderExists (BkPath) then
Set objFolder = objShellApp.NameSpace (Left(BkPath, 3))
objFolder.NewFolder (Mid(BkPath, 4))
End If

'В терминале есть запущенная 1с - исправим
WshShell.Run "TASKKILL /F /IM 1cv8*",0,True

'Выгоняем всех из ваз, проходим по рабочим процессам
For count = 0 To (WorkProccess-1)
Set Connector = CreateObject("v82.COMConnector")
Set AgentConnection = Connector.ConnectAgent(ServerName)
Set Clasters = AgentConnection.GetClusters()(0)
AgentConnection.authenticate Clasters, ClasterAdminName, ClasterAdminPass
Set WorkingProcesses = AgentConnection.GetWorkingProcesses(Clasters)(count)
Set ConnectToWorkProcess = Connector.ConnectWorkingProcess("tcp://" + WorkingProcesses.HostName + ":" + CStr(WorkingProcesses.MainPort))
ConnectToWorkProcess.AuthenticateAdmin ClasterAdminName, ClasterAdminPass
InfoBases = ConnectToWorkProcess.GetInfoBases()

For e = LBound(InfoBases) To UBound(InfoBases)
Set Base = InfoBases(e)
DbName = Base.Name
ConnectToWorkProcess.AddAuthentication DbUser, DbPass
Set ibDesc = ConnectToWorkProcess.CreateInfoBaseInfo()
ibDesc.Name = DbName
Connections = ConnectToWorkProcess.GetInfoBaseConnections(ibDesc)

For i = LBound(Connections) To UBound(Connections)
Set Connection = connections(i)
If (Connection.AppID <> "COMConsole") then
ConnectToWorkProcess.Disconnect Connection
End if
Next
Next
Next

'Обслуживание баз
Set Connector = CreateObject("v82.COMConnector")
Set AgentConnection = Connector.ConnectAgent(ServerName)
Set Clasters = AgentConnection.GetClusters()(0)
AgentConnection.authenticate Clasters, ClasterAdminName, ClasterAdminPass
Set WorkingProcesses = AgentConnection.GetWorkingProcesses(Clasters)(0)
Set ConnectToWorkProcess = Connector.ConnectWorkingProcess("tcp://" + WorkingProcesses.HostName + ":" + CStr(WorkingProcesses.MainPort))
ConnectToWorkProcess.AuthenticateAdmin ClasterAdminName, ClasterAdminPass
InfoBases = ConnectToWorkProcess.GetInfoBases()

AllError = 0 'Счетчик ошибок

For e = LBound(InfoBases) To UBound(InfoBases)
Set Base = InfoBases(e)
DbName = Base.Name

Param1C = " CONFIG /S " & Server1c & ":" & ServerPort & "\" & DbName & " /N " &DbUser & " /P " & DbPass & ""
DumpOut1C = " /Out """ & BkPath & "\" & NameArch & "-1c.log""" & " -NoTruncate"
UpdDb =" /UpdateDBCfg /DisableStartUpMessages " & DumpOut1C
CChkDb =" /IBCheckAndRepair /DisableStartUpMessages " & DumpOut1C

Run1CUbdDb = Path1C & Param1C & UpdDb & DumpOut1C
Run1CChkDb = Path1C & Param1C & CChkDb & DumpOut1C

Set File =FSO.GetFile (BkPath & "\" & NameArch & ".log")
Set TextStream = File.OpenAsTextStream(8)
TextStream.WriteLine Time & " База - " & DbName & " "
TextStream.Close

'Обновляем базу
WshShell.Run Run1CUbdDb,0,True
'Если 1с ещё запущена то ждем
MonitorProcces

Set File =FSO.GetFile (BkPath & "\" & NameArch & ".log")
Set TextStream = File.OpenAsTextStream(8)
If SetError > 0 Then
TextStream.WriteLine "Ошибка обновления "
AllError = AllError + 1
Else
TextStream.WriteLine "Обновление закончилось успешно "
End if
TextStream.Close

'Тестируем базу
WshShell.Run Run1CChkDb,0,True
'Если 1с ещё запущена то ждем
MonitorProcces

Set File =FSO.GetFile (BkPath & "\" & NameArch & ".log")
Set TextStream = File.OpenAsTextStream(8)
If SetError > 0 Then
TextStream.WriteLine "Ошибка тестирования "
AllError = AllError + 1
Else
TextStream.WriteLine "Тестирование закончилось успешно "
End if
TextStream.Close

Next

'Записываем в лог о количестве ошибок
Set File =FSO.GetFile (BkPath & "\" & NameArch & ".log")
Set TextStream = File.OpenAsTextStream(8)
If AllError > 0 Then
TextStream.WriteLine "<hr>Обслуживание завершилось с ошибками! Количество ошибок: " & AllError & " "
Else
TextStream.WriteLine "<hr>Обслуживание закончилось успешно "
End if
TextStream.Close

'Читаем лог и переносим тело в массив
Set Text = FSO.OpenTextFile(BkPath & "\" & NameArch & ".log ")
LogRead = LogRead & Text.ReadAll & vbCrLf
Text.Close

'Готовим сообщение и крепим массив строчек из лога
MailSubject = AdressUpdate & " . Обновление и исправление 1с. Дата " & NameArch
MailTextbody = LogRead

'Отправим письмо
SendEMail Message, Attach

'Функция ожидания просесса 1cv8.exe
Sub MonitorProcces
SetError = 0
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcesses = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name ='1cv8.exe'")
count = 0
Do While colProcesses.Count > 0
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcesses = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name ='1cv8.exe'")
WScript.Sleep 2000
count = count + 1
'Может процесс повис? Тогда убьем процесс
if (count=400) Then
WshShell.Run "TASKKILL /F /IM 1cv8*",0,True
SetError = 1
End if
Loop
End Sub

'Выгоняем всех из терминала, если нужно
Sub OffTerminal
Set objProc = WshShell.Exec("C:\WINDOWS\system32\logoff.exe RDP-Tcp /SERVER:localhost")
objProc.StdIn.WriteLine "Y"
Do While objProc.Status = 0
WScript.Sleep 100
Loop
End Sub

'Функция отправки письма
Sub SendEMail (Message, Attach)
objEmail.From = MailFrom
objEmail.To = MailTo
objEmail.Subject = MailSubject
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = EmailServer
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SmtpPort
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = AuthServ
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = EmailUser
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = EmailPass
objEmail.Configuration.Fields.Update
objEmail.HTMLBody = MailTextbody
If Attach <> "" Then
objEmail.AddAttachment Attach
End If
objEmail.Send
End Sub
'Конец скрипта