I have been working on this problem for days, and I am struggling to find a solution that works.
Basically, I want a function in the following form:
in_group(username, groupname)
That returns 1 if the the username is in the group, and 0 otherwise. Does anyone have any sources or solutions for this problem? I am trying to work with the following code:
Function GetMembers(gDN)
Set objGroup = GetObject("LDAP://" & gDN)
objGroup.GetInfo
arrMemberOf = objGroup.GetEx("member")
For Each strMember in arrMemberOf
Set objMember = GetObject("LDAP://" & strMember)
ObjDisp = objMember.Name
oDL = Len(ObjDisp) - 3
ObjDisp = Right(ObjDisp,oDL)
ObjCatArray = Split(objMember.objectCategory,",")
oType = ObjCatArray(0)
oTL = Len(oType) - 3
oType = Right(oType,oTL)
msgbox "Member:" & ObjDisp & Space(20-Len(ObjDIsp)) &" Type:" & oType
If oType = "Group" Then
GetMembers(strMember)
End If
Set objMember = Nothing
Next
End Function
Public Function SearchGroup(ByVal vSAN)
Dim oRootDSE, oConnection, oCommand, oRecordSet
Set oRootDSE = GetObject("LDAP://rootDSE")
Set oConnection = CreateObject("ADODB.Connection")
oConnection.Open "Provider=ADsDSOObject;"
Set oCommand = CreateObject("ADODB.Command")
oCommand.ActiveConnection = oConnection
oCommand.CommandText = "<LDAP://" & oRootDSE.get("defaultNamingContext") & _
">;(&(objectCategory=Group)(samAccountName=" & vSAN & "));distinguishedName;subtree"
Set oRecordSet = oCommand.Execute
On Error Resume Next
SearchGroup = oRecordSet.Fields("distinguishedName")
On Error GoTo 0
oConnection.Close
Set oRecordSet = Nothing
Set oCommand = Nothing
Set oConnection = Nothing
Set oRootDSE = Nothing
End Function
and, alternatively:
Function IsMember(ByVal objADObject, ByVal strGroupNTName)
' Function to test for group membership.
' objADObject is a user or computer object.
' strGroupNTName is the NT name (sAMAccountName) of the group to test.
' objGroupList is a dictionary object, with global scope.
' Returns True if the user or computer is a member of the group.
' Subroutine LoadGroups is called once for each different objADObject.
Dim objRootDSE, strDNSDomain
' The first time IsMember is called, setup the dictionary object
' and objects required for ADO.
If (IsEmpty(objGroupList) = True) Then
Set objGroupList = CreateObject("Scripting.Dictionary")
objGroupList.CompareMode = vbTextCompare
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Search entire domain.
strBase = "<LDAP://" & strDNSDomain & ">"
' Retrieve NT name of each group.
strAttributes = "sAMAccountName"
' Load group memberships for this user or computer into dictionary
' object.
Call LoadGroups(objADObject)
Set objRootDSE = Nothing
End If
If (objGroupList.Exists(objADObject.sAMAccountName & "\") = False) Then
' Dictionary object established, but group memberships for this
' user or computer must be added.
Call LoadGroups(objADObject)
End If
' Return True if this user or computer is a member of the group.
IsMember = objGroupList.Exists(objADObject.sAMAccountName & "\" & strGroupNTName)
End Function
Thoughts? Bonus points if the solution uses "Safe Mode" instead of "System Access." Thanks for your help.
