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
|
Option Explicit
'inclus les groupes imbriqués
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=Utilisateurs du domaine"
Reorganisation,OU=GROUPES,OU=TGITOULOUSE,OU=Ressort Cour d'appel de Toulouse"
StrDN = InputBox("Veuillez entrer le nom du groupe" & VbCrlf & "dont vous voulez les membres","Lister les utilisateurs de groupe by JB 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-ressource.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)
Dim strFilter, strAttributes, adoRecordset, intGroupToken
Dim objMember, strQuery, strNTName,Nomposte
' Retrieve "primaryGroupToken" of group.
objADGroup.GetInfoEx Array("primaryGroupToken"), 0
intGroupToken = objADGroup.Get("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
Nomposte=objMember.sAMAccountName
If instr(1,nomposte,"$") Then
nomposte=replace(nomposte,"$"," ")
End If
StrList = StrList & strOffset & nomposte & 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 |
Partager