понедельник, 29 июля 2019 г.

Хочу прописывать базы 1с через членство в AD

Копипастим скрипт, создаем в AD группы с именем 1cbase_bla-bla-bla
Добавляем туда пользователей.
В описание (поле info) пишем информацию о подключении к БД (никаких русских буков):
[DBCaption]
Connect=Srvr="1сservername";Ref="dbname";
OrderInList=-1
Folder=/
OrderInTree=-1
External=0
ClientConnectionSpeed=Normal
App=Auto
WA=1

Скрипт  добавляем на вход пользователя и все - радуемся.
Если пользователь не в группе - ibases.v8i не будет изменен.

Все! Радуемся, пьем пиво и никуда больше не бегаем.

[code]
On Error Resume Next
Set objNet=Createobject("Wscript.Network")
Set objUser=Getobject("WinNT://" & objNet.UserDomain & "/" & objNet.UserName)
Set objFSO=Createobject("Scripting.Filesystemobject")
Set objShell=Createobject("Wscript.Shell")
strUP=objShell.ExpandEnvironmentStrings("%USERPROFILE%")
strFile=strUP & "\AppData\Roaming\1c\1cestart\ibases.v8i"
arrGroup=Split(GroupList,"|")
For i=0 to Ubound(arrGroup)
If IsMember(arrGroup(i),objUser.Name)=True Then
strBL=strBL & GetBaseInfo(arrGroup(i)) & vbcrlf
End If
Next
If strBL<>"" Then
Set objFile=objFSO.OpenTextFile(strFile,2,True)
objFile.Write strBL
objFile.Close
Set objFile=Nothing
End If
Set objShell=Nothing
Set objFSO=Nothing
Set objUser=Nothing
Set objNet=Nothing
Wscript.Quit


Function GetBaseInfo(strGroup)
On Error Resume Next
GetBaseInfo = GetLDAPValue("info", "cn ='" & strGroup & "'")
End Function


Function GetLDAPValue(strValue, strFilter)
On Error Resume Next
Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
strQuery = "SELECT " & strValue & " FROM 'LDAP://" & GetLDAPDomain & "' WHERE " & strFilter
objCommand.CommandText = strQuery
Set objRecordSet = objCommand.Execute
Do Until objRecordSet.EOF
strVar = strVar & objRecordSet.Fields(strValue).Value & "|"
objRecordSet.MoveNext
Loop
If Len(strVar) > 1 Then strVar = Left(strVar, Len(strVar) - 1)
GetLDAPValue = strVar
End Function

Function GetLDAPDomain()
    Set iAdRootDSE = GetObject("LDAP://RootDSE")
    GetLDAPDomain = iAdRootDSE.Get("defaultNamingContext")
End Function

Function GroupList
On Error Resume Next
strGrouplist=""
Set objDomain=Getobject("WinNT://" & objNet.UserDomain)
For Each object in objDomain
If object.Class="Group" Then
If Left(Lcase(object.Name),7)="1cbase_" Then
strGroupList=strGroupList & object.name & "|"
End If
End If
Next
If Right(strGroupList,1)="|" Then strGroupList=Left(strGroupList,Len(strGroupList)-1)
GroupList=strGroupList
End Function
Function IsMember(strGroup,strUser)
On Error Resume Next
IsMember=False
Set objGroup=Getobject("WinNT://" & objNet.UserDomain & "/" & strGroup)
For Each objMember In objGroup.Members
If Lcase(objMember.Name)=Lcase(strUser) Then IsMember=True
Next
End Function
[/code]