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

Приветствую тебя, уважаемый читатель!
По традиции, прошу слишком сильно не пинать, т.к. это мой первый пост.

Итак, приблизительно с полгода назад, встала задача автоматизировать управление списком баз 1С (коих развелось уже более 20 штук) у пользователей домена.
Делалось это не только удобства ради, но и в рамках проекта по внедрению «ролевой модели доступа». Вкратце, смысл этой модели в том, что каждый пользователь в домене является членом определенной группы (именуемой согласно должности), которая имеет заранее определенный набор привилегий, в том числе и список информационных баз.

Т.к. у нас имеется домен Active Directory, логично использовать групповые политики для выполнения нашей задачи.
Гугление выдавало достаточно много реализаций (и даже платных), но все они, чаще всего, сводились к заранее сформированным файлам со списками баз (ibases.v8i). Нам же хотелось:
a) Централизованно управлять настройками подключения к информационным базам (у нас клиент-серверный вариант с SQL базами).
б) Централизованно управлять списком, доступных пользователю, информационных баз, согласно его «роли».

В итоге я расскажу о решении которое работает уже больше полугода в нашей компании.


Итак, приступим.

Шаг 1.

1С 8.2 хранит список информационных баз в файле ibases.v8i, такой файл присутствует в профиле у каждого пользователя. Формат и принцип работы этого файла отлично описаны тут и тут, поэтому я не вижу смысла здесь это повторять.
Также, в одном каталоге с файлом ibases.v8i, находится файл 1CEStart.cfg, особенностью этого файла является то, что в нем можно прописать пути к отдельным файлам *.v8i, содержащим параметры подключения к конкретным информационным базам.
При запуске, 1С берет параметры подключений к информационным базам из файлов, прописанных в 1CEStart.cfg и помещает их в ibases.v8i. Эту-то особенность мы и будем использовать.
Сначала, сформируем файл v8i для каждой информационной базы.
Самый простой способ сформировать такой файлик — это кликнуть правой кнопкой на нужной базе в списке, и выбрать пункт «Сохранить ссылку в файл»:
image
Однако, следует иметь ввиду, что сформированный таким образом файл v8i содержит некоторые «лишние» строки, которые нам не нужны. Для нормальной работы достаточно оставить только следующее:

[%NAME% ]
Connect=Srvr="%server%";Ref="%base%";
ClientConnectionSpeed=Normal
App=Auto
WA=1
Version=8.2

Далее, необходимо разместить эти файлы в общедоступном, для пользователей локальной сети, месте, и дать права на «чтение». Я не стал заморачиваться, и просто разместил их в папке NETLOGON контроллера домена. Тому есть несколько причин — это и репликация каталога между контроллерами домена, и отказоустойчивость (в силу того, что контроллеров три, и в каждый момент времени хотя-бы один из них доступен).

Шаг 2.

Раз мы собираемся управлять списком информационных баз на основе принадлежности пользователя к той или иной группе AD, создадим в ней необходимое количество групп безопасности согласно имеющимся у нас базам 1С:
image

Префикс «1C_82» является обязательным, и далее будет понятно для чего.

Теперь, в каждой вновь созданной группе безопасности, в поле «заметки», укажем путь к соответствующему ей файлу v8i:
image

На этом с группами закончили.

Шаг 3.

Создаем групповую политику, которая будет запускать следующий vbs скрипт каждый раз при логоне пользователя:

Код на vbs
On Error Resume Next
Const PROPERTY_NOT_FOUND  = &h8000500D
Dim sGroupNames
Dim sGroupDNs
Dim aGroupNames
Dim aGroupDNs
Dim aMemof
Dim oUser
Dim tgdn
Dim fso
Dim V8iConfigFile
Dim dir
Const ForReading = 1, ForWriting = 2, ForAppending = 8
'Настраиваем лог файл
Set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("Wscript.Shell")
strSysVarTEMP = WshShell.ExpandEnvironmentStrings("%TEMP%")
Set oScriptLog = fso.OpenTextFile(strSysVarTEMP + "\_dbconn.log",ForWriting,True)
oScriptLog.Write ""
strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "Start..."
oScriptLog.WriteLine(strToLog)

'Проверяем, что 1С установлена
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not (objFSO.FolderExists("C:\Program Files\1cv82") Or objFSO.FolderExists("C:\Program Files (x86)\1cv82")) Then
 strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "1C 8.2 not installed... Quit..."
 oScriptLog.WriteLine(strToLog)
    WScript.quit
End If

'Проверяем есть ли старый файл и удаляем в случае наличия'
 APPDATA = WshShell.ExpandEnvironmentStrings("%APPDATA%")
 v8i = APPDATA + "\1C\1CEStart\ibases.v8i"
 If fso.FileExists(v8i) Then 
	fso.DeleteFile(v8i)
	Set V8iConfigFile = fso.CreateTextFile(v8i ,True)
	strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "Удален файл v8i и создан новый"
	oScriptLog.WriteLine(strToLog)
' Если файла нет (1С только установлена), то создаем файла по указанному пути
 Else
	Set dir = fso.CreateFolder(APPDATA + "\1C")
	Set dir = fso.CreateFolder(dir + "\1CEStart")
	Set V8iConfigFile = fso.CreateTextFile(v8i ,True)
	strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "Создан файл v8i"
	oScriptLog.WriteLine(strToLog)
 End if

'
' Initialise strings. We make the assumption that every account is a member of two system groups
'
sGroupNames = "Authenticated Users(S),Everyone(S)"
'
' Enter the DN for the user account here
Set objSysInfo = CreateObject("ADSystemInfo")
strUserName = objSysInfo.UserName
strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "Logged user DN: "+strUserName
oScriptLog.WriteLine(strToLog)

