Комментарии 17
Сколько же головной боли снимет этот скрипт.
Остается только 1 вопрос. Часто пользователю требуется иметь локальную базу. А дынный скрипт будет каждый раз удалять ее.
Не сталкивались с решениями которые могли бы обнаруживать еще и локальные базы?
Остается только 1 вопрос. Часто пользователю требуется иметь локальную базу. А дынный скрипт будет каждый раз удалять ее.
Не сталкивались с решениями которые могли бы обнаруживать еще и локальные базы?
Для локальной базы, можно просто иметь на рабочем столе файл *.v8i с прописанными параметрами подключения (такой-же как формировали на шаге 2), кликнув на него, у вас откроется именно эта база :)
Лет 6 назад писал vbs скрипт который который умел добавлять, удалять и исправлять базы у пользователя. С тех пор ничего не изменилось. Даже и не думал что это такая проблема. Поищу в архивах, может сохранился.
Просто отлично, в избранное :)
Вопрос почти по теме: сейчас воюю с 1С сервером под Debian'ом, пытаюсь его научить авторизовать пользователей по учётным записям в AD. Пока получается не очень :( если есть у кого-нибудь в закромах годный гайд, был бы очень признателен.
Вопрос почти по теме: сейчас воюю с 1С сервером под Debian'ом, пытаюсь его научить авторизовать пользователей по учётным записям в AD. Пока получается не очень :( если есть у кого-нибудь в закромах годный гайд, был бы очень признателен.
Вот для 2008 R2 и 2003 R2:
blog.scottlowe.org/2007/07/09/linux-ad-integration-with-windows-server-2008/
blog.scottlowe.org/2007/01/15/linux-ad-integration-version-4/
Ну и ещё книгу «Linux in a Windows World» можно почитать, для общего развития.
blog.scottlowe.org/2007/07/09/linux-ad-integration-with-windows-server-2008/
blog.scottlowe.org/2007/01/15/linux-ad-integration-version-4/
Ну и ещё книгу «Linux in a Windows World» можно почитать, для общего развития.
Эммм, зачем столько всего? Наверняка есть уже определенные наборы баз, нужные определенным категориям пользователей. Создайте на шаре папки с именами этих наборов (для бухгалтерии, руководства, финотдела и проч.). В каждую папку положите ibases, 1cestart и 1cescmn. В 1cestart пропишите сетевой путь до лежащего рядом 1cescmn.cfg (commoncfglocation). В 1cescmn.cfg пропишите ссылку на лежащий в этой же папке список баз. Теперь раздайте 1cestart.cfg из нужной папки нужным пользователям по GP в %appdata%\1с.
Таким образом, при старте 1с полезет на шару в нужную папку за списком баз. Вы можете оперативно менять список баз на шаре, при этом он будет меняться и у пользователей. Базы, добавленные пользователем вручную на этот список не влияют.
Таким образом, при старте 1с полезет на шару в нужную папку за списком баз. Вы можете оперативно менять список баз на шаре, при этом он будет меняться и у пользователей. Базы, добавленные пользователем вручную на этот список не влияют.
При таком подходе при каждом входе у юзера будет создаваться новый кэш конфигурации, что замедлит старт системы, но с другой стороны застрахует от ошибок этого самого кэша. Кроме того, старый кэш у вас не уничтожается и копится в виде мусора.
Писалось для 1С 8.1 8.2, на основании этого добра, со скуки был написан генератор этого скрипта на delphi (если нужно, попробую почистить его и выложить)
Функции:
Добавление, исправление, записей к базам.
Создание файла с записями, если не существовал.
Установка новых релизов платформ (требует ввода пароля во всплывающем окне командной строки для пользователя Setup@DOMAIN.LOCAL). Криво, но на тот момент вариантов увы не было.
Фильтрация добавления, исправления, записей к базам для конкретных групп.
Установка компоненты ScanOPOS для 1С
и может быть что то еще ))
vbscript — изучал на написании данного скрипта, соответственно может быть очень криво.
Коментарии писал вроде бы понятные.
Если есть вопросы по этой каше, спрашивайте, попробую вспомнить почему так писал.
Функции:
Добавление, исправление, записей к базам.
Создание файла с записями, если не существовал.
Установка новых релизов платформ (требует ввода пароля во всплывающем окне командной строки для пользователя 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, который создает ярлыки подключений к терминальным серверам как в режиме удаленного рабочего стола с прописанной средой запуска, так и в режиме запуска опубликованного приложения. Фишка скрипта — определение размера экрана пользователя при запуске и установка именно такого размера экрана в свойствах подключения.
Следующий код делает почти тоже самое что и скрипт автора топика, но я не проверяю установлена ли 1С и формирую файлы с списками баз в профиле пользователя каждый раз при входе, предварительно их удаляя. В описании группы название базы в списке баз и в заметках параметры подключения к базе. Скрипт не мой, просил сделать на фрилансе, поэтому если кто то узнает свой код — еще раз примите благодарности, несколько лет не знаю горя.
' Скрипт создания на рабочем столе пользователя ярлыка удаленного подключения к рабочему столу
' или подключения 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, который создает ярлыки подключений к терминальным серверам как в режиме удаленного рабочего стола с прописанной средой запуска, так и в режиме запуска опубликованного приложения. Фишка скрипта — определение размера экрана пользователя при запуске и установка именно такого размера экрана в свойствах подключения.
Никогда не думал, что это может потянуть на статью на Хабре, если будет интересно и пригодится то вот код скрипта vbs, который создает ярлыки подключений к терминальным серверам как в режиме удаленного рабочего стола с прописанной средой запуска, так и в режиме запуска опубликованного приложения. Фишка скрипта — определение размера экрана пользователя при запуске и установка именно такого размера экрана в свойствах подключения.
Код
Следующий код делает почти тоже самое что и скрипт автора топика, но я не проверяю установлена ли 1С и формирую файлы с списками баз в профиле пользователя каждый раз при входе, предварительно их удаляя. В описании группы название базы в списке баз и в заметках параметры подключения к базе. Скрипт не мой, просил сделать на фрилансе, поэтому если кто то узнает свой код — еще раз примите благодарности, несколько лет не знаю горя.
' Скрипт создания на рабочем столе пользователя ярлыка удаленного подключения к рабочему столу
' или подключения 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 в список информационных баз у пользователя добавятся только те, на которые у него есть права на чтение.
Ни каких скриптов, права можно менять без перелогона пользователя и вообще удобно.
рядом с ним файл
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-файла можно организовать и по запросу (дать юзеру ссылку на отдельный скрипт для этого или самому запустить отдельный скрипт с указанием имени комп-а и пользователя), без перелогина.
Зарегистрируйтесь на Хабре, чтобы оставить комментарий
Управление списком баз 1С 8.2 с помощью Active Directory