Управление списком баз 1С 8.2 через группы Active Directory

Собственно, поскольку лень двигатель прогресса, и подключать базы вручную не хотелось, то на свет явился этот скрипт. Прошу сильно не пинать, писалось методом "вроде бы работает"(уже с год).

Для начала советую прочитать информацию по этой ссылке http://infostart.ru/public/104469/, что бы понять, где хранятся и как используются конфиги 1С, отвечающие за подключение баз. Будет легче понять, о чем пойдет речь далее.

Итак, есть AD, 400 пользователей и пара десятков баз.
Задача:
1. По максимуму автоматизировать прописывание баз 1С 8.2.
2. Иметь возможность за пару минут поменять параметры подключения у всех пользователей(на случай, если сервер 1С забрали маски шоу вышел из строя).
3. Желательно, не устанавливать на клиентские ПК дополнительный софт.



Выглядеть это должно так:

В AD создается группа, связанная с конкретной базой.
Если пользователь является членом этой группы, то ему прописывается база, если пользователь был исключен из группы, база удаляется.
Права на управление членством в группе делегируются техподдержке и 1С программистам.
Также, некоторые пользователи при заведении учетки уже являются членами необходимых групп(Например бухгалтеру ООО "Ромашка"

логично подключить бух. базу этой компании.).
Имя каждой группы должно начинаьтся с ConnectDB_1C_82, скрипт, запускаясь и получая список групп, отбрасывает не нужные.
Далее идет ID компании(01 - ООО "Ромашка" 02 - ЗАО "Вектор+" и т.д).
Затем тип конфигурации(buh,zup,ts,uso...)



Значения группы выглядят так:

Собственно, здесь интересует только значение поля Notes. В нем храниться путь(в данном случае на реплицируемую по всем офисам DFS шару) к файлу .v8i в котором прописаны настройки подключения к самой базе, и именно этот путь будет прописываться скриптом в конфигурационный файл 1С(1СEStart.cfg).

Поле Description ни на что не влияет.







Вот пример файла *.v8i:
[Бухгалтерия ООО "Ромашка"]
Connect=Srvr="appsrv-03";Ref="01_82_acc";
ClientConnectionSpeed=Normal
App=Auto
WA=1
Version=8.2

Немного про файловую шару, где будут хранятся эти файлы. Крайне желательно, что бы она была продублирована. Если откажет сервер, на котором лежат эти файлы, то пользователи не смогут подключиться к базе, несмотря на то, что сам сервер 1С жив. Еще хуже, если у вас распределенная географически сеть(в моем случае есть 2 центральных офиса и 5 филиалов). Я для этого использовал DFS репликацию(DFS-R). В каждом офисе есть файловый сервер, на каждом сервере создана расшаренная для чтения папка, и между этими папками проходит репликация. Прелесть DFS в том, что даже если один из серверов откажет, то пользовательские ПК загрузят эти файлы с шары из другого офиса, при этом, для них это будет прозрачно.
Еще вариант, который пришел в голову уже после внедрения, что можно использовать в этих целях контроллеры домена(папка Netlogon, которая также использует DFS-R). Хоть MS и не рекомендует использовать эту папку, но размер даже сотни таких файлов будет мизерным и вряд ли скажется на производительности КД.

Как работает скрипт.
1. Извлекает все группы из AD, членом которых является пользователь.
2. Отбрасывает все, кроме тех, которые начинаются с ConnectDB_1C_82.
3. Получает значение атрибута "Notes".
4. Прописывает значение этого атрибута в файл 1CEStart.cfg
Попутно пишется лог:
Для Windows 7 - C:\Users\username\appdata\Local\Temp\_dbconn.log
Для Windows XP - C:\Documents and Settings\username\Local Settings\Temp\_dbconn.log

Скрипт вешается через GPO на Logon пользователя, и отрабатывает при каждом входе, каждый раз формируя файл 1CEStart.cfg.
Соответственно, если мы пользователя из группы исключили, то при следующем входе в систему - файл будет пересоздан заново, и запись о базе пропадет.

При необходимости изменить параметры подключения к какой то базе(Задача п.2), нам достаточно поменять их в одном месте. Поскольку сами *.v8i файлы не храниться на пользовательских ПК, а загружаются в момент старта 1С, то поменяв их на файловом сервере, пользователю будет достаточно перезапустить 1С.