'  Получаем имя залогиненного пользователя
Set oUser = GetObject("LDAP://" + strUserName)
If Err.Number <> 0 Then
        strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "There is an error retrieving the account. Please check your distinguished name syntax assigned to the oUser object."
        oScriptLog.WriteLine(strToLog)
  WScript.quit
End If
'
' Determine the DN of the primary group
' We make an assumption that every user account is a member of a primary group
' 
iPgid = oUser.Get("primaryGroupID")
sGroupDNs = primgroup(iPgid)
tgdn = sGroupDNs
'
' Call a subroutine to extract the group name and scope
' Add the result to the accumulated group name String
'
Call Getmemof(tgdn)
'
' Check the direct group membership for the User account
'
aMemOf = oUser.GetEx("memberOf")
If Err.Number <> PROPERTY_NOT_FOUND Then
'
' Call a recursive subroutine to retrieve all indirect group memberships
'
        Err.clear
    For Each GroupDN in aMemof
        Call AddGroups(GroupDN)
        Call Getmemof(GroupDN)
    Next
End If

aGroupNames = Split(sGroupNames,",")
aGroupDNs = Split(sGroupDNs,":")

'Откидываем все группы, кроме начинающихся с 1C_82
For Each strGroupDN in aGroupDNs
 if StrComp(Mid(strGroupDN,1,8), "CN=1C_82", vbTextCompare) = 0 Then
  strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "User is member of: " + strGroupDN
  oScriptLog.WriteLine(strToLog)
  Set objGroup = GetObject("LDAP://" & strGroupDN)
  If Err.Number <> 0 Then
   strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "There is an error retrieving the group. Please check your distinguished name syntax assigned to the objGroup object: " + strGroupDN
   oScriptLog.WriteLine(strToLog)
   WScript.quit
  End If
  strInfo = objGroup.Get("info")
  strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "Group " + strGroupDN +" info field: " + strInfo
  oScriptLog.WriteLine(strToLog)
  strAllInfo = strAllInfo & ":" & strInfo
    
    
 End If
Next

aInfoStrings = Split(strAllInfo,":")

Call WriteDBSettings()

Sub WriteDBSettings()
'Прописываем ссылки на v8i файлы в 1CEStart.cfg
strSysVarAPPDATA = WshShell.ExpandEnvironmentStrings("%APPDATA%")
strDBConfigFilePath = strSysVarAPPDATA + "\1C\1CEStart\1CEStart.cfg"
strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "1C Config file is: " + strDBConfigFilePath
oScriptLog.WriteLine(strToLog)

If (fso.FileExists(strDBConfigFilePath)) Then
 Set objDBConfigFile = fso.OpenTextFile(strDBConfigFilePath,ForWriting,True)
 objDBConfigFile.Write ""
 For each strInfo in aInfoStrings
  objDBConfigFile.WriteLine("CommonInfoBases=" + strInfo)
  strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "Add Line: " + "CommonInfoBases=" + strInfo
  oScriptLog.WriteLine(strToLog)
 next
'Изменить на 0, если аппаратные лицензии не используются
 objDBConfigFile.WriteLine("UseHWLicenses=1")
 strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "Add Line: " + "UseHWLicenses=1"
 oScriptLog.WriteLine(strToLog)
 strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "Ready"
 oScriptLog.WriteLine(strToLog)
 objDBConfigFile.Close
Else
 Set fso = CreateObject("Scripting.FileSystemObject")
 Set WshShell = WScript.CreateObject("Wscript.Shell")
 Set objDBConfigFile = fso.OpenTextFile(strDBConfigFilePath,ForWriting,True)
 objDBConfigFile.Write ""
 For each strInfo in aInfoStrings
  objDBConfigFile.WriteLine("CommonInfoBases=" + strInfo)
  strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "Add Line: " + "CommonInfoBases=" + strInfo
  oScriptLog.WriteLine(strToLog)
 next
 strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "1C Config file" + strDBConfigFilePath + " Not Exist! Create!"
 oScriptLog.WriteLine(strToLog)
 WScript.Quit
End If

End Sub

'*************************************************************************************************
' End of mainline code
'*************************************************************************************************

Function primgroup(groupid)
' This function accepts a primary group id
' It binds to the local domain and returns the DN of the primary group
' David Zemdegs 6 May 2008
'
Dim oRootDSE,oConn,oCmd,oRset
Dim ADDomain,srchdmn
' Bind to loca domain
Set oRootDSE = GetObject("LDAP://RootDSE")
ADDomain = oRootDSE.Get("defaultNamingContext")
srchdmn = "<LDAP://" & ADDomain & ">"
'
' Initialise AD search and obtain the recordset of groups
' 
Set oConn = CreateObject("ADODB.Connection")
oConn.Open "Provider=ADsDSOObject;"
Set oCmd = CreateObject("ADODB.Command")
oCmd.ActiveConnection = oConn
oCmd.CommandText = srchdmn & ";(objectCategory=Group);" & _
        "distinguishedName,primaryGroupToken;subtree" 
Set oRset = oCmd.Execute
'
' Loop through the recordset and find the matching primary group token
' When found retrieve the DN and exit the loop
' 
Do Until oRset.EOF
    If oRset.Fields("primaryGroupToken") = groupid Then
        primgroup = oRset.Fields("distinguishedName")
        Exit Do
    End If
    oRset.MoveNext
Loop
'
' Close and tidy up objects
' 
oConn.Close
Set oRootDSE = Nothing
Set oConn = Nothing
Set oCmd = Nothing
Set oRset = Nothing
End Function
Sub Getmemof(sDN)
'
' This is recursive subroutine that calls itself for memberof Property
' David Zemdegs 6 May 2008
'
On Error Resume Next
Dim oGrp
Dim aGrpMemOf
Dim sGrpDN
Set oGrp = GetObject("LDAP://" & sDN)
aGrpMemOf = oGrp.GetEx("memberOf")
If Err.Number <> PROPERTY_NOT_FOUND Then
'
' Call a recursive subroutine to retrieve all indirect group memberships
'
        Err.clear
    For Each sGrpDN in aGrpMemOf
                Call AddGroups(sGrpDN)
        Call Getmemof(sGrpDN)
    Next
