Comments 17
Сколько же головной боли снимет этот скрипт.
Остается только 1 вопрос. Часто пользователю требуется иметь локальную базу. А дынный скрипт будет каждый раз удалять ее.
Не сталкивались с решениями которые могли бы обнаруживать еще и локальные базы?
Остается только 1 вопрос. Часто пользователю требуется иметь локальную базу. А дынный скрипт будет каждый раз удалять ее.
Не сталкивались с решениями которые могли бы обнаруживать еще и локальные базы?
0
Для локальной базы, можно просто иметь на рабочем столе файл *.v8i с прописанными параметрами подключения (такой-же как формировали на шаге 2), кликнув на него, у вас откроется именно эта база :)
0
Лет 6 назад писал vbs скрипт который который умел добавлять, удалять и исправлять базы у пользователя. С тех пор ничего не изменилось. Даже и не думал что это такая проблема. Поищу в архивах, может сохранился.
0
Просто отлично, в избранное :)
Вопрос почти по теме: сейчас воюю с 1С сервером под Debian'ом, пытаюсь его научить авторизовать пользователей по учётным записям в AD. Пока получается не очень :( если есть у кого-нибудь в закромах годный гайд, был бы очень признателен.
Вопрос почти по теме: сейчас воюю с 1С сервером под Debian'ом, пытаюсь его научить авторизовать пользователей по учётным записям в AD. Пока получается не очень :( если есть у кого-нибудь в закромах годный гайд, был бы очень признателен.
0
Вот для 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» можно почитать, для общего развития.
0
Эммм, зачем столько всего? Наверняка есть уже определенные наборы баз, нужные определенным категориям пользователей. Создайте на шаре папки с именами этих наборов (для бухгалтерии, руководства, финотдела и проч.). В каждую папку положите ibases, 1cestart и 1cescmn. В 1cestart пропишите сетевой путь до лежащего рядом 1cescmn.cfg (commoncfglocation). В 1cescmn.cfg пропишите ссылку на лежащий в этой же папке список баз. Теперь раздайте 1cestart.cfg из нужной папки нужным пользователям по GP в %appdata%\1с.
Таким образом, при старте 1с полезет на шару в нужную папку за списком баз. Вы можете оперативно менять список баз на шаре, при этом он будет меняться и у пользователей. Базы, добавленные пользователем вручную на этот список не влияют.
Таким образом, при старте 1с полезет на шару в нужную папку за списком баз. Вы можете оперативно менять список баз на шаре, при этом он будет меняться и у пользователей. Базы, добавленные пользователем вручную на этот список не влияют.
0
При таком подходе при каждом входе у юзера будет создаваться новый кэш конфигурации, что замедлит старт системы, но с другой стороны застрахует от ошибок этого самого кэша. Кроме того, старый кэш у вас не уничтожается и копится в виде мусора.
0
Писалось для 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 — изучал на написании данного скрипта, соответственно может быть очень криво.
Коментарии писал вроде бы понятные.
Если есть вопросы по этой каше, спрашивайте, попробую вспомнить почему так писал.
0
Никогда не думал, что это может потянуть на статью на Хабре, если будет интересно и пригодится то вот код скрипта 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
-2
Это нереальная лажа, я не проверил свой комментарий и ошибся с тегами. Прошу пардону.
Никогда не думал, что это может потянуть на статью на Хабре, если будет интересно и пригодится то вот код скрипта 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>
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 в список информационных баз у пользователя добавятся только те, на которые у него есть права на чтение.
Ни каких скриптов, права можно менять без перелогона пользователя и вообще удобно.
рядом с ним файл
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-файла можно организовать и по запросу (дать юзеру ссылку на отдельный скрипт для этого или самому запустить отдельный скрипт с указанием имени комп-а и пользователя), без перелогина.
0
Sign up to leave a comment.
Управление списком баз 1С 8.2 с помощью Active Directory