Книга знаний

AdBlock убивает бесплатный контент
1С:Предприятие

Полезный скрипт для обновления конфигурации

Скрипт: ставит блокировку регламентных заданий и на вход с отсрочкой 10 минут, готовит обновление,
<br>через 10 минут принудительно всех выгоняет, обновляет базу, запускает обработчики, снимает
блокировку,
<br>отправляет логи в почту.
Автор статьи: rphosts
Последняя редакция №1 от 30.08.15
URL: http://kb.mista.ru/article.php?id=944

Ключевые слова: обновление, конфигурации, динамическое


Текст VB-скрипта любезно предоставлен и публикуется с разрешения автора
http://www.forum.mista.ru/users.php?id=25627
Раскраска выполнена в стиле редактора кода 1С (так нагляднее).

' Обновление базы:
' 1. Предупреждением пользователей: ставим блокировку начала сеанса. Начало действия - "сейчас" плюс 
10 минут.
' 2. Пока пользователи выходят, готовим файл обновления и обновляем конфигурацию.
' 3. Ждем, когда наступит время начала блокировки.
' 4. Принудительно завершаем сеансы.
' 5. Обновляем конфигурацию БД
' 6. Снимаем блокировку
'
' Планы:
' 1. Надо предусмотреть, что на ночь могут запускать групповое перепроведение, которое прерывать 
нельзя.
'    Поскольку в бух 3.0 оно выполняется в фоновом задании, то определить его можно по наличию
'    активного фонового задания с названием "Групповое перепроведение документов"
' 2. Посмотреть как будет работать, если база в монопольном режиме
' 3. Опционально перезапуск рабочих процессов или агента сервера
' 4. Проверить, как будет работать получение InfoBaseInfo, если подключились к отключенному рабочему 
процессу.
'    Возможно придется перебирать рабочие процессы в поисках активного.
' 5. Оптимизация кода
' 6. Во время ожидания начала блокировки, периодически проверять количество сессий. Раз в 5 секунд 
например.
'    Сейчас такая проверка выполняется один раз. Это позволит сэкономить некоторое количество 
времени, если пользователи вышли заранее.
' 7. При подсчете количества сессий не учитывать "Консоль кластера" (SrvrConsole) и "COM-
администратор" (COMConsole)
' 8. Сделать чтоб скрипт был один, к нему файлы с настройками в XML например

Option Explicit

Dim AgentServer,AgentPort,ClusterServer,ClusterPort,InfoBaseName,IBConnectionString
Dim Connector,AgentConnection,ClusterInfo,WorkingProcessConnection,InfoBaseInfo,InfoBaseShort
Dim ExternalConnection
Dim DateDeniedFrom
Dim DiffSec
Dim FSO,WshShell
Dim ExecFile
Dim LogPath
Dim RepositoryInfoBase,RepositoryF,RepositoryN,RepositoryP
Dim DistributionFile
Dim objlogStep3UpdateCfgFile,objlogStep5UpdateIBFile
Dim Version1C
Dim Install32Path,Install64Path
Dim ExpressionResult,AfterUpdateExpression,AfterUpdateExpressions(0) 'количество строк минус 1
Dim SMTPServer,MailFrom,MailTo

'Значения этих переменных надо внести руками
AgentServer = "appenergo2"     'сервер, где расположен агент сервера 1С
AgentPort = 2540               'порт агента сервера 1С
ClusterServer = "appenergo2"   'сервер, где расположен менеджер кластера 1С
ClusterPort = 2541             'порт менеджера кластера
InfoBaseName = "Base1" 'имя базы в кластере

RepositoryInfoBase = "File=""E:\1C_Base_for_Update"";" 'строка соединения с базой подключенной к 
хранилищу
LogPath = "c:\Scripts\Logs\Engineering\"               'папка куда складывать логи
RepositoryF = """tcp://appenergo2:1542/1C_Depository_ING_2014"""  'адрес хранилища
RepositoryN = """ReadOnly"""                                      'пользователь хранилища
RepositoryP = """"""                                              'пароль пользователя хранилища
DistributionFile = """e:\DistributionFiles\Engineering\1Cv8.cf""" 'файл поставки

Version1C = "8.3.5.1383" 'версия 1С
Install32Path = "c:\Program Files (x86)\1cv8\" & Version1C & "\bin\" 'путь папки bin 32 бит
Install64path = "c:\Program Files\1cv8\"       & Version1C & "\bin\" 'путь папки bin 64 бит

'Выражения, которые будут выполняться после обновления
'Для бухгалтерии 2.0:
'AfterUpdateExpressions(0) = "ExternalConnection.[ОбновлениеИнформационнойБазы].
[ВыполнитьОбновлениеИнформационнойБазы]()"
'Для бухгалтерии 3.0:
'AfterUpdateExpressions(0) = "ExternalConnection.[СтандартныеПодсистемыСервер].
[УстановитьЗапускОбновленияИнформационнойБазы](True)"
'AfterUpdateExpressions(1) = "ExternalConnection.[ОбновлениеИнформационнойБазы].
[ВыполнитьОбновлениеИнформационнойБазы]()"