End If
Err.clear
Set oGrp = Nothing
End Sub
Sub AddGroups(sGdn)
'
' This subroutine accepts a disguished name
' It extracts the RDN as the group name and determines the group scope
' This is then appended to the group name String
' It also appends the DN to the DN String
'
Const SCOPE_GLOBAL = &h2
Const SCOPE_LOCAL = &h4
Const SCOPE_UNIVERSAL = &h8
Dim SNewgrp
'
' Retrieve the group name
'
iComma = InStr(1,sGdn,",")
sGrpName = Mid(sGdn,4,iComma-4)

'
' Add the results to the group name String
' Check that the group doesnt already exist in the list
'
sNewgrp = sGrpName
If InStr(1,sGroupNames,SNewgrp,1) = 0 Then
        sGroupNames = sGroupNames & "," & SNewgrp
End If
'
' Add the Groups DN to the string if not duplicate
'
If InStr(1,sGroupDNs,sGdn,1) = 0 Then
        sGroupDNs = sGroupDNs & ":" & sGdn
End If
End Sub



Логика работы скрипта следующая:
1. Проверяет установлена ли 1С, если нет — скрипт завершается.
2. Проверяет существует ли файл ibases.v8i, и перезаписывает его пустым (или создает в случае отсутствия).
3. Извлекает все группы из AD, членом которых является пользователь.
4. Отбрасывает все, кроме тех, которые начинаются с 1C_82.
5. Получает значение атрибута «Notes».
6. Прописывает значение этого атрибута в файл 1CEStart.cfg
Попутно пишется лог:
Для Windows 7 — C:\Users\username\appdata\Local\Temp\_dbconn.log
Для Windows XP — C:\Documents and Settings\username\Local Settings\Temp\_dbconn.log

Шаг 4.

«Вешаем» групповую политику на необходимую OU или весь домен. Стоит отметить, для того, чтоб скрипт не применялся всем подряд без разбора (не все пользователи работают с 1С), я добавил в фильтр безопасности групповой политики только те группы, которые мы создавали на шаге 2, таким образом скрипт будет отрабатывать только у пользователей включенных в хотя-бы одну из этих групп:
image

Шаг 5.

Включаем группу (читай должность) пользователя в те группы 1С, которые предусмотрены ролевой моделью доступа (хотя можно и отдельно взятого пользователя — бывают исключения). После перезагрузки у пользователя будет индивидуальный именно его должности список информационных баз.
Ну вот вроде-бы и все.
Кстати, для применения изменений, пользователю не обязательно перелогиниваться, нужно просто заставить пользователя выполнить этот скрипт любым удобным способом, к примеру, отправив скрипт по электронной почте.

Спасибо за внимание, буду очень рад, если статья кому-то поможет.
Поделиться публикацией
Ой, у вас баннер убежал!

