Saturday 13 June 2015

VBScript to list the Active Directory security groups a user belongs to

This is a little script that queries the Active Directory domain and returns the AD security group memberships that the given user belong to by querying the MemberOf  property of the user.

Note:
  • The computer that the script is run on has to be joined to a domain, as it is querying the root DSE.

'Response.Write GetADGroups("tallitguy")    'ASP
MsgBox GetADGroups("tallitguy")             'VBScript

Function GetADGroups (ADUserName)
    
    Const ADS_SCOPE_SUBTREE = 2
    
    Dim objRootDSE, strDNSDomain, strTarget
    Dim objConnection, objCmd, objRecordSet
    Dim tmp, Ctr, i, Grp, strList
    
    ' Connect to the LDAP server's root object
    Set objRootDSE = GetObject("LDAP://RootDSE")
    strDNSDomain = objRootDSE.Get("defaultNamingContext")
    strTarget = "LDAP://" & strDNSDomain

    ' Connect to AD Provider
    Set objConnection = CreateObject("ADODB.Connection")
    objConnection.Provider = "ADsDSOObject"
    ' Domain account credentials with read access to LDAP:
    objConnection.Properties("User ID") = "domain\username" 
    objConnection.Properties("Password") = "password" 
    ' Connect to AD
    objConnection.Open "Active Directory Provider"

    Set objCmd =   CreateObject("ADODB.Command")
    Set objCmd.ActiveConnection = objConnection 

    ' Query to get groups a user is a Member Of:
    objCmd.CommandText = "SELECT memberof " & _
                        " FROM '" & strTarget & "' " & _
                        " WHERE objectCategory = 'user' " & _
                        " and name='" & ADUserName & "' "
    ' Set up the command object before running it
    objCmd.Properties("Page Size") = 100
    objCmd.Properties("Timeout") = 30
    objCmd.Properties("Searchscope") = ADS_SCOPE_SUBTREE
    objCmd.Properties("Cache Results") = False
    
    ' Execute query
    Set objRecordSet = objCmd.Execute

    ' Initialize counter & return value
    Ctr = 0
    strList = ""
    
    ' Iterate through the query results    
    Do Until objRecordSet.EOF
        For i = 0 to objRecordSet.Fields.Count -1
            For each Grp in objRecordSet.Fields("memberof").value
                Ctr = Ctr + 1
                tmp = Replace(Split(Grp, ",")(0), "CN=", "") 
                
                strList = strList & tmp & "; " & vbcrlf
                
            Next
        Next
        objRecordSet.MoveNext
    Loop
    
    GetADGroups = strList
    End Function