Comments / Profile of Voron095 / Habr

Александр Скляров @Voron095

User

Profile Publications Comments 16Bookmarks 196

Управление списком баз 1С 8.2 с помощью Active Directory

Voron095 Jul 28 2014 at 10:43

Писалось для 1С 8.1 8.2, на основании этого добра, со скуки был написан генератор этого скрипта на delphi (если нужно, попробую почистить его и выложить)
Функции:
Добавление, исправление, записей к базам.
Создание файла с записями, если не существовал.
Установка новых релизов платформ (требует ввода пароля во всплывающем окне командной строки для пользователя Setup@DOMAIN.LOCAL). Криво, но на тот момент вариантов увы не было.
Фильтрация добавления, исправления, записей к базам для конкретных групп.
Установка компоненты ScanOPOS для 1С
и может быть что то еще ))

Код

on error resume next

Dim FSO,WshShell,WshEnvVolatile,WshEnvUser,UserProfile
Dim Title81(),Server81(),Base81(),ConnType81(),Incor81(),Add81()
Dim Title82(),Server82(),Base82(),ConnType82(),Incor82(),Add82()
Dim arrMyFile81,arrMyFile82

Set WshShell = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WshEnvVolatile = WshShell.Environment("Volatile")
Set WshEnvUser = WshShell.Environment("User")
Set WshEnvPROCESS = WshShell.Environment("PROCESS")
Set WshNet=WScript.CreateObject("WScript.Network")
Set objGroup1 = GetObject("LDAP://CN="+WshNet.UserName+",CN=Users,DC=DOMAIN,DC=LOCAL")
GroupList=objGroup1.GetEx("memberOf")
'#################Настройки#####################
SkipChekBase81 = 1 ' Если 1, то не исправлять пути к базам 8.1
SkipChekBase82 = 1 ' Если 1, то не исправлять пути к базам 8.2
SkipAddBase81 = 1 ' Если 1, не добавлять новые базы 8.1
SkipAddBase82 = 0 ' Если 1, не добавлять новые базы 8.2
SkipEraseCache82 = 1  ' Если 1, не очищать кэш 8.2
SkipEndEcho = 1 ' Если 1, не показывать сообщение по окончанию работы скрипта

SkipSetup = 1  ' Если 1, не производить установку
strRELIZ = "C:\Program Files\1cv82\8.2.13.205\"
strRunRELIZ = "\\DOMAIN.LOCAL\SYSVOL\DOMAIN.LOCAL\1C_82\setup.exe"
strRunAs = "runas /user:Setup@DOMAIN.LOCAL"
ScanOposdll = "\\DOMAIN.LOCAL\SYSVOL\DOMAIN.LOCAL\1C_82\ScanOPOS.dll\"
SkipScanOpos = 1  ' Если 1, не производить установку ScanOpos.dll в папку strRELIZ\bin\

'Не выполнять для пользователей входящих в группу
SkipGroup = "GroupProg1C"
SkipGroupChekBase81 = 1 ' Если 1, то не исправлять пути к базам 8.1
SkipGroupChekBase82 = 1 ' Если 1, то не исправлять пути к базам 8.2
SkipGroupAddBase81 = 1 ' Если 1, не добавлять новые базы 8.1
SkipGroupAddBase82 = 1 ' Если 1, не добавлять новые базы 8.2


'###############################################

Numb81 = -1 'не менять
Numb82 = -1 'не менять

'##### 8.1 Bases #####
'ZP_GR
Numb81=Numb81+1 'не менять
Redim Preserve Title81(Numb81),Server81(Numb81),Base81(Numb81),ConnType81(Numb81),Incor81(Numb81),Add81(Numb81) 'не менять
Title81(Numb81) = "[ZP_GR]"
ConnType81(Numb81) = "Srvr"
Server81(Numb81) = "bdsrv"
Base81(Numb81) = "ZP_GR"
Incor81(Numb81) = 0 'не менять
Add81(Numb81) =  0 'Если 1, то прописать базу