Ну. И что?
Реклама
Комментарии 17
    0
    Сколько же головной боли снимет этот скрипт.

    Остается только 1 вопрос. Часто пользователю требуется иметь локальную базу. А дынный скрипт будет каждый раз удалять ее.
    Не сталкивались с решениями которые могли бы обнаруживать еще и локальные базы?
      0
      Для локальной базы, можно просто иметь на рабочем столе файл *.v8i с прописанными параметрами подключения (такой-же как формировали на шаге 2), кликнув на него, у вас откроется именно эта база :)
        0
        Спасибо за идею, этому обучить необходимых людей не сложно.
          0
          Вы знаете, я вас дезинформировал, прошу прощения. Сам только что проверил — не получается, хотя раньше работало — я точно уверен. Попробую найти решение и обязательно отпишусь!
            0
            Что странно у меня тоже ведь такой способ работал. В понедельник проверю отпишусь.

            Скоро подобное для 8.3 осваивать нужно будет. Интересно там много поменяли…
              0
              Хотелось бы надеяться на обратную совместимость, ибо «наши» уже вовсю 8.3 тестят…
      0
      Лет 6 назад писал vbs скрипт который который умел добавлять, удалять и исправлять базы у пользователя. С тех пор ничего не изменилось. Даже и не думал что это такая проблема. Поищу в архивах, может сохранился.
        0
        Пожалуйста, если не трудно, то выложите ваши наработки.
        0
        Просто отлично, в избранное :)

        Вопрос почти по теме: сейчас воюю с 1С сервером под Debian'ом, пытаюсь его научить авторизовать пользователей по учётным записям в AD. Пока получается не очень :( если есть у кого-нибудь в закромах годный гайд, был бы очень признателен.
        0
        Эммм, зачем столько всего? Наверняка есть уже определенные наборы баз, нужные определенным категориям пользователей. Создайте на шаре папки с именами этих наборов (для бухгалтерии, руководства, финотдела и проч.). В каждую папку положите ibases, 1cestart и 1cescmn. В 1cestart пропишите сетевой путь до лежащего рядом 1cescmn.cfg (commoncfglocation). В 1cescmn.cfg пропишите ссылку на лежащий в этой же папке список баз. Теперь раздайте 1cestart.cfg из нужной папки нужным пользователям по GP в %appdata%\1с.

        Таким образом, при старте 1с полезет на шару в нужную папку за списком баз. Вы можете оперативно менять список баз на шаре, при этом он будет меняться и у пользователей. Базы, добавленные пользователем вручную на этот список не влияют.
          0
          При таком подходе при каждом входе у юзера будет создаваться новый кэш конфигурации, что замедлит старт системы, но с другой стороны застрахует от ошибок этого самого кэша. Кроме того, старый кэш у вас не уничтожается и копится в виде мусора.
            0
            Писалось для 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 — изучал на написании данного скрипта, соответственно может быть очень криво.
            Коментарии писал вроде бы понятные.
            Если есть вопросы по этой каше, спрашивайте, попробую вспомнить почему так писал.
              –2
              Никогда не думал, что это может потянуть на статью на Хабре, если будет интересно и пригодится то вот код скрипта vbs, который создает ярлыки подключений к терминальным серверам как в режиме удаленного рабочего стола с прописанной средой запуска, так и в режиме запуска опубликованного приложения. Фишка скрипта — определение размера экрана пользователя при запуске и установка именно такого размера экрана в свойствах подключения.
              ' Скрипт создания на рабочем столе пользователя ярлыка удаленного подключения к рабочему столу ' или подключения Remote Apps, базируясь на членстве в группах безопасности. ' ' Шаблон названия группы для создания ярлыка подключения к удаленному рабочему столу ' ================================================================================== ' Префикс названия группы: RDP_ /все после префикса - название ярлыка/ ' Описание группы: имя сервера для подключения ' Заметки группы: среда для запуска при входе на терминальный сервер, например "C:\Program Files (x86)\1cv81\bin\1cv8.exe" enterprise /S APP-SRV\base ' ' Шаблон названия группы для создания ярлыка подключения к Remote Apps ' ================================================================================== ' Префикс названия группы: RemApps_ /все после префикса - название ярлыка/ ' Описание группы: имя сервера для подключения ' Заметки группы: псевдоним опубликованного приложения на сервере терминалов On Error Resume Next Set wshShell = WScript.CreateObject("WScript.Shell") Set m_FSO = CreateObject("Scripting.FileSystemObject") ' определяем размер рабочего стола Set Locator = CreateObject("WbemScripting.SWbemLocator") Set Services = Locator.ConnectServer(".") Set Obj = Services.ExecQuery("Select * from Win32_DesktopMonitor") For Each Item In Obj If Item.Availability=3 Then resy = Item.ScreenWidth resx = Item.ScreenHeight End If Next ' WScript.Echo "По вертикали="& resx ' WScript.Echo "По горизонтали="& resy ' Находим пользователя в AD и определем его параметры Set objSysInfo = CreateObject("ADSystemInfo") ADSPath = "LDAP://" & objSysInfo.UserName Set objUser = GetObject(ADSPath) ShortUserName = objUser.SamAccountName DomainName = objSysInfo.DomainShortName ' Читаем путь к Рабочему столу DesktopPath = wshShell.SpecialFolders("Desktop") LevelCount = 0 MaxLevelCount = 4 Status = CheckGroups(ADSPath) ' дальше идет нудный перечень используемых функций '============ Function GetPrefixNameGroup ============ Function GetPrefixNameGroup(sString) ' Trim prefix of name group Dim TempString TempString = Left(sString, InStr(sString, "_")) GetPrefixNameGroup = TempString End Function '===================================================== '============ Function GetLinkNameGroup ============ Function GetLinkNameGroup(sString) ' Trim LinkName of name group Dim TempString TempString = Mid(sString, InStrRev(sString, "_")+1) GetLinkNameGroup = TempString End Function '===================================================== '============ Function Create Remote Application File ============ Function CreateRemAppsFile(sString, sName, sShell) spath = DesktopPath & "\" & sString & ".rdp" ' проверяем наличие такого же файла - если есть - удаляем его' If m_FSO.FileExists(sPath) or m_FSO.FolderExists(sPath) Then m_FSO.DeleteFile (sPath),1 End If Set RDPFile = m_FSO.CreateTextFile (spath, True) RDPFile.writeline ("redirectclipboard:i:1") RDPFile.writeline ("redirectposdevices:i:0") RDPFile.writeline ("redirectprinters:i:0") RDPFile.writeline ("redirectcomports:i:1") RDPFile.writeline ("redirectsmartcards:i:0") RDPFile.writeline ("drivestoredirect:s:") RDPFile.writeline ("session bpp:i:32") RDPFile.writeline ("prompt for credentials on client:i:1") RDPFile.writeline ("span monitors:i:1") RDPFile.writeline ("use multimon:i:1") RDPFile.writeline ("remoteapplicationmode:i:1") RDPFile.writeline ("server port:i:3389") RDPFile.writeline ("allow font smoothing:i:1") RDPFile.writeline ("promptcredentialonce:i:1") RDPFile.writeline ("authentication level:i:2") RDPFile.writeline ("gatewayusagemethod:i:0") RDPFile.writeline ("gatewayprofileusagemethod:i:1") RDPFile.writeline ("gatewaycredentialssource:i:0") RDPFile.writeline ("full address:s:" & sName) RDPFile.writeline ("remoteapplicationprogram:s:||" & sShell) RDPFile.writeline ("gatewayhostname:s:") RDPFile.writeline ("remoteapplicationname:s:" & sString) RDPFile.writeline ("screen mode id:i:2") RDPFile.writeline ("desktopwidth:i:" & resy) RDPFile.writeline ("desktopheight:i:" & resx) RDPFile.writeline ("winposstr:s:0,3,0,0,800,600") RDPFile.writeline ("compression:i:1") RDPFile.writeline ("keyboardhook:i:2") RDPFile.writeline ("audiocapturemode:i:0") RDPFile.writeline ("videoplaybackmode:i:1") RDPFile.writeline ("connection type:i:2") RDPFile.writeline ("displayconnectionbar:i:1") RDPFile.writeline ("disable wallpaper:i:1") RDPFile.writeline ("allow desktop composition:i:0") RDPFile.writeline ("disable full window drag:i:1") RDPFile.writeline ("disable menu anims:i:1") RDPFile.writeline ("disable themes:i:0") RDPFile.writeline ("disable cursor setting:i:0") RDPFile.writeline ("bitmapcachepersistenable:i:1") RDPFile.writeline ("audiomode:i:0") RDPFile.writeline ("redirectdirectx:i:1") RDPFile.writeline ("autoreconnection enabled:i:1") RDPFile.writeline ("prompt for credentials:i:0") RDPFile.writeline ("negotiate security layer:i:1") RDPFile.writeline ("remoteapplicationicon:s:") RDPFile.writeline ("shell working directory:s:") RDPFile.writeline ("use redirection server name:i:0") RDPFile.close End Function '============ Function Create RdpFile ============ Function CreateRDPFile(sString, sName, sShell) spath = DesktopPath & "\" & sString & ".rdp" ' проверяем наличие такого же файла - если есть - удаляем его' If m_FSO.FileExists(sPath) or m_FSO.FolderExists(sPath) Then m_FSO.DeleteFile (sPath),1 End If Set RDPFile = m_FSO.CreateTextFile (spath, True) RDPFile.writeline ("screen mode id:i:2") RDPFile.writeline ("use multimon:i:0") RDPFile.writeline ("desktopwidth:i:" & resy) RDPFile.writeline ("desktopheight:i:" & resx) RDPFile.writeline ("session bpp:i:16") RDPFile.writeline ("winposstr:s:0,3,0,0,800,600") RDPFile.writeline ("compression:i:1") RDPFile.writeline ("keyboardhook:i:2") RDPFile.writeline ("audiocapturemode:i:0") RDPFile.writeline ("videoplaybackmode:i:1") RDPFile.writeline ("connection type:i:2") RDPFile.writeline ("displayconnectionbar:i:1") RDPFile.writeline ("disable wallpaper:i:1") RDPFile.writeline ("disable full window drag:i:1") RDPFile.writeline ("allow desktop composition:i:0") RDPFile.writeline ("allow font smoothing:i:0") RDPFile.writeline ("disable menu anims:i:1") RDPFile.writeline ("disable themes:i:1") RDPFile.writeline ("disable cursor setting:i:0") RDPFile.writeline ("bitmapcachepersistenable:i:1") RDPFile.writeline ("full address:s:" & sName) RDPFile.writeline ("audiomode:i:2") RDPFile.writeline ("redirectprinters:i:0") RDPFile.writeline ("redirectcomports:i:0") RDPFile.writeline ("redirectsmartcards:i:0") RDPFile.writeline ("redirectclipboard:i:1") RDPFile.writeline ("redirectposdevices:i:0") RDPFile.writeline ("redirectdirectx:i:1") RDPFile.writeline ("autoreconnection enabled:i:1") RDPFile.writeline ("authentication level:i:0") RDPFile.writeline ("prompt for credentials:i:0") RDPFile.writeline ("negotiate security layer:i:1") RDPFile.writeline ("remoteapplicationmode:i:0") RDPFile.writeline ("alternate shell:s:" & sShell) RDPFile.writeline ("shell working directory:s:") RDPFile.writeline ("gatewayhostname:s:") RDPFile.writeline ("gatewayusagemethod:i:4") RDPFile.writeline ("gatewaycredentialssource:i:4") RDPFile.writeline ("gatewayprofileusagemethod:i:0") RDPFile.writeline ("promptcredentialonce:i:1") RDPFile.writeline ("drivestoredirect:s:*") RDPFile.writeline ("use redirection server name:i:0") RDPFile.close End Function '===================================================== '============ Function CheckGroups =================== Function CheckGroups(ADSPath) Dim objUser, arrMemberOf Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D LevelCount = LevelCount + 1 if ( LevelCount >= MaxLevelCount) then LevelCount = LevelCount - 1 return LevelCount end If Set objUser = GetObject (ADSPath) On Error Resume Next arrMemberOf = objUser.GetEx("memberOf") If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then LevelCount = LevelCount - 1 return LevelCount Else For Each Group in arrMemberOf ADSGroup = "LDAP://" & Group CheckGroups(ADSGroup) ' WScript.Echo "Extra=" & LevelCount Set objGroup = GetObject ( ADSGroup ) If(GetPrefixNameGroup(objGroup.CN) = "RemApps_") Then Set objGroup = GetObject ( "LDAP://" & Group) LinkName = GetLinkNameGroup(objGroup.CN) LinkServer = objGroup.description LinkProgram = objGroup.info LinkResult = CreateRemAppsFile (LinkName, LinkServer, LinkProgram) end If If(GetPrefixNameGroup(objGroup.CN) = "RDP_") Then Set objGroup = GetObject ( "LDAP://" & Group) LinkName = GetLinkNameGroup(objGroup.CN) LinkServer = objGroup.description LinkProgram = objGroup.info LinkResult = CreateRDPFile (LinkName, LinkServer, LinkProgram) end If Next End If LevelCount = LevelCount - 1 End Function

              Следующий код делает почти тоже самое что и скрипт автора топика, но я не проверяю установлена ли 1С и формирую файлы с списками баз в профиле пользователя каждый раз при входе, предварительно их удаляя. В описании группы название базы в списке баз и в заметках параметры подключения к базе. Скрипт не мой, просил сделать на фрилансе, поэтому если кто то узнает свой код — еще раз примите благодарности, несколько лет не знаю горя.

              ' Префикс названий групп prefix_1c = "1c_" ' Получаем имя пользователя set info = CreateObject( "ADSystemInfo" ) ' Получаем учетную запись set user = GetObject( "LDAP://" & info.UserName ) ' Создаем файловые потоки set res_81 = CreateObject( "ADODB.Stream" ) res_81.Type = 2 res_81.Charset = "UTF-8" res_81.Open res_81.Position = 0 set res_82 = CreateObject( "ADODB.Stream" ) res_82.Type = 2 res_82.Charset = "UTF-8" res_82.Open res_82.Position = 0 memberOf = user.memberOf ' Просматривает список групп If (not (IsEmpty(memberOf)) ) then For Each item in user.memberOf set group = GetObject( "LDAP://" & item ) if (InStr( group.CN, prefix_1c ) = 1) then if (InStr( group.info, "Version=8.1" ) > 0) then res_81.WriteText( "[" & group.Description & "]" & Chr(13) & Chr(10) ) res_81.WriteText( group.info & Chr(13) & Chr(10) ) end if if (InStr( group.info, "Version=8.2" ) > 0) then res_82.WriteText( "[" & group.Description & "]" & Chr(13) & Chr(10) ) res_82.WriteText( group.info & Chr(13) & Chr(10) ) end if end if next end if ' Ищем путь до файлов set shell = CreateObject( "WScript.Shell" ) appdata = shell.ExpandEnvironmentStrings( "%APPDATA%" ) ' Создать папки set fso = CreateObject( "Scripting.FileSystemObject" ) if (not fso.FolderExists( appdata + "\1C" )) then fso.CreateFolder( appdata + "\1C" ) end if if (not fso.FolderExists( appdata + "\1C\1Cv81" )) then fso.CreateFolder( appdata + "\1C\1Cv81" ) end if if (not fso.FolderExists( appdata + "\1C\1CEStart" )) then fso.CreateFolder( appdata + "\1C\1CEStart" ) end if ' И пишем файлы туда res_81.SaveToFile appdata & "\1C\1Cv81\ibases.v8i", 2 res_81.Close res_82.SaveToFile appdata & "\1C\1CEStart\ibases.v8i", 2 res_82.Close
                0
                Это нереальная лажа, я не проверил свой комментарий и ошибся с тегами. Прошу пардону.

                Никогда не думал, что это может потянуть на статью на Хабре, если будет интересно и пригодится то вот код скрипта vbs, который создает ярлыки подключений к терминальным серверам как в режиме удаленного рабочего стола с прописанной средой запуска, так и в режиме запуска опубликованного приложения. Фишка скрипта — определение размера экрана пользователя при запуске и установка именно такого размера экрана в свойствах подключения.

                Код
                ' Скрипт создания на рабочем столе пользователя ярлыка удаленного подключения к рабочему столу 
                ' или подключения Remote Apps, базируясь на членстве в группах безопасности.
                ' 
                ' Шаблон названия группы для создания ярлыка подключения к удаленному рабочему столу
                ' ==================================================================================
                ' Префикс названия группы: RDP_ /все после префикса - название ярлыка/
                ' Описание группы: имя сервера для подключения
                ' Заметки группы: среда для запуска при входе на терминальный сервер, например "C:\Program Files (x86)\1cv81\bin\1cv8.exe" enterprise /S APP-SRV\base
                ' 
                ' Шаблон названия группы для создания ярлыка подключения к Remote Apps
                ' ==================================================================================
                ' Префикс названия группы: RemApps_ /все после префикса - название ярлыка/
                ' Описание группы: имя сервера для подключения
                ' Заметки группы: псевдоним опубликованного приложения на сервере терминалов
                
                On Error Resume Next
                Set wshShell = WScript.CreateObject("WScript.Shell")
                Set m_FSO = CreateObject("Scripting.FileSystemObject")
                
                ' определяем размер рабочего стола
                
                Set Locator = CreateObject("WbemScripting.SWbemLocator")
                Set Services = Locator.ConnectServer(".")
                Set Obj = Services.ExecQuery("Select * from Win32_DesktopMonitor")
                
                For Each Item In Obj
                If Item.Availability=3 Then
                resy = Item.ScreenWidth
                resx = Item.ScreenHeight
                End If
                
                Next
                
                ' WScript.Echo "По вертикали="& resx
                ' WScript.Echo "По горизонтали="& resy
                
                ' Находим пользователя в AD и определем его параметры
                
                Set objSysInfo = CreateObject("ADSystemInfo")
                ADSPath = "LDAP://" & objSysInfo.UserName
                Set objUser = GetObject(ADSPath)
                ShortUserName = objUser.SamAccountName
                DomainName = objSysInfo.DomainShortName
                
                ' Читаем путь к Рабочему столу
                
                DesktopPath = wshShell.SpecialFolders("Desktop")
                LevelCount = 0
                MaxLevelCount = 4
                Status = CheckGroups(ADSPath)
                
                ' дальше идет нудный перечень используемых функций
                '============ Function GetPrefixNameGroup ============
                
                Function GetPrefixNameGroup(sString)
                ' Trim prefix of name group
                Dim TempString
                TempString = Left(sString, InStr(sString, "_"))
                GetPrefixNameGroup = TempString
                End Function
                
                '=====================================================
                '============ Function GetLinkNameGroup ============
                
                Function GetLinkNameGroup(sString)
                ' Trim LinkName of name group
                Dim TempString
                TempString = Mid(sString, InStrRev(sString, "_")+1)
                GetLinkNameGroup = TempString
                End Function
                
                '=====================================================
                '============ Function Create Remote Application File ============
                
                Function CreateRemAppsFile(sString, sName, sShell)
                spath = DesktopPath & "\" & sString & ".rdp"
                
                ' проверяем наличие такого же файла - если есть - удаляем его'
                
                If m_FSO.FileExists(sPath) or m_FSO.FolderExists(sPath) Then
                m_FSO.DeleteFile (sPath),1
                End If
                
                Set RDPFile = m_FSO.CreateTextFile (spath, True)
                RDPFile.writeline ("redirectclipboard:i:1")
                RDPFile.writeline ("redirectposdevices:i:0")
                RDPFile.writeline ("redirectprinters:i:0")
                RDPFile.writeline ("redirectcomports:i:1")
                RDPFile.writeline ("redirectsmartcards:i:0")
                RDPFile.writeline ("drivestoredirect:s:")
                RDPFile.writeline ("session bpp:i:32")
                RDPFile.writeline ("prompt for credentials on client:i:1")
                RDPFile.writeline ("span monitors:i:1")
                RDPFile.writeline ("use multimon:i:1")
                RDPFile.writeline ("remoteapplicationmode:i:1")
                RDPFile.writeline ("server port:i:3389")
                RDPFile.writeline ("allow font smoothing:i:1")
                RDPFile.writeline ("promptcredentialonce:i:1")
                RDPFile.writeline ("authentication level:i:2")
                RDPFile.writeline ("gatewayusagemethod:i:0")
                RDPFile.writeline ("gatewayprofileusagemethod:i:1")
                RDPFile.writeline ("gatewaycredentialssource:i:0")
                RDPFile.writeline ("full address:s:" & sName)
                RDPFile.writeline ("remoteapplicationprogram:s:||" & sShell)
                RDPFile.writeline ("gatewayhostname:s:")
                RDPFile.writeline ("remoteapplicationname:s:" & sString)
                RDPFile.writeline ("screen mode id:i:2")
                RDPFile.writeline ("desktopwidth:i:" & resy)
                RDPFile.writeline ("desktopheight:i:" & resx)
                RDPFile.writeline ("winposstr:s:0,3,0,0,800,600")
                RDPFile.writeline ("compression:i:1")
                RDPFile.writeline ("keyboardhook:i:2")
                RDPFile.writeline ("audiocapturemode:i:0")
                RDPFile.writeline ("videoplaybackmode:i:1")
                RDPFile.writeline ("connection type:i:2")
                RDPFile.writeline ("displayconnectionbar:i:1")
                RDPFile.writeline ("disable wallpaper:i:1")
                RDPFile.writeline ("allow desktop composition:i:0")
                RDPFile.writeline ("disable full window drag:i:1")
                RDPFile.writeline ("disable menu anims:i:1")
                RDPFile.writeline ("disable themes:i:0")
                RDPFile.writeline ("disable cursor setting:i:0")
                RDPFile.writeline ("bitmapcachepersistenable:i:1")
                RDPFile.writeline ("audiomode:i:0")
                RDPFile.writeline ("redirectdirectx:i:1")
                RDPFile.writeline ("autoreconnection enabled:i:1")
                RDPFile.writeline ("prompt for credentials:i:0")
                RDPFile.writeline ("negotiate security layer:i:1")
                RDPFile.writeline ("remoteapplicationicon:s:")
                RDPFile.writeline ("shell working directory:s:")
                RDPFile.writeline ("use redirection server name:i:0")
                RDPFile.close
                End Function
                
                
                '============ Function Create RdpFile ============
                Function CreateRDPFile(sString, sName, sShell)
                spath = DesktopPath & "\" & sString & ".rdp"
                
                ' проверяем наличие такого же файла - если есть - удаляем его'
                
                If m_FSO.FileExists(sPath) or m_FSO.FolderExists(sPath) Then
                m_FSO.DeleteFile (sPath),1
                End If
                
                Set RDPFile = m_FSO.CreateTextFile (spath, True)
                RDPFile.writeline ("screen mode id:i:2")
                RDPFile.writeline ("use multimon:i:0")
                RDPFile.writeline ("desktopwidth:i:" & resy)
                RDPFile.writeline ("desktopheight:i:" & resx)
                RDPFile.writeline ("session bpp:i:16")
                RDPFile.writeline ("winposstr:s:0,3,0,0,800,600")
                RDPFile.writeline ("compression:i:1")
                RDPFile.writeline ("keyboardhook:i:2")
                RDPFile.writeline ("audiocapturemode:i:0")
                RDPFile.writeline ("videoplaybackmode:i:1")
                RDPFile.writeline ("connection type:i:2")
                RDPFile.writeline ("displayconnectionbar:i:1")
                RDPFile.writeline ("disable wallpaper:i:1")
                RDPFile.writeline ("disable full window drag:i:1")
                RDPFile.writeline ("allow desktop composition:i:0")
                RDPFile.writeline ("allow font smoothing:i:0")
                RDPFile.writeline ("disable menu anims:i:1")
                RDPFile.writeline ("disable themes:i:1")
                RDPFile.writeline ("disable cursor setting:i:0")
                RDPFile.writeline ("bitmapcachepersistenable:i:1")
                RDPFile.writeline ("full address:s:" & sName)
                RDPFile.writeline ("audiomode:i:2")
                RDPFile.writeline ("redirectprinters:i:0")
                RDPFile.writeline ("redirectcomports:i:0")
                RDPFile.writeline ("redirectsmartcards:i:0")
                RDPFile.writeline ("redirectclipboard:i:1")
                RDPFile.writeline ("redirectposdevices:i:0")
                RDPFile.writeline ("redirectdirectx:i:1")
                RDPFile.writeline ("autoreconnection enabled:i:1")
                RDPFile.writeline ("authentication level:i:0")
                RDPFile.writeline ("prompt for credentials:i:0")
                RDPFile.writeline ("negotiate security layer:i:1")
                RDPFile.writeline ("remoteapplicationmode:i:0")
                RDPFile.writeline ("alternate shell:s:" & sShell)
                RDPFile.writeline ("shell working directory:s:")
                RDPFile.writeline ("gatewayhostname:s:")
                RDPFile.writeline ("gatewayusagemethod:i:4")
                RDPFile.writeline ("gatewaycredentialssource:i:4")
                RDPFile.writeline ("gatewayprofileusagemethod:i:0")
                RDPFile.writeline ("promptcredentialonce:i:1")
                RDPFile.writeline ("drivestoredirect:s:*")
                RDPFile.writeline ("use redirection server name:i:0")
                RDPFile.close
                End Function
                
                '=====================================================
                '============ Function CheckGroups ===================
                
                Function CheckGroups(ADSPath)
                Dim objUser, arrMemberOf
                Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
                LevelCount = LevelCount + 1
                if ( LevelCount >= MaxLevelCount) then
                LevelCount = LevelCount - 1
                return LevelCount
                end If
                Set objUser = GetObject (ADSPath)
                On Error Resume Next
                arrMemberOf = objUser.GetEx("memberOf")
                If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
                LevelCount = LevelCount - 1
                return LevelCount
                Else
                For Each Group in arrMemberOf
                ADSGroup = "LDAP://" & Group
                CheckGroups(ADSGroup)
                ' WScript.Echo "Extra=" & LevelCount
                Set objGroup = GetObject ( ADSGroup )
                
                If(GetPrefixNameGroup(objGroup.CN) = "RemApps_") Then
                Set objGroup = GetObject ( "LDAP://" & Group)
                LinkName = GetLinkNameGroup(objGroup.CN)
                LinkServer = objGroup.description
                LinkProgram = objGroup.info
                LinkResult = CreateRemAppsFile (LinkName, LinkServer, LinkProgram)
                end If
                
                If(GetPrefixNameGroup(objGroup.CN) = "RDP_") Then
                Set objGroup = GetObject ( "LDAP://" & Group)
                LinkName = GetLinkNameGroup(objGroup.CN)
                LinkServer = objGroup.description
                LinkProgram = objGroup.info
                LinkResult = CreateRDPFile (LinkName, LinkServer, LinkProgram)
                end If
                
                Next
                End If
                LevelCount = LevelCount - 1
                End Function</spoiler>


                Следующий код делает почти тоже самое что и скрипт автора топика, но я не проверяю установлена ли 1С и формирую файлы с списками баз в профиле пользователя каждый раз при входе, предварительно их удаляя. В описании группы название базы в списке баз и в заметках параметры подключения к базе. Скрипт не мой, просил сделать на фрилансе, поэтому если кто то узнает свой код — еще раз примите благодарности, несколько лет не знаю горя.

                Код
                ' Префикс названий групп
                prefix_1c = "1c_"
                
                ' Получаем имя пользователя
                set info = CreateObject( "ADSystemInfo" )
                
                ' Получаем учетную запись
                set user = GetObject( "LDAP://" & info.UserName )
                
                ' Создаем файловые потоки
                set res_81 = CreateObject( "ADODB.Stream" )
                res_81.Type = 2
                res_81.Charset = "UTF-8"
                res_81.Open
                res_81.Position = 0
                
                set res_82 = CreateObject( "ADODB.Stream" )
                res_82.Type = 2
                res_82.Charset = "UTF-8"
                res_82.Open
                res_82.Position = 0
                
                memberOf = user.memberOf
                
                ' Просматривает список групп
                If (not (IsEmpty(memberOf)) ) then
                  For Each item in user.memberOf
                    set group = GetObject( "LDAP://" & item )
                
                    if (InStr( group.CN, prefix_1c ) = 1) then
                      if (InStr( group.info, "Version=8.1" ) > 0) then
                        res_81.WriteText( "[" & group.Description & "]" & Chr(13) & Chr(10) )
                        res_81.WriteText( group.info & Chr(13) & Chr(10) )
                      end if
                
                      if (InStr( group.info, "Version=8.2" ) > 0) then
                        res_82.WriteText( "[" & group.Description & "]" & Chr(13) & Chr(10) )
                        res_82.WriteText( group.info & Chr(13) & Chr(10) )
                      end if
                    end if
                  next
                end if
                
                ' Ищем путь до файлов
                set shell = CreateObject( "WScript.Shell" )
                appdata = shell.ExpandEnvironmentStrings( "%APPDATA%" )
                
                ' Создать папки
                set fso = CreateObject( "Scripting.FileSystemObject" )
                
                if (not fso.FolderExists( appdata + "\1C" )) then
                  fso.CreateFolder( appdata + "\1C" )
                end if
                if (not fso.FolderExists( appdata + "\1C\1Cv81" )) then
                  fso.CreateFolder( appdata + "\1C\1Cv81" )
                end if
                if (not fso.FolderExists( appdata + "\1C\1CEStart" )) then
                  fso.CreateFolder( appdata + "\1C\1CEStart" )
                end if
                
                
                ' И пишем файлы туда
                
                
                res_81.SaveToFile appdata & "\1C\1Cv81\ibases.v8i", 2
                res_81.Close
                
                res_82.SaveToFile appdata & "\1C\1CEStart\ibases.v8i", 2
                res_82.Close</spoiler>
                  0
                  Все делается намного проще, всем делается ярлык на 1cestart.exe
                  рядом с ним файл
                  1CESCmn.cfg
                  в него прописываем все файлы описания имеющихся баз перечислением:

                  CommonInfoBases=\\xxxxx\share$\base1.v8i
                  CommonInfoBases=\\xxxxx\share$\base2.v8i
                  CommonInfoBases=\\xxxxx\share$\base3.v8i

                  Или через группы, или напрямую даем права на чтение нужным пользователям на файлы \\xxxxx\share$\base1.v8i

                  При запуске 1cestart.exe в список информационных баз у пользователя добавятся только те, на которые у него есть права на чтение.
                  Ни каких скриптов, права можно менять без перелогона пользователя и вообще удобно.
                    0
                    права можно менять без перелогона пользователя

                    Это справедливо если права менять на файле v8i, добавляя очередную учётку с правами на чтение, однако при большом количестве баз и/или пользователей, гораздо правильнее добавлять пользователя в группу, у которой есть право на чтение нужных файлов, а при этом перелогин будет уже необходим.
                    С другой стороны, генерацию cfg-файла можно организовать и по запросу (дать юзеру ссылку на отдельный скрипт для этого или самому запустить отдельный скрипт с указанием имени комп-а и пользователя), без перелогина.

                  Только полноправные пользователи могут оставлять комментарии. Войдите, пожалуйста.

                  Самое читаемое