Управление списком баз 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-файла можно организовать и по запросу (дать юзеру ссылку на отдельный скрипт для этого или самому запустить отдельный скрипт с указанием имени комп-а и пользователя), без перелогина.

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