Pull to refresh

Comments 17

Сколько же головной боли снимет этот скрипт.

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

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

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

Таким образом, при старте 1с полезет на шару в нужную папку за списком баз. Вы можете оперативно менять список баз на шаре, при этом он будет меняться и у пользователей. Базы, добавленные пользователем вручную на этот список не влияют.
При таком подходе при каждом входе у юзера будет создаваться новый кэш конфигурации, что замедлит старт системы, но с другой стороны застрахует от ошибок этого самого кэша. Кроме того, старый кэш у вас не уничтожается и копится в виде мусора.
Писалось для 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 — изучал на написании данного скрипта, соответственно может быть очень криво.
Коментарии писал вроде бы понятные.
Если есть вопросы по этой каше, спрашивайте, попробую вспомнить почему так писал.
Никогда не думал, что это может потянуть на статью на Хабре, если будет интересно и пригодится то вот код скрипта 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
Это нереальная лажа, я не проверил свой комментарий и ошибся с тегами. Прошу пардону.

Никогда не думал, что это может потянуть на статью на Хабре, если будет интересно и пригодится то вот код скрипта 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>
Все делается намного проще, всем делается ярлык на 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 в список информационных баз у пользователя добавятся только те, на которые у него есть права на чтение.
Ни каких скриптов, права можно менять без перелогона пользователя и вообще удобно.
права можно менять без перелогона пользователя

Это справедливо если права менять на файле v8i, добавляя очередную учётку с правами на чтение, однако при большом количестве баз и/или пользователей, гораздо правильнее добавлять пользователя в группу, у которой есть право на чтение нужных файлов, а при этом перелогин будет уже необходим.
С другой стороны, генерацию cfg-файла можно организовать и по запросу (дать юзеру ссылку на отдельный скрипт для этого или самому запустить отдельный скрипт с указанием имени комп-а и пользователя), без перелогина.
Only those users with full accounts are able to leave comments. Log in, please.