'[:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::]
'[:::][:::][:::] Переменные [:::][:::][:::][:::][:::][:::]
'[:::] Задержки
WaitMinutes = 0.1 'задержка выхода пользователей из базы после установки блокировки БД
WorkMinutes = 120 'предположительное время работы скрипта в минутах
'[:::] Аутентификация БД
Adm_Nm = "blank" 'Логин, "blank" = использовать NTLM
Adm_Pw = "blank" 'Пароль
Server_Nm = "1C" 'Сервер
DB_Nm = "backuptest" 'База
'[:::] Блокирока БД
Lock_Msg = "Внимание!"&vbCrLf&"Ведутся технические работы."&vbCrLf&"Доступ к базе данных закрыт."
Lock_PrmCode = "1" 'Код блокировки базы
'[:::] Пути и папки
str1CPath = "C:\Program Files\1cv81\bin\1cv8.exe"
BackupPrefix = "[test]" 'Префикс базы для файлов бекапа
BackupFolder = "D:\Backup\DT" 'Папка backup'a
LogFolder = BackupFolder 'Папка лога
massive_SyncFolders = Array("\\STORAGE_1\Backup_DT$", "\\STORAGE_2\Backup_DT$") 'Массив папок для копирования полученного бэкапа
'[:::] Массивы исключений
Excludes_Users = Array("Иванов И.И.", "Петров П.П.", "Сидоров К.К.", "Перепёлко Н.Т.") 'По имени пользователя
Excludes_Computers = Array("IVANOV", "PETROV", "SIDOROV", "PEREPELKO") 'По имени компьютера
'[:::] Отправка лога по почте
massive_Recipient = Array("Admin1@testov.net", "Admin2@testov.net", "Admin3@testov.net", "Admin4@testov.net") 'Массив рассылки
strSender = "test@test.local" 'Отправитель
strSMTP_Server_Nm = "SMTPSRV.test.local" 'Сервер
strSMTP_Server_Port = "25" 'Порт
strSMTP_User_Nm = "test@test.local" 'Логин
strSMTP_User_Pw = "testPWtest" 'Пароль
'[:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::]
'[:::][:::][:::] Тело скрипта [:::][:::][:::][:::][:::][:::]
'[:::] Заполняем переменные, открываем лог
Dim objConnector
Dim objCluster
Dim objWPConnection
Dim objInfoBase
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
BackupName = BackupPrefix&"_"&CurrentDTFormat()
Set LogTextStream = Log_Open_TextStream(LogFolder&"\"&BackupName&".txt")
LogTextStream.Write vbCrLf&"--------------- BEGIN ---------------------------------------------"&vbCrLf
LogTextStream.Write Now()&vbCrLf
LogTextStream.Write " Backup: '"&BackupName&"'"&vbCrLf
LogTextStream.Write " Server: '"&Server_Nm&"'"&vbCrLf
LogTextStream.Write " DB: '"&DB_Nm&"'"&vbCrLf
LogTextStream.Write " 1CPath: '"&str1CPath&"'"&vbCrLf
strSubject = "1c backup "&BackupName&": "
strTextBody = "Краткий лог выгрузки "&BackupName&":"&vbCrLf&vbCrLf
strAttachmentPath = LogFolder&"\"&BackupName&".txt"
FlagDBFound = False
Lock_TimeMnts = WaitMinutes + WorkMinutes
'[:::] Находим базу
Call DB_Find()'(LogTextStream, strTextBody, Server_Nm, DB_Nm, Adm_Nm, Adm_Pw, FlagDBFound, objConnector, objCluster, objWPConnection, objInfoBase)
'[:::] Отрабатываем ошибки
If Not FlagDBFound Then
LogTextStream.Write Now()&" База данных не найдена!"&vbCrLf
LogTextStream.Write Now()&vbCrLf
LogTextStream.Write "--------------- END ---------------------------------------------"&vbCrLf
LogTextStream.Close
strTextBody = strTextBody&"DB not found!"&vbCrLf
strSubject = strSubject&"FAIL. DB not found."
Call SendEmail()'(massive_Recipient, strSubject, strTextBody, strAttachmentPath, strSender, strSMTP_User_Nm, strSMTP_User_Pw, strSMTP_Server_Nm, strSMTP_Server_Port)
WScript.Quit
End If
'[:::] Устанавливаем блокировку
Call DB_Lock()'(LogTextStream, objInfoBase, objWPConnection, Lock_TimeMnts, Lock_Msg, Lock_PrmCode)
'[:::] Ждем пока пользователей выкинет
LogTextStream.Write Now()&" Ждем "&WaitMinutes&" минут ("&WaitMinutes*60&" секунд)..."&vbCrLf
WScript.Sleep(WaitMinutes*60*1000)
'[:::] Выкидываем тех, кто не вышел
Call DB_DropUsers()'(LogTextStream, strTextBody, objInfoBase, objWPConnection, FlagWasExceptions)
'[:::] Отрабатываем ошибки
If FlagWasExceptions Then
LogTextStream.Write Now()&" Выгрузка базы отменена по причине исключительной ситуации"&vbCrLf
LogTextStream.Write Now()&vbCrLf
LogTextStream.Write "--------------- END ---------------------------------------------"&vbCrLf
LogTextStream.Close
strTextBody = strTextBody&"Выгрузка базы отменена так как не все соединения были разорваны (найдены исключения)."&vbCrLf
strSubject = strSubject&"cancelled by exceptions."
Call SendEmail()'(massive_Recipient, strSubject, strTextBody, strAttachmentPath, strSender, strSMTP_User_Nm, strSMTP_User_Pw, strSMTP_Server_Nm, strSMTP_Server_Port)
WScript.Quit
End If
'[:::] Делаем backup
strTextBody = strTextBody&"Все соединения были успешно разорваны (исключений не найдено)."&vbCrLf
LogTextStream.Write Now()&" Лог выгрузки: {"&vbCrLf&vbCrLf
LogTextStream.Close
RunCommand = """"&str1CPath&""""
RunCommand = RunCommand&" DESIGNER"
RunCommand = RunCommand&" /S"""&Server_Nm&"\"&DB_Nm&""""
If Adm_Nm <> "blank" Then
RunCommand = RunCommand&" /N"""&Adm_Nm&""" /P"""&Adm_Pw&""""
Else
RunCommand = RunCommand&" /WA+"
End If
RunCommand = RunCommand&" /UC "&Lock_PrmCode
RunCommand = RunCommand&" /Visible"
RunCommand = RunCommand&" /Out"""&LogFolder&"\"&BackupName&".txt"""
RunCommand = RunCommand&" -NoTruncate"
RunCommand = RunCommand&" /DumpIB"""&BackupFolder&"\"&BackupName&".dt"""
objShell.Run RunCommand, 2, True
Set LogTextStream = Log_Open_TextStream(LogFolder&"\"&BackupName&".txt")
LogTextStream.Write vbCrLf&Now()&" }"&vbCrLf
'[:::] Отрабатываем ошибки
LogTextStream.Write Now()&" Проверяем физическое наличие backup'a:"&vbCrLf
If Not objFSO.FileExists(BackupFolder&"\"&BackupName&".dt") Then
LogTextStream.Write Now()&" Файл отсутствует! БАЗА НЕ ВЫГРУЖЕНА!!!"&vbCrLf
LogTextStream.Write Now()&vbCrLf
LogTextStream.Write "--------------- END ---------------------------------------------"&vbCrLf
LogTextStream.Close
strTextBody = strTextBody&"Файл отсутствует! БАЗА НЕ ВЫГРУЖЕНА!!!"&vbCrLf
strSubject = strSubject&"FAIL."
Call SendEmail()'(massive_Recipient, strSubject, strTextBody, strAttachmentPath, strSender, strSMTP_User_Nm, strSMTP_User_Pw, strSMTP_Server_Nm, strSMTP_Server_Port)
WScript.Quit
End If
LogTextStream.Write Now()&" Файл на месте. База выгружена."&vbCrLf
strTextBody = strTextBody&"Файл на месте. База выгружена."&vbCrLf
strSubject = strSubject&"success."
'[:::] Снимаем блокировку
Call DB_UnLock()'(LogTextStream, objInfoBase, objWPConnection)
'[:::] Синхронизируем папки бэкапов
LogTextStream.Write Now()&" Начинаем копировать в целевые папки синхронизации"&vbCrLf
strTextBody = strTextBody&"Синхронизация:"&vbCrLf
For Each SyncPath In massive_SyncFolders
LogTextStream.Write Now()&" <"&SyncPath&">:"
If objFSO.FolderExists(SyncPath) Then
LogTextStream.Write "Папка доступна. Запущено копирование."&vbCrLf
objFSO.CopyFile BackupFolder&"\"&BackupName&".dt" , SyncPath&"\", True
objFSO.CopyFile LogFolder&"\"&BackupName&".txt", SyncPath&"\", True
If objFSO.FileExists(SyncPath&"\"&BackupName&".dt") Then
strTextBody = strTextBody&"<"&SyncPath&">: ОК."&vbCrLf
LogTextStream.Write Now()&" ОК."
Else
strTextBody = strTextBody&"<"&SyncPath&">: FAIL."&vbCrLf
extStream.Write Now()&" FAIL."
End If
Else
strTextBody = strTextBody&"<"&SyncPath&">: FAIL."&vbCrLf
LogTextStream.Write "Папка недоступна."
End If
Next
'[:::] Закрываем лог
LogTextStream.Write Now()&vbCrLf
LogTextStream.Write "--------------- END ---------------------------------------------"&vbCrLf
LogTextStream.Close
'[:::] Отправляем сообщения по почте
Call SendEmail()'(massive_Recipient, strSubject, strTextBody, strAttachmentPath, strSender, strSMTP_User_Nm, strSMTP_User_Pw, strSMTP_Server_Nm, strSMTP_Server_Port)
'[:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::]
'[:::][:::][:::] Процедуры работы с базой данных [:::][:::][:::][:::][:::][:::]
' // Процедура находит нужную БД на сервере, и возвращает параметры соединений
' // Takes:
' // LogTextStream - (obj) Log stream
' // strTextBody - (str) Short log for mail
' // Server_Nm - (str) Server name
' // DB_Nm - (str) DataBase name
' // Adm_Nm - (str) Administrator user name
' // Adm_Pw - (str) Administrator user password
' // Returns (changes):
' // LogTextStream - (obj) Log stream
' // strTextBody - (str) Short log for mail
' // FlagDBFound - (boolean) true = database was found
' // objConnector - (obj) V81.COMConnector
' // objCluster - (obj) Cluster in server structure
' // objWPConnection - (obj) Connection to working process
' // objInfoBase - (obj) 1C database
Sub DB_Find()'(LogTextStream, strTextBody, Server_Nm, DB_Nm, Adm_Nm, Adm_Pw, FlagDBFound, objConnector, objCluster, objWPConnection, objInfoBase)
Dim ConnectString
FlagDBFound = False
Set objConnector = CreateObject("V81.COMConnector")
Set objAgent = objConnector.ConnectAgent(Server_Nm)
massive_objCluster = objAgent.GetClusters()
LogTextStream.Write Now()&" Получен список кластеров, начинаем перебор:"&vbCrLf
For Each objCluster In massive_objCluster
LogTextStream.Write Now()&" ["&objCluster.Name&"] {"&vbCrLf
objAgent.Authenticate objCluster, " ", " "
LogTextStream.Write Now()&" Аутентификация кластера пройдена"&vbCrLf
massive_objProcess = objAgent.GetWorkingProcesses(objCluster)
LogTextStream.Write Now()&" Получен список процессов, начинаем перебор:"&vbCrLf
For Each objProcess In massive_objProcess
LogTextStream.Write Now()&" HostName: '"&objProcess.HostName&"' Port: '"&objProcess.MainPort&"' {"&vbCrLf
ConnectString = objProcess.HostName&":"&objProcess.MainPort
Set objWPConnection = objConnector.ConnectWorkingProcess(ConnectString)
If Adm_Nm <> "blank" Then
objWPConnection.AddAuthentication Adm_Nm, Adm_Pw
LogTextStream.Write Now()&" Аутентификация процесса пройдена"&vbCrLf
Else
LogTextStream.Write Now()&" Использована NTLM аутентификация текущего пользователя"&vbCrLf
End If 'Adm_Nm <> "blank"
massive_objInfoBase = objWPConnection.GetInfoBases()
LogTextStream.Write Now()&" Получен список баз, начинаем перебор:"
For Each objInfoBase In massive_objInfoBase
LogTextStream.Write vbCrLf
LogTextStream.Write Now()&" <"&objInfoBase.Name&">"
If UCase(objInfoBase.Name) = UCase(DB_Nm) Then
'закрываем теги и выходим из процедуры
strTextBody = strTextBody&"DB Found: ["&objCluster.Name&"], HostName: '"&objProcess.HostName&"' Port: '"&objProcess.MainPort&"', <"&objInfoBase.Name&">."&vbCrLf
LogTextStream.Write ": Совпадение!"&vbCrLf
LogTextStream.Write Now()&" } HostName: '"&objProcess.HostName&"' Port: '"&objProcess.MainPort&"'"&vbCrLf
LogTextStream.Write Now()&" } ["&objCluster.Name&"]"&vbCrLf
FlagDBFound = True
Exit Sub
End If 'UCase(objInfoBase.Name) = UCase(DB_Nm)
Next 'massive_objInfoBase
LogTextStream.Write vbCrLf
LogTextStream.Write Now()&" } HostName: '"&objProcess.HostName&"' Port: '"&objProcess.MainPort&"'"&vbCrLf
Next 'massive_objProcess
LogTextStream.Write Now()&" } ["&objCluster.Name&"]"&vbCrLf
Next 'massive_objCluster
End Sub 'DB_Find'
' // Процедура устанавливает блокировку БД
' // Takes:
' // LogTextStream - (obj) Log stream
' // strTextBody - (str) Short log for mail
' // objInfoBase - (obj) 1C database
' // objWPConnection - (obj) Connection to working process
' // Lock_TimeMnts - (real) Time in minutes to lock
' // Lock_Msg - (str) Lock message displaying to user
' // Lock_PrmCode - (str) Lock permission code
' // Returns (changes):
' // LogTextStream - (obj) Log stream
Sub DB_Lock()'(LogTextStream, objInfoBase, objWPConnection, Lock_TimeMnts, Lock_Msg, Lock_PrmCode)
LogTextStream.Write Now()&" Устанавливаем блокировку базы ["&objInfoBase.Name&"] на "&Lock_TimeMnts&" минут:"&vbCrLf
objInfoBase.ConnectDenied = True
objInfoBase.DeniedFrom = CStr(Now())
objInfoBase.DeniedTo = CStr(DateAdd("n",Lock_TimeMnts,Now()))
objInfoBase.DeniedMessage = Lock_Msg
objInfoBase.PermissionCode = Lock_PrmCode
objWPConnection.UpdateInfoBase(objInfoBase)
LogTextStream.Write Now()&" done"&vbCrLf
End Sub 'DB_Lock'
' // Процедура снимает блокировку БД
' // Takes:
' // LogTextStream - (obj) Log stream
' // objInfoBase - (obj) 1C database
' // objWPConnection - (obj) Connection to working process
Sub DB_UnLock()'(LogTextStream, objInfoBase, objWPConnection)
LogTextStream.Write Now()&" Снимаем блокировку базы ["&objInfoBase.Name&"]:"&vbCrLf
objInfoBase.ConnectDenied = False
objWPConnection.UpdateInfoBase(objInfoBase)
LogTextStream.Write Now()&" done"&vbCrLf
End Sub 'DB_UnLock'
' // Процедура отключает подключения к БД
' // Takes:
' // LogTextStream - (obj) Log stream
' // strTextBody - (str) Short log for mail
' // objInfoBase - (obj) 1C database
' // objWPConnection - (obj) Connection to working process
' // Returns (changes):
' // LogTextStream - (obj) Log stream
' // strTextBody - (str) Short log for mail
' // FlagWasExceptions - (boolean) true = not all connections was disconnected
Sub DB_DropUsers()'(LogTextStream, strTextBody, objInfoBase, objWPConnection, FlagWasExceptions)
LogTextStream.Write Now()&" Получаем список подключений к базе, и отключаем их:"&vbCrLf
FlagWasExceptions = False
massive_objUserConnection = objWPConnection.GetInfoBaseConnections(objInfoBase)
For Each objUserConnection In massive_objUserConnection
LogTextStream.Write Now()&" name: '"&objUserConnection.UserName&"', computer:'"&objUserConnection.HostName&"', appID: '"&objUserConnection.AppID&"'"&vbCrLf
If (objUserConnection.AppID = "COMConsole") Then
LogTextStream.Write Now()&" тип подключения в списке исключений"&vbCrLf
ElseIf CheckMassiveForExactMatch(Excludes_Users, objUserConnection.UserName) Then
FlagWasExceptions = True
strTextBody = strTextBody&"(исключение по имени пользователя) name: '"&objUserConnection.UserName&"', computer:'"&objUserConnection.HostName&"', appID: '"&objUserConnection.AppID&"'."&vbCrLf
LogTextStream.Write Now()&" пользователь в списке исключений"&vbCrLf
ElseIf CheckMassiveForExactMatch(Excludes_Computers, objUserConnection.HostName) Then
FlagWasExceptions = True
strTextBody = strTextBody&"(исключение по имени комьюра) name: '"&objUserConnection.UserName&"', computer:'"&objUserConnection.HostName&"', appID: '"&objUserConnection.AppID&"'."&vbCrLf
LogTextStream.Write Now()&" компьютер в списке исключений"&vbCrLf
Else
objWPConnection.Disconnect objUserConnection
LogTextStream.Write Now()&" disconnected successfully"&vbCrLf
End If
Next
LogTextStream.Write Now()&" Отключили."&vbCrLf
End Sub 'DB_DropUsers'
'[:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::]
'[:::][:::][:::] Процедуры работы с почтой [:::][:::][:::][:::][:::][:::]
Sub SendEmail()'(massive_Recipient, strSubject, strTextBody, strAttachmentPath, strSender, strSMTP_User_Nm, strSMTP_User_Pw, strSMTP_Server_Nm, strSMTP_Server_Port)
Const cdoSendUsingPickup = 1 'Send message using the local SMTP service pickup directory.
Const cdoSendUsingPort = 2 'Send the message using the network (SMTP over the network).
Const cdoAnonymous = 0 'Do not authenticate
Const cdoBasic = 1 'basic (clear-text) authentication
Const cdoNTLM = 2 'NTLM
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = strSubject
objMessage.From = strSender
objMessage.BodyPart.Charset="windows-1251"
objMessage.TextBody = strTextBody
objMessage.AddAttachment strAttachmentPath
'==This section provides the configuration information for the remote SMTP server.
'==Normally you will only change the server name or IP.
' http://msdn.microsoft.com/en-us/library/ms526318(EXCHG.10).aspx
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTP_Server_Nm
'Type of authentication, NONE, Basic (Base64 encoded), NTLM
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
'Your UserID on the SMTP server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = strSMTP_User_Nm
'Your password on the SMTP server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strSMTP_User_Pw
'Server port (typically 25)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = strSMTP_Server_Port
'Use SSL for the connection (False or True)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/languagecode") = 1049
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/usemessageresponsetext") = true
objMessage.Configuration.Fields.Update
'==End remote SMTP server configuration section==
For Each strRecipient In massive_Recipient
objMessage.To = strRecipient
objMessage.Send
Next
End Sub 'SendEmail'
'[:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::][:::]
'[:::][:::][:::] Вспомогательные функции и процедуры [:::][:::][:::][:::][:::]
' // Процедура
Sub hz()
End Sub 'hz'
' // Функция открывает поток записи в текстовый файл
' // Takes:
' // FileName - (str) Full file name + path
' // Returns:
' // Log_Open_TextStream - (obj) Log stream
Function Log_Open_TextStream(FileName)
If objFSO.FileExists(FileName) Then
Set File = objFSO.GetFile(FileName)
Set Log_Open_TextStream = File.OpenAsTextStream(8)
Else
Set Log_Open_TextStream = objFSO.CreateTextFile(FileName, True)
End If
End Function 'Log_Open_TextStream'
' // Функция возвращает текущую дату в формате 'YYYY-MM-DD_HH'
' // Returns:
' // CurrentDTFormat - (str) current date in 'YYYY-MM-DD_HH' format
Function CurrentDTFormat()
'Месяц
m = Month(Date())
If m < 10 Then
m = "0"&m
End If
'День
d = Day(Date())
If d < 10 Then
d = "0"&d
End If
'Час
h = Hour(Time())
If h < 10 Then
h = "0"&h
End If
'Возвращаемое значение
CurrentDTFormat = Year(Date())&"-"&m&"-"&d&"_"&h
End Function 'CurrentDTFormat'
' // Функция производит поиск значения в массиве
' // Takes:
' // chkMassive - (str massive) Massive for check in
' // chkValue - (str) Value for check out
' // Returns:
' // CheckMassiveForExactMatch - (boolean) true = One of chkMassive values have exact match with chkValue
Function CheckMassiveForExactMatch(chkMassive, chkValue)
tmpFilter = Filter(chkMassive, chkValue)
CheckMassiveForExactMatch = False
If IsArray(tmpFilter) And UBound(tmpFilter) >= 0 Then
For Each tmpValue In tmpFilter
If tmpValue = chkValue Then
CheckMassiveForExactMatch = True
Exit Function
End If
Next
End If
End Function 'CheckMassiveForExactMatch'