'Торговое оборудование
Numb81=Numb81+1
Redim Preserve Title81(Numb81),Server81(Numb81),Base81(Numb81),ConnType81(Numb81),Incor81(Numb81),Add81(Numb81)
Title81(Numb81) = "[РўРѕСЂРіРѕРІРѕРµ РѕР±РѕСЂСѓРґРѕРІР°РЅРёРµ]"
ConnType81(Numb81) = "Srvr"
Server81(Numb81) = "bdsrv"
Base81(Numb81) = "TorgovoeOborudovanie"
Incor81(Numb81) = 0 'не менять
Add81(Numb81) =  0 'Если 1, то прописать базу


'#####################
'Мусор, но без него удаляются записи 8.1
ID = "ID=00000000-0000-0000-0000-00000000001"
OrderInList = "OrderInList=0"
Folder = "Folder=/"
OrderInTree = "OrderInTree=0"
External = "External=0"
'#####################

'##### 8.2 Bases #####

'Сайт_через_сайт
Numb82=Numb82+1
Redim Preserve Title82(Numb82),Server82(Numb82),Base82(Numb82),ConnType82(Numb82),Incor82(Numb82),Add82(Numb82)
Title82(Numb82) = "[РЎР°Р№С‚]"
ConnType82(Numb82) = "ws"
Server82(Numb82) = "http://SRV.RU:8081/"
Base82(Numb82) = "dsite/"
Incor82(Numb82) = 0 'не менять
Add82(Numb82) =  0 'Если 1, то прописать базу

'Сайт_Резерв
Numb82=Numb82+1
Redim Preserve Title82(Numb82),Server82(Numb82),Base82(Numb82),ConnType82(Numb82),Incor82(Numb82),Add82(Numb82)
Title82(Numb82) = "[РЎР°Р№С‚_Р РµР·РµСЂРІ]"
ConnType82(Numb82) = "Srvr"
Server82(Numb82) = "SRV"
Base82(Numb82) = "dsite"
Incor82(Numb82) = 0 'не менять
Add82(Numb82) = 1 'Если 1, то прописать базу

If SkipSetup = 0 Then
  If NOT FSO.FileExists(strRELIZ & "bin\1cv8.exe") Then
	Set oExec = WshShell.Run(strRunAs & " " & Chr(34) & strRunRELIZ & " /S" & Chr(34),1,true)
  'Else 
    'WScript.Echo "Релиз 8.2.13.205 уже установлен. Нажмите " &Chr(34)& "Ок" &Chr(34)& " для продолжения"
  End If
