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

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

' Скрипт создания на рабочем столе пользователя ярлыка удаленного подключения к рабочему столу 
' или подключения 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>

' Префикс названий групп
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>