Еще одна особенность. Если мы добавили\исключили пользователя в\из группы, то ему нет нужды завершать все приложения и перелогиниватся, достаточно отправить ему ссылку на скрипт(например по e-mail), и база сразу пропишется\удалиться.

Собственно, сам скрипт с небольшими комментариями.
Часть, отвечающая за шаг 1 была взята отсюда и немного переделана(те комментарии, которые на английском - это не мои).

On Error Resume Next
Const PROPERTY_NOT_FOUND  = &h8000500D
Dim sGroupNames
Dim sGroupDNs
Dim aGroupNames
Dim aGroupDNs
Dim aMemof
Dim oUser
Dim tgdn

Const ForReading = 1, ForWriting = 2, ForAppending = 8
'Настраиваем лог файл
Set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("Wscript.Shell")
strSysVarTEMP = WshShell.ExpandEnvironmentStrings("%TEMP%")
Set oScriptLog = fso.OpenTextFile(strSysVarTEMP + "\_dbconn.log",ForWriting,True)
oScriptLog.Write ""
strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "Start..."
oScriptLog.WriteLine(strToLog)

'Проверяем, что 1С установлена
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not (objFSO.FolderExists("C:\Program Files\1cv82") Or objFSO.FolderExists("C:\Program Files (x86)\1cv82")) Then
strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "1C 8.2 not installed... Quit..."
oScriptLog.WriteLine(strToLog)
    WScript.quit
End If


'
' Initialise strings. We make the assumption that every account is a member of two system groups
'
sGroupNames = "Authenticated Users(S),Everyone(S)"
'
' Enter the DN for the user account here
Set objSysInfo = CreateObject("ADSystemInfo")
strUserName = objSysInfo.UserName
strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "Logged user DN: "+strUserName
oScriptLog.WriteLine(strToLog)

'  Получаем имя залогиненного пользователя
Set oUser = GetObject("LDAP://" + strUserName)
If Err.Number <> 0 Then
        strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "There is an error retrieving the account. Please check your distinguished name syntax assigned to the oUser object."
        oScriptLog.WriteLine(strToLog)
WScript.quit
End If
'
' Determine the DN of the primary group
' We make an assumption that every user account is a member of a primary group
'
iPgid = oUser.Get("primaryGroupID")
sGroupDNs = primgroup(iPgid)
tgdn = sGroupDNs
'
' Call a subroutine to extract the group name and scope
' Add the result to the accumulated group name String
'
Call AddGroupName(tgdn)
Call Getmemof(tgdn)
'
' Check the direct group membership for the User account
'
aMemOf = oUser.GetEx("memberOf")
If Err.Number <> PROPERTY_NOT_FOUND Then
'
' Call a recursive subroutine to retrieve all indirect group memberships
'
        Err.clear
    For Each GroupDN in aMemof
        Call AddGroups(GroupDN)
        Call Getmemof(GroupDN)
    Next
End If

aGroupNames = Split(sGroupNames,",")
aGroupDNs = Split(sGroupDNs,":")

'Откидываем все группы, кроме начинающихся с ConnectDB_1C_82
For Each strGroupDN in aGroupDNs
if StrComp(Mid(strGroupDN,1,18), "CN=ConnectDB_1C_82", vbTextCompare) = 0 Then
strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "User is member of: " + strGroupDN
oScriptLog.WriteLine(strToLog)
Set objGroup = GetObject("LDAP://" & strGroupDN)
If Err.Number <> 0 Then
strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "There is an error retrieving the group. Please check your distinguished name syntax assigned to the objGroup object: " + strGroupDN
oScriptLog.WriteLine(strToLog)
WScript.quit
End If
strInfo = objGroup.Get("info")
strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "Group " + strGroupDN +" info field: " + strInfo
oScriptLog.WriteLine(strToLog)
strAllInfo = strAllInfo & ":" & strInfo


End If
Next

aInfoStrings = Split(strAllInfo,":")


Call WriteDBSettings()


Sub WriteDBSettings()
'Прописываем ссылки на v8i файлы в 1CEStart.cfg
strSysVarAPPDATA = WshShell.ExpandEnvironmentStrings("%APPDATA%")
strDBConfigFilePath = strSysVarAPPDATA + "\1C\1CEStart\1CEStart.cfg"
strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "1C Config file is: " + strDBConfigFilePath
oScriptLog.WriteLine(strToLog)