AfterUpdateExpressions(0) = "ExternalConnection.[ОбновлениеИнформационнойБазы].
[ВыполнитьОбновлениеИнформационнойБазы]()"

'для отправки логов. остальное в процедуре SendUpdateIBResult
SMTPServer = "smtp.xxx.com" 'адрес SMTP сервера
MailFrom = "robot@xxx.com"            'отправитель
MailTo = "Igor@xxx.com; Anton@xxx.com" 'получатели. если переменная не заполнена, то отправки не 
будет




'Поехали

'Инициализация
Call Initialise

'Блокировка базы через 10 минут
DateDeniedFrom = DateAdd("n", 10, Now) 'сейчас плюс 10 минут
Call BlockInfoBase(DateDeniedFrom)

'Обновление промежуточной базы из хранилища
WshShell.Run ExecFile & " DESIGNER" & _
" /IBConnectionString " & RepositoryInfoBase & _
" /Out " & FSO.BuildPath(LogPath, "log_Step1_ConfRepUpdateCfg.txt") & _
" /ConfigurationRepositoryF " & RepositoryF & _
" /ConfigurationRepositoryN " & RepositoryN & _
" /ConfigurationRepositoryP " & RepositoryP & _
" /ConfigurationRepositoryUpdateCfg -force -revised /UpdateDBCfg",, True

'Создание файла поставки
WshShell.Run ExecFile & " DESIGNER" & _
" /IBConnectionString " & RepositoryInfoBase & _
" /Out " & FSO.BuildPath(LogPath, "log_Step2_CreateDistribFiles.txt") & _
" /ConfigurationRepositoryF " & RepositoryF & _
" /ConfigurationRepositoryN " & RepositoryN & _
" /ConfigurationRepositoryP " & RepositoryP & _
" /CreateDistributionFiles -cffile " & DistributionFile,, True

'Завершим конфигуратор, на случай, если кто-то там засел
Call TerminateDesignerSession

'Обновление конфигурации
WshShell.Run ExecFile & " DESIGNER" & _
" /IBConnectionString " & IBConnectionString & _
" /Out " & FSO.BuildPath(LogPath, "log_Step3_UpdateCfg.txt") & _
" /WA+ /DisableStartupMessages" & _
" /UpdateCfg " & DistributionFile,, True

'если обновления нет, то снимаем блокировку и выходим
Set objlogStep3UpdateCfgFile = FSO.OpenTextFile(FSO.BuildPath(LogPath, "log_Step3_UpdateCfg.txt"), 
1, True)
If Not objlogStep3UpdateCfgFile.AtEndOfLine Then
    If objlogStep3UpdateCfgFile.ReadLine = "Файл не содержит доступных обновлений" Then
        objlogStep3UpdateCfgFile.Close
        Call UnblockInfoBase
        Call SendUpdateIBResult
        WScript.Quit
    End If
    objlogStep3UpdateCfgFile.Close
End If

'Ждем, когда наступит время начала блокировки
DiffSec = DateDiff("s", Now, InfoBaseInfo.DeniedFrom)
If DiffSec > 0 Then

    'проверим, если количество сессий > 0, то подождем
    If GetCountInfoBaseSessions() > 0 Then
        WScript.Sleep DiffSec * 1000
    Else
        Call BlockInfoBase(Now)
    End If

End If

'Принудительно завершаем работу пользователей, вдруг кто-то не отвалился/не вышел
Call TerminateSessions

'Обновление конфигурации БД
WshShell.Run ExecFile & " DESIGNER" & _
" /IBConnectionString " & IBConnectionString & _
" /Out " & FSO.BuildPath(LogPath, "log_Step4_UpdateDBCfg.txt") & _
" /WA+ /DisableStartupMessages /UpdateDBCfg -Server -Dynamic-",, True

'Запись результата выполнения обработчиков
Set objlogStep5UpdateIBFile = FSO.CreateTextFile(FSO.BuildPath(LogPath, 
"log_Step5_UpdateInfoBase.txt"))
objlogStep5UpdateIBFile.WriteLine "Запуск служебных обработчиков:"

'Выполнение обработчиков после обновления. Выполняются во внешнем соединении
If Not IsEmpty(AfterUpdateExpressions) Then
    Set ExternalConnection = Connector.Connect(IBConnectionString)

    For Each AfterUpdateExpression In AfterUpdateExpressions
        ExpressionResult = Eval(AfterUpdateExpression)
        objlogStep5UpdateIBFile.WriteLine ExpressionResult
    Next
    
End If

objlogStep5UpdateIBFile.Close

'Разблокировка базы
Call UnblockInfoBase

'Отправка логов
If Not IsEmpty(MailTo) And MailTo <> "" Then
    Call SendUpdateIBResult