End If  
If SkipScanOpos = 0 Then
	If NOT FSO.FileExists(strRELIZ & "bin\ScanOPOS.dll") Then
	  TimeStart = 0
	  Do 
	    If FSO.FolderExists(strRELIZ & "bin") Then Exit Do End If
	    TimeStart = TimeStart + 1
        WScript.sleep 30000
	  Loop Until TimeStart = 10
      Set oExec1 = WshShell.Run(strRunAs & Chr(32) & Chr(34) & "cmd " & Chr(47)& "C copy " & Chr(92) & Chr(34) & ScanOposdll & Chr(34) & Chr(32) & Chr(92) & Chr(34)& strRELIZ & "\bin\" & Chr(92) & Chr(34) & Chr(34),1,true)  
	End If
End If


AppData = WshEnvVolatile.Item("APPDATA")
UserName = WshEnvUser.Item("USERNAME")
Path1C = AppData & "\1C"


Path1C81 = AppData & "\1C\1Cv81" 'Путь к папке с файлом базы
File1C81 = Path1C81 & "\ibases.v8i"
File1C81New = Path1C81 & "\ibases.new"

Path1C82 = AppData & "\1C\1CEStart" 'Путь к папке с файлом базы
File1C82 = Path1C82 & "\ibases.v8i"
File1C82New = Path1C82 & "\ibases.new"

for Each val in GroupList 
  str = lcase(val)
  str1 = lcase("CN="&SkipGroup&",CN=Users,DC=DOMAIN,DC=LOCAL")
  If str=str1 Then
    If SkipGroupChekBase81 = 1 Then SkipChekBase81 = 1 End If
    If SkipGroupChekBase82 = 1 Then SkipChekBase82 = 1 End If
    If SkipGroupAddBase81 = 1 Then SkipAddBase81  = 1 End If
    If SkipGroupAddBase82 = 1 Then SkipAddBase82  = 1 End If
  End if
next

'#########################################
If FSO.FolderExists(Path1C) Then  'Проверка существования пути AppData & "\1C", если нет, создаем
Else
  FSO.CreateFolder(AppData & "\1C") 'Создаем папку "\1C"
End If

If FSO.FolderExists(Path1C81) Then  'Проверка существования пути, если нет, создаем
  If FSO.FileExists(File1C81) Then 'Проверка существования файла баз, если нет, создаем
    Set File81 = FSO.OpenTextFile(File1C81, 1) 'Читаем файл с базами
    Set Temp81 = FSO.CreateTextFile(File1C81New, true) 'Создаем temp фаил
  Else
    Set File81 = FSO.CreateTextFiles(File1C81, true) 'Создаем File фаил
    Set Temp81 = FSO.CreateTextFile(File1C81New, true) 'Создаем temp фаил  
  End If
Else
  FSO.CreateFolder(AppData & "\1C\1Cv81")
  Set File81 = FSO.CreateTextFiles(File1C81, true) 'Читаем файл с базами
  Set Temp81 = FSO.CreateTextFile(File1C81New, true) 'Создаем temp фаил
End If

If FSO.FolderExists(Path1C82) Then  'Проверка существования пути, если нет, создаем
  If FSO.FileExists(File1C82) Then 'Проверка существования файла баз, если нет, создаем
    Set File82 = FSO.OpenTextFile(File1C82, 1) 'Читаем файл с базами
    Set Temp82 = FSO.CreateTextFile(File1C82New, true) 'Создаем temp фаил
  Else
    Set File82 = FSO.CreateTextFiles(File1C82, true) 'Создаем File фаил
    Set Temp82 = FSO.CreateTextFile(File1C82New, true) 'Создаем temp фаил  
  End If
Else
  FSO.CreateFolder(AppData & "\1C\1CEStart")
  Set File82 = FSO.CreateTextFiles(File1C82, true) 'Читаем файл с базами
  Set Temp82 = FSO.CreateTextFile(File1C82New, true) 'Создаем temp фаил
End If
'#########################################


  arrMyFile81 = Split(File81.ReadAll, vbNewLine) 'Создаем массив из файла с базами 81
  For a = 0 To UBound(arrMyFile81) 'Читаем поэлементно массив arrMyFile81
   str81 = arrMyFile81(a) 'строка из массива
   str81Low = lcase(arrMyFile81(a)) 'строка из массива переведенная в нижний регистр
   If InStr(1, str81Low, "connect", vbTextCompare) Then 'Находим строку с путями к базе
     Result = 0 'Флаг нахождения строки конекта, если база не указанна в списке, то строка будет записанна без изменений
     For b = 0 To UBound(Base81) 'Обрабатываем массив предопределенных баз
       If InStr(1, str81Low, lcase(Base81(b)), vbTextCompare) Then 'Ищем базу Base81(b)
         If InStr(1, str81Low, lcase(ConnType81(b)), vbTextCompare) Then 'Проверяем тип соединения
           Result = 1 'Флаг База найдена
           Add81(b) = 0 'Флаг База уже прописанна
         End If
         If SkipChekBase81 = 0 Then
           If InStr(1, str81Low, lcase(Server81(b)), vbTextCompare) Then 'Проверяем адресс сервера прописанный для базы Base81(b), и если он правельный по заканчиваем обработку строки, если неправильный, правим
             Result = 0 'Пишем строку без изменений
           Else
             If ConnType81(b) = "File" Then Temp81.WriteLine("Connect="&ConnType81(b)&"="&Chr(34)&Base81(b)&Chr(34)&";") End If 
             If ConnType81(b) = "Srvr" Then Temp81.WriteLine("Connect="&ConnType81(b)&"="&Chr(34)&Server81(b)&Chr(34)&";Ref="&Chr(34)&Base81(b)&Chr(34)&";") End If
           End If
         Else
           Result = 0
         End If
       End If
     Next
     If Result = 0 Then Temp81.WriteLine(str81) End If 
   Else
     Temp81.WriteLine(str81) 'Пишем строку без изменений если не найдено слово connect
   End If
  Next

  arrMyFile82 = Split(File82.ReadAll, vbNewLine) 'Создаем массив из файла с базами 82
  For a = 0 To UBound(arrMyFile82) 'Читаем поэлементно массив arrMyFile82
   str82 = arrMyFile82(a) 'строка из массива
   str82Low = lcase(arrMyFile82(a)) 'строка из массива переведенная в нижний регистр
   If InStr(1, str82Low, "connect", vbTextCompare) Then 'Находим строку с путями к базе
     Result = 0
     For b = 0 To UBound(Base82) 'Обрабатываем массив предопределенных баз
       If InStr(1, str82Low, lcase(Base82(b)), vbTextCompare) Then 'Ищем базу Base82(b)
	     If InStr(1, str82Low, lcase(ConnType82(b)), vbTextCompare) Then 'Проверяем тип соединения
           Result = 1
           Add82(b) = 0 ' База существует
         End If
         If SkipChekBase82 = 0 Then
           If InStr(1, str82Low, lcase(Server82(b)), vbTextCompare) Then 'Проверяем адресс сервера прописанный для базы Base82(b), и если он правельный по заканчиваем обработку строки, если неправильный, правим
             Result = 0 'Пишем строку без изменений
           Else
             If ConnType82(b) = "ws" Then Temp82.WriteLine("Connect="&ConnType82(b)&"="&Chr(34)&Server82(b)&Base82(b)&Chr(34)&";") End If 
             If ConnType82(b) = "Srvr" Then Temp82.WriteLine("Connect="&ConnType82(b)&"="&Chr(34)&Server82(b)&Chr(34)&";Ref="&Chr(34)&Base82(b)&Chr(34)&";") End If
           End If
         Else
           Result = 0
         End If
       End If
     Next
	 If Result = 0 Then Temp82.WriteLine(str82) End If
   Else
     Temp82.WriteLine(str82) 'Пишем строку без изменений если не найдено слово connect
   End If
  Next

If SkipAddBase81 = 0 Then
    For a = 0 To UBound(Add81) 'Добавляем базы у которых Add(a) = 1
       If Add81(a) = 1 Then
         Temp81.WriteLine(Title81(a))
         If ConnType81(a) = "File" Then Temp81.WriteLine("Connect="&ConnType81(a)&"="&Chr(34)&Base81(a)&Chr(34)&";") End If 
         If ConnType81(a) = "Srvr" Then Temp81.WriteLine("Connect="&ConnType81(a)&"="&Chr(34)&Server81(a)&Chr(34)&";Ref="&Chr(34)&Base81(a)&Chr(34)&";") End If
		 Temp81.WriteLine(ID&a)
		 Temp81.WriteLine(OrderInList)
		 Temp81.WriteLine(Folder)
		 Temp81.WriteLine(OrderInTree)
		 Temp81.WriteLine(External)
       End If
    Next
End If

If SkipAddBase82 = 0 Then
    For a = 0 To UBound(Add82) 'Добавляем базы у которых Add(a) = 1
       If Add82(a) = 1 Then
         Temp82.WriteLine(Title82(a))
         If ConnType82(a) = "ws" Then Temp82.WriteLine("Connect="&ConnType82(a)&"="&Chr(34)&Server82(a)&Base82(a)&Chr(34)&";") End If 
         If ConnType82(a) = "Srvr" Then Temp82.WriteLine("Connect="&ConnType82(a)&"="&Chr(34)&Server82(a)&Chr(34)&";Ref="&Chr(34)&Base82(a)&Chr(34)&";") End If
       End If
    Next
End If

File81.Close
Temp81.Close
FSO.DeleteFile File1C81, 0
FSO.MoveFile File1C81New, File1C81

File82.Close
Temp82.Close
FSO.DeleteFile File1C82, 0
FSO.MoveFile File1C82New, File1C82

If SkipEraseCache82 = 0 Then 
  UserProfile = WshEnvPROCESS.Item("userprofile")
  FSO.DeleteFolder(UserProfile & "\Application Data\1C\1Cv82")
  FSO.DeleteFolder(UserProfile & "\Local Settings\Application Data\1C\1Cv82")
End If


If SkipEndEcho = 0 Then
  WScript.Echo "Скрипт выполнен. Нажмите " &Chr(34)& "Ок" &Chr(34)& " для выхода"
End If

vbscript — изучал на написании данного скрипта, соответственно может быть очень криво.
Коментарии писал вроде бы понятные.
Если есть вопросы по этой каше, спрашивайте, попробую вспомнить почему так писал.