In an earlier article I’ve been talkin about how to check if a user belongs to a specific domain group. However, the code in that article doesn’t work on local groups and WinNT ADSI provider. I’ve made an update to the code posted there, this should work both on domain and local groups.
Usage:
If IsUserInGroup("Contoso\JohnDoe", "Contoso\Managers") Then
'...do something
End If
Notes:
- Option Strict Off. Sorry, I’m using the GetObject magic function here, so there’s no way I could leave the option strict on.
- Seems to be quite slow when local groups are scanned from outside.
- Could be a problem when you have users from two different domains + local users.
'''<created>
''' <author>Krišs Rauhvargers</author>
''' <date>2006.04.26</date>
'''</created>
'''<summary>Checks if a user belongs to the specified group.</summary>
'''<remarks>Should now work both on domain and local groups/users</remarks>
'''<param name="spUserLogin">Login name, e.g. Contoso\JohnDoe</param>
'''<param name="spGroupLogin">Group name, e.g. Contoso\Managers</param>
Public Function IsUserInGroup(ByVal spUserLogin As String, _
ByVal spGroupLogin As String) As Boolean
Dim oSeenGroups As New Specialized.StringCollection
Return IsUserInGroup(spUserLogin, spGroupLogin, oSeenGroups)
End Function
'''<created>
''' <author>Krišs Rauhvargers</author>
''' <date>2006.04.26</date>
'''</created>
'''<summary>Performs a recursive check if the user specified belongs to the
'''group.</summary>
'''<param name="spUserLogin">User login name, authority\account</param>
'''<param name="spGroupLogin">Group login name, authority\account</param>
'''<param name="opSeenGroups">A collection of previously visited groups</param>
'''<param name="opUserObj">An instance of COM object for user entry (saving resources)</param>
'''<returns>Boolean</returns>
Private Function IsUserInGroup(ByVal spUserLogin As String, _
ByVal spGroupLogin As String, _
ByVal opSeenGroups As Collections.Specialized.StringCollection, _
Optional ByVal opUserObj As Object = Nothing) As Boolean
Dim oUserObj As Object
Dim oGroupObj As Object
Dim oGroupsToCheck As New Specialized.StringCollection
'it's theoretically possible to get a loop - "A includes B" and "B includes A"
'so it's more safe to remember the seen groups
If opSeenGroups.Contains(spGroupLogin) Then Return False
opSeenGroups.Add(LCase(spGroupLogin))
If opUserObj Is Nothing Then
oUserObj = GetAdsiObj(spUserLogin)
Else
'if we already have found the "user object" use that one
oUserObj = opUserObj
End If
'get an ADSI object instance for the group
oGroupObj = GetAdsiObj(spGroupLogin)
'chek all the group members, perform a recursive call
'when a member of type "group" is found
For Each oMember As Object In oGroupObj.Members
If LCase(oMember.class) = "user" Then
'"normal" case when a group contains members of type "user"
If SidsEqual(oMember.objectsid, oUserObj.objectsid) Then
'assume the user is in group if SIDs of both objects are equal
Return True
End If
ElseIf LCase(oMember.class) = "group" Then
'if a group contains a member of type "group"
'have to check - if the user object we're looking is probably a group itself.
If LCase(oUserObj.class) = "group" Then
If SidsEqual(oMember.objectsid, oUserObj.objectsid) Then
'if so - see if sids are equal or not
Return True
End If
Else
'we've found a group within a group. have to perform a recursive check
If LCase(oGroupObj.parent).indexof("ldap://") > -1 Then
'a domain group contains a subgroup
Dim sTmpDomain, sTmpAccount As String
SplitLogin(spGroupLogin, sTmpDomain, sTmpAccount)
oGroupsToCheck.Add(LCase(sTmpDomain & "\" & oMember.samaccountname))
Else
'a local group contains a subgroup (a domain group can be registered as a
'member of a local group
oGroupsToCheck.Add(LCase(LastAuthority(oMember.parent) & "\" & oMember.name))
End If
End If
End If
Next
'see if we have found sub-groups
If oGroupsToCheck.Count > 0 Then
'if any of the subgroups contains the member we're looking for- return true
For Each sGroupLogin As String In oGroupsToCheck
If IsUserInGroup(spUserLogin, sGroupLogin, opSeenGroups, oUserObj) = True Then
Return True
End If
Next
End If
'if we have come this far - the member is not found
Return False
End Function
'''<created>
''' <author>Krišs Rauhvargers</author>
''' <date>2006.04.27</date>
'''</created>
'''<summary>Checks if the object is registered in local security authority
'''or it is a domain level entry.</summary>
'''<remarks>Assumes WINNT provider format</remarks>
'''<param name="spParentURI">WinNT://blabla</param>
'''<returns>Boolean</returns>
Private Shared Function IsLocal(ByVal spParentURI As String) As Boolean
If spParentURI Is Nothing OrElse spParentURI.Length < 7 Then
Throw New FormatException("Incorrect parent property! " & spParentURI)
End If
Return Not (spParentURI.LastIndexOf("/") = 7)
End Function
'''<created>
''' <author>Krišs Rauhvargers</author>
''' <date>2006.04.27</date>
'''</created>
'''<summary>Gets the last security authority name</summary>
'''<remarks>Can be WinNT://domain/computer or WinNT://domain. The first case
''' returns 'computer', the second one - 'domain'</remarks>
'''<param name="spParentUri"></param>
'''<returns>String</returns>
Private Shared Function LastAuthority(ByVal spParentUri As String) As String
If spParentUri Is Nothing OrElse spParentUri.Length < 7 Then
Return "" 'must have WinNT providers
End If
Return spParentUri.Substring(spParentUri.LastIndexOf("/") + 1)
End Function
'''<created>
''' <author>Krišs Rauhvargers</author>
''' <date>2006.04.26</date>
'''</created>
'''<summary>Creates the ADSI object for a member.</summary>
'''<remarks>Returns LDAP:// or WINNT:// object, according to member type</remarks>
'''<param name="spGroupLogin">Members login name</param>
Private Function GetAdsiObj(ByVal spLogin As String) As Object
Try
Dim sDomain, sAccount As String
Dim oAdsiObj As Object
SplitLogin(spLogin, sDomain, sAccount)
oAdsiObj = GetObject("WinNT://" & sDomain & "/" & sAccount)
'if the member found is not local, upgrade to an LDAP object
If Not IsLocal(oAdsiObj.parent) Then
oAdsiObj = GetObject("LDAP://" & Me.DistingishedNameFromLogin(spLogin))
End If
Return oAdsiObj
Catch ex As Exception
Throw New Exception("Member not found: " & spLogin, ex)
End Try
End Function
'''<created>
''' <author>Krišs Rauhvargers</author>
''' <date>2006.04.26</date>
'''</created>
'''<summary>Checks if two SIDs are equal</summary>
'''<remarks>Compares two byte arrays.</remarks>
Public Function SidsEqual(ByVal bapFirst As Byte(), ByVal bapSecond As Byte()) As Boolean
'if one of arrays is not initiated or sizes differ
If bapFirst Is Nothing Or bapSecond Is Nothing Then Return False
If bapFirst.Length <> bapSecond.Length Then Return False
For i As Integer = 0 To bapFirst.Length - 1
If bapFirst(i) <> bapSecond(i) Then
Return False
End If
Next
Return True
End Function
'''<created>
''' <author>Krišs Rauhvargers</author>
''' <date>2005.10.12</date>
'''</created>
'''<summary>Gets the full user reference from login name (domain members only!)</summary>
'''<param name="spLogin">domain\user</param>
Public Shared Function DistingishedNameFromLogin(ByVal spLogin As String) As String
Dim sLogin, sDomain As String
Dim sFilter As String
Dim dsEntryObj As DirectoryEntry
Dim dsSearcher As DirectorySearcher
Dim dsResult As SearchResultCollection
If Trim(spLogin) = "" Then Return ""
'get the domain and login part
If Not (SplitLogin(spLogin, sDomain, sLogin)) Then
Return ""
End If
Try
'meklēšana LDAP://LB
dsEntryObj = New DirectoryEntry("LDAP://" & sDomain)
Catch e As Exception
Throw New System.Exception(String.Format("Can't create the LDAP object!" & "LDAP://" & sDomain))
End Try
'izveido meklētāja objektu
dsSearcher = New DirectorySearcher(dsEntryObj)
'looking for a specific SAMAccountName - persons or groups only
dsSearcher.Filter = String.Concat("(&(sAMAccountName=", sLogin, ")(|(objectCategory=group)(objectCategory=person)))")
Try
dsSearcher.SearchScope = SearchScope.Subtree
dsResult = dsSearcher.FindAll()
Catch e As Exception
Throw New Exception(String.Format("Error in directory lookup. Filter: {0}", dsSearcher.Filter))
End Try
'''have to dispose this kind of objects
dsEntryObj.Dispose()
dsSearcher.Dispose()
Try
If dsResult.Count = 0 Then
Return ""
ElseIf dsResult.Count > 1 Then
Throw New ArgumentException("More than one entries found having the same account name! Account:" & spLogin)
Else
'the good case
Return dsResult(0).Properties("distinguishedname")(0).ToString
End If
Finally
dsResult.Dispose()
End Try
End Function
'''<created>
''' <author>Krišs Rauhvargers</author>
''' <date>2005.10.12</date>
'''</created>
'''<summary>Splits login name into parts (domain\user)</summary>
'''<remarks></remarks>
'''<param name="spLogin">Full login name</param>
'''<param name="spDomain">OUT: domain</param>
'''<param name="spAccount">OUT: account</param>
'''<returns>Boolean</returns>
Public Shared Function SplitLogin(ByVal spLogin As String, ByRef spDomain As String, ByRef spAccount As String) As Boolean
Dim iSlashPos As Integer
spLogin = spLogin.Replace("/"c, "\"c)
iSlashPos = spLogin.IndexOf("\"c)
If iSlashPos > -1 Then
With spLogin.Split("\"c)
spAccount = .GetValue(1).ToString
spDomain = .GetValue(0).ToString
End With
Return True
Else
Return False
End If
End Function
Thanks for the code. Saved me a bunch of time.
Jay