Enumerate Active Directory Group Members

Want to share a script? Click here to contribute!

Author:
Shane Boudreaux

Platform:
Windows

Type:
Win

Description:
Script will enumerate group members, based on an Active Directory Group name.

Scroll down to view the script.

Enumerate Active Directory Group Members

''==================================
''  Enumerate Active Directory Group Members
''  Author:		Shane Boudreaux
''  Start Date:		5/22/07
''  Last Modified:	5/22/07
''==================================

''==================================
'' GLOBAL DECLARES & CONSTANTS
''==================================
On Error Resume Next
Const ForAppending = 8
Const DOMAIN = "LDAP://DC=YourDomain,DC=com"
Const GROUPHEADER = "GROUP:"
Const GROUPFOOTER = "====================="

Dim groupName

'' prompt user for FULL group name
groupName = inputbox("Enter Full Group Name")

'' check if output file exists; create if doesn''t exist
fileExists "c:members.txt"

'' find the group and output members to text file
findGroup groupName

wscript.echo "DONE!"
'' display results text file
openFile

''========================
Private Sub findGroup(grp)

	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") = 5000
	objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 

	objCommand.CommandText = "SELECT ''distinguishedName'' FROM ''" & DOMAIN & "'' WHERE objectCategory=''group'' " & _
		"AND Name=''" & grp & "*''"

	Set objRecordSet = objCommand.Execute

	objRecordSet.MoveFirst
	Do Until objRecordSet.EOF
    		group = objRecordSet.Fields("distinguishedName").Value
				getMembers group
    		objRecordSet.MoveNext
	Loop
End Sub
''========================

''========================
Private Sub getMembers(grp)
	Set objGroup = GetObject ("LDAP://" & grp)
	objGroup.GetInfo
	arrMemberOf = objGroup.GetEx("member")
	text = GROUPHEADER & vbcrlf & vbtab & grp & vbcrlf & GROUPFOOTER & vbcrlf & "MEMBERS:" & vbcrlf & GROUPFOOTER & vbcrlf
	For Each strMember in arrMemberOf
		''Dim temp
		''temp = pwdExpire(strMember)
		''strMember = strMember & vbcrlf & temp
		text = text & strMember & vbcrlf
	Next
	AppendToFile text
End Sub
''========================

''========================
Private Sub AppendToFile(text)
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objFile = objFSO.OpenTextFile("C:members.txt", ForAppending)
	If text <> "" Then
		objFile.WriteLine text
	Else
		objFile.WriteLine "No Members OR Incorrect Input"
	End If
	objFile.Close
End Sub
''========================

''========================
Private Sub openFile()
	Const WIN_STYLE = 4
	Set objShell = WScript.CreateObject("WScript.Shell")
	objShell.Run "notepad.exe c:members.txt", WIN_STYLE
End Sub
''========================

''================================
Private Sub fileExists(file)
	'' NOTE: param file must be full path and file name!
	Set objFSO = CreateObject("Scripting.FileSystemObject")

	If objFSO.FileExists(file) Then
    Exit Sub
	Else	'' Create File if DOESN''t Exist
    Set objFSO = CreateObject("Scripting.FileSystemObject")
		Set objFile = objFSO.CreateTextFile(file)
	End If
End Sub
''================================

''===============================
Private Function pwdExpire(user)
	Const SEC_IN_DAY = 86400
	Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
	Dim retVal
 
	Set objUserLDAP = GetObject("LDAP://" & user)
	intCurrentValue = objUserLDAP.Get("userAccountControl")
 
	If intCurrentValue and ADS_UF_DONT_EXPIRE_PASSWD Then
    retVal = vbTab & "Password does NOT expire."
	Else
    dtmValue = objUserLDAP.PasswordLastChanged 
    retVal = vbTab & "The password was last changed on " & _
        DateValue(dtmValue) & " at " & TimeValue(dtmValue) & VbCrLf & _
            vbTab & "The difference between when the password was last set" &  _
                "and today is " & int(now - dtmValue) & " days"
    intTimeInterval = int(now - dtmValue)
  
    Set objDomainNT = GetObject("WinNT://its")
    intMaxPwdAge = objDomainNT.Get("MaxPasswordAge")
    If intMaxPwdAge < 0 Then
        retVal = retVal & vbcrlf & vbtab & vbtab & "The Maximum Password Age is set to 0 in the " & _
            "domain. Therefore, the password does not expire."
    Else
        intMaxPwdAge = (intMaxPwdAge/SEC_IN_DAY)
        retVal = retVal & vbcrlf & vbtab & vbtab & "The maximum password age is " & intMaxPwdAge & " days"
        If intTimeInterval >= intMaxPwdAge Then
          retVal = retVal & vbcrlf & vbtab & vbtab & "The password has expired."
        Else
          retVal = retVal & vbcrlf & vbtab & vbtab & "The password will expire on " & _
              DateValue(dtmValue + intMaxPwdAge) & " (" & _
                  int((dtmValue + intMaxPwdAge) - now) & " days from today" & _
                      ")."
        End If
    End If
	End If
	pwdExpire = retVal
End Function
''===============================