четверг, 12 января 2012 г.

Выгонялка пользователей из 1С 8.x

'basename-Имя базы в кластере серверов 1с
'updateway - Путь к файлу обновления
'platform - Платформа 1с (8.1/8.2)
'srv1c - Сервер 1с
'srvUser - пользователя для входа на сервер 1с
'srvPasswd- пароль пользователя для входа на сервер 1с
'confchanged - булево - конфигурация изменена. Выполнить только принятие изменений конфигурации
Function GetUpdateForConfig(basename,updateway,platform,srv1c,srvUser,srvPasswd,baseUsr,basepwd,confchanged)

allowdisconnect=false
'Если мы работаем с 12 до 6 утра - мы можем выгнать пользователей
if Hour(now())>0 and Hour(now)<6 then
allowdisconnect=true
End if

set Connector=CreateObject("V" & Replace(platform,".","") & +".ComConnector")

set AgentConnection=Connector.ConnectAgent(srv1c)


set Cluster=AgentConnection.GetClusters() (0)

AgentConnection.Authenticate Cluster,srvUser,srvPasswd

'WorkingProcess = AgentConnection.GetWorkingProcesses(Cluster)[0];
Process = AgentConnection.GetWorkingProcesses(Cluster)

for each WorkingProcess in Process
if WorkingProcess.Running<>0 then
ConnectString = WorkingProcess.HostName & ":" & WorkingProcess.MainPort
set WorkingProcessConnection = Connector.ConnectWorkingProcess("tcp://" & ConnectString)
WorkingProcessConnection.AddAuthentication baseUsr,basepwd

set ibDesc = WorkingProcessConnection.CreateInfoBaseInfo()
ibDesc.Name = basename

Connections = WorkingProcessConnection.GetInfoBaseConnections(ibDesc)


for each Connection in Connections
if LCase(Connection.AppID) <> "comconsole" then
if allowdisconnect then
WorkingProcessConnection.Disconnect Connection
ShowStatus "Discconnect соединения " & Trim(Connection.ConnID),true,false
else
ShowStatus "Есть работающие пользователи.",false,false
GetUpdateForConfig=0
Exit function
End if
End if
Next

End if

Next


ShowStatus "Запуск обновления " & updateway,true,false

ProcId=0


constr="/S""" & srv1c & "\" & basename & """"

if baseUsr<>"" then
constr=constr & " /N" & baseUsr & " /P" & basepwd
end if

if not confchanged then
constr=constr & " /UpdateCfg""" & updateway & """"
end if

constr=constr & " /UpdateDBCfg"
if Way1cv81="" then
ShowStatus "Не заполнен путь к 81",true,true
GetUpdateForConfig=""
Exit function
End if
RunString="""" & Way1cv81 & "1cv8.exe"" CONFIG " & constr & ""


Resfile=WorkCatalog() & "result.txt"
RunString=RunString & " /Out""" & Resfile & """"

ShowStatus "Строка запуска: " & RunString,true,false

CreateProcess RunString,true
GetUpdateForConfig=ReadFileText(Resfile)

End Function

Комментариев нет:

Отправить комментарий