'==========================================================================
'
' NAME: GetGroupMembers.vbs
'
' AUTHOR: Mark D. MacLachlan , The Spider's Parlor
' URL: [URL unfurl="true"]http://www.thespidersparlor.com[/URL]
' DATE : 3/23/2005
'
' COMMENT: Dumps group members to text file.
'
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF
' ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED To
' THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A
' PARTICULAR PURPOSE.
'
' IN NO EVENT SHALL THE SPIDER'S PARLOR AND/OR ITS RESPECTIVE SUPPLIERS
' BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
' DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
' WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS
' ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE
' OF THIS CODE OR INFORMATION.
'==========================================================================
Dim sResultText,Grps,MemberList
Dim oRootDSE, oConnection, oCommand, oRecordSet
Set oRootDSE = GetObject("LDAP://rootDSE")
Set oConnection = CreateObject("ADODB.Connection")
oConnection.Open "Provider=ADsDSOObject;"
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = oConnection
ldstring = "<LDAP://" & oRootDSE.get("defaultNamingContext") & ">;"
objCommand.CommandText=ldstring & "(objectClass=group);name,SamAccountName"
Set oRecordSet = objCommand.Execute()
Do While Not oRecordSet.EOF
sResultText = sResultText & oRecordSet.Fields("samAccountName") & vbCrLf
'WScript.Echo oRecordSet.Fields("samAccountName") & vbCrLf
MemberList=RetrieveUsers(dom,oRecordSet.Fields("samAccountName"))
'WScript.Echo Memberlist
sResultText = sResultText & memberlist & vbCrLf & "************************************" & vbCrLf
oRecordSet.MoveNext
Loop
'Wscript.Echo sResultText
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.CreateTextFile (dom & "DomainGroupUsers.txt", ForWriting)
ts.write sResultText
MsgBox "Done"
'*****************************************************************************************
'*****************************************************************************************
Function RetrieveUsers(domainName,grpName)
dim dom
dim grp
dim GrpObj
dim mbrlist
dim mbr
'-------------------------------------------------------------------------------
' *** Enumerate Group Members ***
'-------------------------------------------------------------------------------
grp = grpName
Set objDomain = getObject("LDAP://rootDse")
domainName = objDomain.Get("dnsHostName")
' Build the ADSI query and retrieve the group object
Set GrpObj = GetObject("WinNT://" & domainName & "/" & grp & ",group")
' Loop through the group membership and build a string containing the names
for each mbr in GrpObj.Members
On error resume next
mbremail = SearchEmail(mbr.name)
If Err Then
mbrlist = mbrlist & vbTab & mbr.name & vbCrLf
Else
'if you don't want the email addresses, then copy the line 2 up to below
mbrlist = mbrlist & vbTab & mbr.name & vbTab & vbTab & mbremail+ vbCrLf
End If
Next
'The next line returns mbrlist back up to the main body
RetrieveUsers=mbrlist
End Function
Public Function SearchEmail(ByVal vSAN)
' Function: SearchDistinguishedName
' Description: Searches the DistinguishedName for a given SamAccountName
' Parameters: ByVal vSAN - The SamAccountName to search
' Returns: The DistinguishedName Name
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=User)(samAccountName=" & vSAN & "));mail;subtree"
Set oRecordSet = oCommand.Execute
On Error Resume Next
SearchEmail = oRecordSet.Fields("mail")
On Error GoTo 0
oConnection.Close
Set oRecordSet = Nothing
Set oCommand = Nothing
Set oConnection = Nothing
Set oRootDSE = Nothing
End Function