If (fso.FileExists(strDBConfigFilePath)) Then
Set objDBConfigFile = fso.OpenTextFile(strDBConfigFilePath,ForWriting,True)
objDBConfigFile.Write ""
For each strInfo in aInfoStrings
objDBConfigFile.WriteLine("CommonInfoBases=" + strInfo)
strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "Add Line: " + "CommonInfoBases=" + strInfo
oScriptLog.WriteLine(strToLog)
next
'Изменить на 0, если аппаратные лицензии не используются
objDBConfigFile.WriteLine("UseHWLicenses=1")
strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "Add Line: " + "UseHWLicenses=1"
oScriptLog.WriteLine(strToLog)
strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "Ready"
oScriptLog.WriteLine(strToLog)
objDBConfigFile.Close
Else
strToLog = CStr(Date())+" "+CStr(Time()) + " - " + "1C Config file" + strDBConfigFilePath + " Not Exist! Exit!"
oScriptLog.WriteLine(strToLog)
WScript.Quit
End If

End Sub

'*************************************************************************************************
' End of mainline code
'*************************************************************************************************

Function primgroup(groupid)
' This function accepts a primary group id
' It binds to the local domain and returns the DN of the primary group
' David Zemdegs 6 May 2008
'
Dim oRootDSE,oConn,oCmd,oRset
Dim ADDomain,srchdmn
' Bind to loca domain
Set oRootDSE = GetObject("LDAP://RootDSE")
ADDomain = oRootDSE.Get("defaultNamingContext")
srchdmn = "<LDAP://" & ADDomain & ">"
'
' Initialise AD search and obtain the recordset of groups
'
Set oConn = CreateObject("ADODB.Connection")
oConn.Open "Provider=ADsDSOObject;"
Set oCmd = CreateObject("ADODB.Command")
oCmd.ActiveConnection = oConn
oCmd.CommandText = srchdmn & ";(objectCategory=Group);" & _
        "distinguishedName,primaryGroupToken;subtree"
Set oRset = oCmd.Execute
'
' Loop through the recordset and find the matching primary group token
' When found retrieve the DN and exit the loop
'
Do Until oRset.EOF
    If oRset.Fields("primaryGroupToken") = groupid Then
        primgroup = oRset.Fields("distinguishedName")
        Exit Do
    End If
    oRset.MoveNext
Loop
'
' Close and tidy up objects
'
oConn.Close
Set oRootDSE = Nothing
Set oConn = Nothing
Set oCmd = Nothing
Set oRset = Nothing
End Function
Sub Getmemof(sDN)
'
' This is recursive subroutine that calls itself for memberof Property
' David Zemdegs 6 May 2008
'
On Error Resume Next
Dim oGrp
Dim aGrpMemOf
Dim sGrpDN
Set oGrp = GetObject("LDAP://" & sDN)
aGrpMemOf = oGrp.GetEx("memberOf")
If Err.Number <> PROPERTY_NOT_FOUND Then
'
' Call a recursive subroutine to retrieve all indirect group memberships
'
        Err.clear
    For Each sGrpDN in aGrpMemOf
                Call AddGroups(sGrpDN)
        Call Getmemof(sGrpDN)
    Next
End If
Err.clear
Set oGrp = Nothing
End Sub
Sub AddGroups(sGdn)
'
' This subroutine accepts a disguished name
' It extracts the RDN as the group name and determines the group scope
' This is then appended to the group name String
' It also appends the DN to the DN String
'
Const SCOPE_GLOBAL = &h2
Const SCOPE_LOCAL = &h4
Const SCOPE_UNIVERSAL = &h8
Dim SNewgrp
'
' Retrieve the group name
'
iComma = InStr(1,sGdn,",")
sGrpName = Mid(sGdn,4,iComma-4)

'
' Add the results to the group name String
' Check that the group doesnt already exist in the list
'
sNewgrp = sGrpName
If InStr(1,sGroupNames,SNewgrp,1) = 0 Then
        sGroupNames = sGroupNames & "," & SNewgrp
End If
'
' Add the Groups DN to the string if not duplicate
'
If InStr(1,sGroupDNs,sGdn,1) = 0 Then
        sGroupDNs = sGroupDNs & ":" & sGdn
End If
End Sub