1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
Option Explicit
Dim StrContainer , StrGrp
Dim objGroup, strDN, objMemberList
Dim adoConnection, adoCommand, objRootDSE, strDNSDomain
Dim FSO,Fichier, StrList
Const Lire = 1, Ecrire = 2, Ajouter = 8
' Dictionary object to track group membership.
Set objMemberList = CreateObject("Scripting.Dictionary")
objMemberList.CompareMode = vbTextCompare
Set FSO = Wscript.CreateObject("Scripting.FileSystemObject")
StrContainer = "OU=GROUPES,OU=ORGANISATION,OU=VILLE"
StrDN = InputBox("Veuillez entrer le nom du groupe" & VbCrlf & "dont vous voulez les membres","Lister les utilisateurs de groupe by Vikingraver entreprise")
' Se connecter sur le groupe
Set objRootDSE = GetObject("LDAP://RootDSE")
StrDNSDomain = objRootDSE.Get("defaultNamingContext")
On Error Resume Next
Set ObjGroup = GetObject("LDAP://CN=" & StrDN & "," & strContainer & "," & StrDNSDomain)
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Groupe non trouvé" & vbCrLf & strDN
Wscript.Quit(1)
End If
On Error GoTo 0
' Setup ADO.
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Enumerer les membres du groupe
Call EnumGroup(objGroup, " ")
set Fichier=FSO.OpenTextFile("Liste.txt",Ajouter,true)
Fichier.WriteLine "********************" & VbCrlf & "Les membres de " & StrDN & " sont :" & vbCrlf & VbCrlf & "********************" & VbCrlf & Vbcrlf & VbCrlf & StrList
Fichier.Close
adoConnection.Close
Set objGroup = Nothing
Set objRootDSE = Nothing
Set adoCommand = Nothing
Set adoConnection = Nothing
'#################################################################################
Sub EnumGroup(ByVal objADGroup, ByVal strOffset)
' Recursive subroutine to enumerate group membership.
' objMemberList is a dictionary object with global scope.
' objADGroup is a group object bound with the LDAP provider.
' This subroutine outputs a list of group members, one member
' per line. Nested group members are included. Users are also
' included if their primary group is objADGroup. objMemberList
' prevents an infinite loop if nested groups are circular.
Dim strFilter, strAttributes, adoRecordset, intGroupToken
Dim objMember, strQuery, strNTName
' Retrieve "primaryGroupToken" of group.
objADGroup.GetInfoEx Array("primaryGroupToken"), 0
intGroupToken = objADGroup.Get("primaryGroupToken")
' Use ADO to search for users whose "primaryGroupID" matches the
' group "primaryGroupToken".
strFilter = "(primaryGroupID=" & intGroupToken & ")"
strAttributes = "sAMAccountName"
strQuery = "<LDAP://" & strDNSDomain & ">;" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
Set adoRecordset = adoCommand.Execute
Do Until adoRecordset.EOF
strNTName = adoRecordset.Fields("sAMAccountName").Value
If (objMemberList.Exists(strNTName) = False) Then
objMemberList.Add strNTName, True
StrList = StrList & strOffset & strNTName & " (Primary)" & VbCrlf
Else
StrList = StrList & strOffset & strNTName & " (Primary, Duplicate)" & Vbcrlf
End If
adoRecordset.MoveNext
Loop
adoRecordset.Close
For Each objMember In objADGroup.Members
If (objMemberList.Exists(objMember.sAMAccountName) = False) Then
objMemberList.Add objMember.sAMAccountName, True
If (UCase(Left(objMember.objectCategory, 8)) = "CN=GROUP") Then
StrList = Strlist & VbCrlf & StrOffset & "-----------------------" & VbCrlf & strOffset & objMember.sAMAccountName & " (Groupe)" & VbCrlf
Call EnumGroup(objMember, strOffset & strOffset & strOffset)
Else
StrList = StrList & strOffset & objMember.sAMAccountName & VbCrlf
End If
Else
StrList = Strlist & strOffset & objMember.sAMAccountName & " (Ce compte existe deja dans un autre groupe.)" & VbCrlf
End If
Next
Set objMember = Nothing
Set adoRecordset = Nothing
End Sub |