End If

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'устанавлиает блокировку базы
Sub BlockInfoBase(ByVal DateDeniedFrom)
    InfoBaseInfo.PermissionCode = "0000"
    InfoBaseInfo.SessionsDenied = True
    InfoBaseInfo.ScheduledJobsDenied = True
    InfoBaseInfo.DeniedFrom = DateDeniedFrom
    InfoBaseInfo.DeniedTo = DateSerial(100, 1, 1) 'пустая дата
    InfoBaseInfo.DeniedMessage = "Обновление информационной базы"

    WorkingProcessConnection.UpdateInfoBase(InfoBaseInfo)
End Sub

'отменяет блокировку базы
Sub UnblockInfoBase()
    InfoBaseInfo.ScheduledJobsDenied = False
    InfoBaseInfo.SessionsDenied = False

    WorkingProcessConnection.UpdateInfoBase(InfoBaseInfo)
End Sub

'разрывает все соединения с базой
Sub TerminateSessions()
    Dim SessionInfo
  
    For Each SessionInfo in AgentConnection.GetInfoBaseSessions(ClusterInfo, InfoBaseShort)
        AgentConnection.TerminateSession ClusterInfo, SessionInfo
    Next

End Sub

'завершает работу конфигуратора
Sub TerminateDesignerSession()
    Dim SessionInfo
  
    For Each SessionInfo in AgentConnection.GetInfoBaseSessions(ClusterInfo, InfoBaseShort)
        If SessionInfo.AppID = "Designer" Then
            AgentConnection.TerminateSession ClusterInfo, SessionInfo
        End If
    Next

End Sub

'возвращает количество сессий ИБ
Function GetCountInfoBaseSessions()
    Dim InfoBaseSessions

    InfoBaseSessions = AgentConnection.GetInfoBaseSessions(ClusterInfo, InfoBaseShort)
    GetCountInfoBaseSessions = UBound(InfoBaseSessions)+1

End Function

'отправляет в почту логи обновления
Sub SendUpdateIBResult()
  Dim objEmail
  Dim File,Folder

  Set Folder = FSO.GetFolder(LogPath)

  Set objEmail = WScript.CreateObject("CDO.Message")
  objEmail.From = MailFrom
  objEmail.To = MailTo
  objEmail.BodyPart.Charset = "windows-1251"
  objEmail.BodyPart.ContentTransferEncoding = "base64"
  objEmail.Subject = "Результат обновления " & InfoBaseName
'  objEmail.Textbody = ""
  objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
  objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = 
SMTPServer
  For Each File In Folder.Files
    objEmail.AddAttachment(File.Path)
  Next
  objEmail.Configuration.Fields.Update
  objEmail.Send

  Set objEmail = Nothing
  Set Folder = Nothing

End Sub

'Регистрирует comcntr.dll
Sub RegComcntr(Path)
    If FSO.FileExists(Path) Then
        WshShell.Run "regsvr32 /s """ & Path & """",, True
    End If
End Sub

'инициализация
Sub Initialise()
    Dim WorkingProcessInfo
    Dim ConnectString
    Dim ClusterInfoOK,InfoBaseInfoOK,InfoBaseShortOK

    Set WshShell = CreateObject("WScript.Shell")
    Set FSO = CreateObject("Scripting.FileSystemObject")

    Call RegComcntr(FSO.BuildPath(Install32Path, "comcntr.dll"))
    Call RegComcntr(FSO.BuildPath(Install64Path, "comcntr.dll"))

    Set Connector = CreateObject("V83.COMConnector")
    Set AgentConnection = Connector.ConnectAgent(AgentServer & ":" & AgentPort)
    For Each ClusterInfo In AgentConnection.GetClusters()
        If ClusterInfo.MainPort = ClusterPort And LCase(ClusterInfo.HostName) = LCase(ClusterServer) 
Then
            ClusterInfoOK = True
            Exit For
        End If  
    Next

    AgentConnection.Authenticate ClusterInfo, "", ""

    Set WorkingProcessInfo = AgentConnection.GetWorkingProcesses(ClusterInfo)(0)
    ConnectString = WorkingProcessInfo.HostName & ":" & WorkingProcessInfo.MainPort
    Set WorkingProcessConnection = Connector.ConnectWorkingProcess(ConnectString)
    For Each InfoBaseInfo In WorkingProcessConnection.GetInfoBases()     
        If LCase(InfoBaseInfo.Name) = LCase(InfoBaseName) Then
            InfoBaseInfoOK = True
            Exit For
        End If  
    Next
    For Each InfoBaseShort In AgentConnection.GetInfoBases(ClusterInfo)
        If LCase(InfoBaseShort.Name) = LCase(InfoBaseName) Then
            InfoBaseShortOK = True
            Exit For
        End If
    Next
    IBConnectionString = "Srvr=""" & ClusterServer & ":" & ClusterPort & """;Ref=""" & InfoBaseName 
& """;UC=0000;"
    ExecFile = """" & FSO.BuildPath(Install32Path, "1cv8.exe") & """"
    FSO.DeleteFile FSO.BuildPath(LogPath, "*"), 1
End Sub
Закладка

Описание | Рубрикатор | Поиск | ТелепатБот | Захваченные статьи | Установки | Форум
© Станислав Митичкин (Волшебник), 2005-2011 | Mista.ru

Яндекс.Метрика