TUTOS.EU

Lister les utilisateurs d'un domaine AD

VbScript pour lister les users d'un domaine Active Directory

Option Explicit

Dim MyDistinguishedName
Dim objRootDSE, objItem, objConnection, objCommand, objRecordSet
Dim strContainer, strname
Dim intCounter

strContainer = "" 'Si vous souhaitez vous connecter à une OU en particulié, indiquez la ici

Const ADS_UF_ACCOUNTDISABLE = 2 
Const ADS_SCOPE_SUBTREE = 2

On Error Resume Next
Set objRootDSE = GetObject("LDAP://rootDSE")
If strContainer = "" Then
  Set objItem = GetObject("LDAP://" & objRootDSE.Get("defaultNamingContext"))
Else
  Set objItem = GetObject("LDAP://" & strContainer & "," & _
    objRootDSE.Get("defaultNamingContext"))
End If
On Error Goto 0

'strname = objItem.Get("name")
'WScript.Echo "name: " & strname

MyDistinguishedName = objItem.Get("distinguishedName") 'Récupération du distinguishedName du domaine par défaut. Exemple DC=Cotonso,DC=Com
'WScript.Echo "distinguishedName: " & MyDistinguishedName

Set objConnection = CreateObject("ADODB.Connection") 
objConnection.Open "Provider=ADsDSOObject;" 
Set objCommand = CreateObject("ADODB.Command") 
objCommand.ActiveConnection = objConnection 
objCommand.CommandText = "<LDAP://" & MyDistinguishedName & ">;(objectCategory=User);name,cn,displayName,sn,sAMAccountName,distinguishedName;subtree"


objCommand.Properties("Page Size") = 10000
objCommand.Properties("Timeout") = 30
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.Properties("Cache Results") = False

Set objRecordSet = objCommand.Execute 
intCounter = 0 
Do Until objRecordset.EOF 
	'WScript.echo objRecordset.Fields("distinguishedName")
	WScript.echo "Name : " & VbTab & objRecordset.Fields("Name")
	WScript.echo VbTab & "cn : " & VbTab & objRecordset.Fields("cn")
	WScript.echo VbTab & "displayName : " & VbTab & objRecordset.Fields("displayName")
	WScript.echo VbTab & "sn : " & VbTab & objRecordset.Fields("sn")
	WScript.echo VbTab & "sAMAccountName : " & VbTab & objRecordset.Fields("sAMAccountName")
	WScript.echo VbTab & "distinguishedName : " & VbTab & objRecordset.Fields("distinguishedName")
    objRecordset.MoveNext 
Loop 
objConnection.Close
Lien vers le fichier : cliquez ici

Version où les résultats sont présentés sous forme de tableau.
Un champs supplémentaire, lastLogonTimeStamp, est ajouté. Il a surtout la particularité d'être une date dans un format qu'il est nécessaire de convertir au préalable. A ce sujet, pour le traiter convenablement il faudrait prendre en compte le timezone en allant en premier lieu lire une clé de registre HKLM\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias mais après test je n'y arrive pas. Attention donc à un éventuel décalage de 2H par exemple dans le résultat affiché.

Option Explicit

Dim MaLigne, NouvelleValeur
Dim MyDistinguishedName
Dim objRootDSE, objItem, objConnection, objCommand, objRecordSet
Dim objShell
Dim strContainer, strname
Dim intCounter
Dim objDate, LastLogonDate, lngHigh, lngLow, lngBiasKey, lngBias
	
strContainer = "" 'Si vous souhaitez vous connecter à une OU en particulié, indiquez la ici

Const ADS_UF_ACCOUNTDISABLE = 2 
Const ADS_SCOPE_SUBTREE = 2


On Error Resume Next
Set objRootDSE = GetObject("LDAP://rootDSE")
If strContainer = "" Then
  Set objItem = GetObject("LDAP://" & objRootDSE.Get("defaultNamingContext"))
Else
  Set objItem = GetObject("LDAP://" & strContainer & "," & _
    objRootDSE.Get("defaultNamingContext"))
End If
On Error Goto 0

'strname = objItem.Get("name")
'WScript.Echo "name: " & strname

MyDistinguishedName = objItem.Get("distinguishedName") 'Récupération du distinguishedName du domaine par défaut. Exemple DC=Cotonso,DC=Com
'WScript.Echo "distinguishedName: " & MyDistinguishedName

Set objConnection = CreateObject("ADODB.Connection") 
objConnection.Open "Provider=ADsDSOObject;" 
Set objCommand = CreateObject("ADODB.Command") 
objCommand.ActiveConnection = objConnection 
objCommand.CommandText = "<LDAP://" & MyDistinguishedName & ">;(objectCategory=User);name,cn,displayName,sn,mail,mailNickname,sAMAccountName,distinguishedName,lastLogon;subtree"


objCommand.Properties("Page Size") = 10000
objCommand.Properties("Timeout") = 30
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.Properties("Cache Results") = False

Set objRecordSet = objCommand.Execute 

'Affichage des entêtes
MaLigne = "Name" & VbTab & "cn" & VbTab & "displayName" & VbTab & "sn" & VbTab & "mail" & VbTab & "mailNickname" & VbTab & "sAMAccountName" & VbTab & "distinguishedName" & VbTab & "lastLogon"
Wscript.Echo MaLigne

intCounter = 0 
Do Until objRecordset.EOF 

	MaLigne = ""
	
	'Traitement des champs que l'on peut lire directement
	MaLigne = objRecordset.Fields("Name") & VbTab & objRecordset.Fields("cn") & VbTab & objRecordset.Fields("displayName") & VbTab & objRecordset.Fields("sn") & VbTab & objRecordset.Fields("mail") & VbTab & objRecordset.Fields("mailNickname") & VbTab & objRecordset.Fields("sAMAccountName") & VbTab & objRecordset.Fields("distinguishedName")
	
	'Ajout des champs qui demandent un traitement
	NouvelleValeur = ""
    ' Convert Integer8 value to date/time in current time zone.
    On Error Resume Next
    Set objDate = objRecordset.Fields("lastLogon").Value
	NouvelleValeur = "Never"
    If (Err.Number <> 0) Then
        On Error GoTo 0
        LastLogonDate = #1/1/1601#
    Else
		On Error GoTo 0
		lngHigh = objDate.HighPart
		lngLow = objDate.LowPart
		Set objDate = Nothing
		If (lngLow < 0) Then
			lngHigh = lngHigh + 1
		End If
		If (lngHigh = 0) And (lngLow = 0) Then
			LastLogonDate = #1/1/1601#
		Else
			LastLogonDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) + lngLow)/600000000 - lngBias)/1440
		End If
		NouvelleValeur = LastLogonDate
    End If
	
	'On ajouter cette nouvelle valeur à la liste des résultats
	MaLigne = MaLigne & VbTab & NouvelleValeur
	
	'Affichage
	Wscript.Echo MaLigne
	
	'On passe au prochain enregistrement
    objRecordset.MoveNext

Loop 
objConnection.Close
Lien vers le fichier : cliquez ici

Version où les résultats sont écrits dans un fichier type csv
Des champs supplémentaires sont présents :
lastLogonTimeStamp, pwdLastSet, AccountDisabled

lastLogonTimeStamp et pwdLastSet on la particularité d'être une date qu'il faut manipuler pour l'adapter au "time zone bias" cad au décalage GMT j'imagine. Sans sa prise en compte on se retrouve avec un décalage d'une ou deux heures dans le résultat.

Pour AccountDisabled il faut d'abord lire le champ userAccountControl puis appliquer un masque logique pour obtenir le résultat.

Option Explicit

Dim objFSO, objTextFile
Dim NomFichier, CheminFichier, CheminScriptActuel, ScriptFileName, Position
Dim MaLigne, NouvelleValeur
Dim MyDistinguishedName
Dim objRootDSE, objItem, objConnection, objCommand, objRecordSet
Dim objShell
Dim strContainer, strname
Dim intCounter
Dim objDate, LastLogonDate, varPwdLastSet, lngHigh, lngLow, lngBiasKey, lngBias
Dim lngFlag, blnPwdExpire, varAccountDisabled
	
strContainer = "" 'Si vous souhaitez vous connecter à une OU en particulié, indiquez la ici

'Déclaration des constantes
Const ForReading = 1
Const ForWritting = 2
Const ForAppending = 8

Const ADS_UF_ACCOUNTDISABLE = 2 
Const ADS_SCOPE_SUBTREE = 2
Const ADS_UF_PASSWD_CANT_CHANGE = &H40
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000


' Obtain local time zone bias from machine registry.
' This bias changes with Daylight Savings Time.
Set objShell = CreateObject("Wscript.Shell")
lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias")
If (UCase(TypeName(lngBiasKey)) = "LONG") Then
	lngBias = lngBiasKey
ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
	lngBias = 0
	For k = 0 To UBound(lngBiasKey)
		lngBias = lngBias + (lngBiasKey(k) * 256^k)
	Next
End If


ScriptFileName = wscript.scriptname
Position = InstrRev(ScriptFileName,".")
if (Position > 0) Then ScriptFileName = Left(ScriptFileName, Position - 1)

NomFichier = ScriptFileName & "_Log.txt"

CheminScriptActuel = Left(wscript.scriptfullname,Len(wscript.scriptfullname)-Len(wscript.scriptname)-1)
CheminFichier = CheminScriptActuel & "\" & NomFichier 'Déclaration du chemin et du nom du fichier
'CheminFichier = Trim(InputBox("Entrez le chemin complet du fichier","Chemin complet du fichier",CheminFichier)) 'Validation du chemin et du nom du fichier

If Len(CheminFichier) > 0 Then
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objTextFile = objFSO.OpenTextFile(CheminFichier, ForWritting, True)

	On Error Resume Next
	Set objRootDSE = GetObject("LDAP://rootDSE")
	If strContainer = "" Then
	  Set objItem = GetObject("LDAP://" & objRootDSE.Get("defaultNamingContext"))
	Else
	  Set objItem = GetObject("LDAP://" & strContainer & "," & _
		objRootDSE.Get("defaultNamingContext"))
	End If
	On Error Goto 0

	'strname = objItem.Get("name")
	'WScript.Echo "name: " & strname

	MyDistinguishedName = objItem.Get("distinguishedName") 'Récupération du distinguishedName du domaine par défaut. Exemple DC=Cotonso,DC=Com
	'WScript.Echo "distinguishedName: " & MyDistinguishedName

	Set objConnection = CreateObject("ADODB.Connection") 
	objConnection.Open "Provider=ADsDSOObject;" 
	Set objCommand = CreateObject("ADODB.Command") 
	objCommand.ActiveConnection = objConnection
	
	'Attention : si vous avez une erreur numéro 80004005, alors il est possible que vous n'avez pas assez de droits ou que vous interrogez un champ qui n'existe pas comme mail et mailNickname qui nécessitent qu'exchange soit installé
	'objCommand.CommandText = "<LDAP://" & MyDistinguishedName & ">;(objectCategory=User);name,cn,displayName,sn,mail,mailNickname,sAMAccountName,distinguishedName,lastLogon,pwdLastSet,userAccountControl;subtree"
	objCommand.CommandText = "<LDAP://" & MyDistinguishedName & ">;(objectCategory=User);name,cn,displayName,sn,sAMAccountName,distinguishedName,lastLogon,pwdLastSet,userAccountControl;subtree"
	'objTextFile.WriteLine(objCommand.CommandText)

	objCommand.Properties("Page Size") = 10000
	objCommand.Properties("Timeout") = 30
	objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
	objCommand.Properties("Cache Results") = False

	Set objRecordSet = objCommand.Execute 

	'Affichage des entêtes
	MaLigne = "Name" & VbTab & "cn" & VbTab & "displayName" & VbTab & "sn" & VbTab & "sAMAccountName" & VbTab & "distinguishedName" & VbTab & "lastLogon" & VbTab & "pwdLastSet" & VbTab & "AccountDisabled"
	objTextFile.WriteLine(MaLigne)
	
	intCounter = 0 
	Do Until objRecordset.EOF 

		MaLigne = ""
		
		'Traitement des champs que l'on peut lire directement
		MaLigne = objRecordset.Fields("Name") & VbTab & objRecordset.Fields("cn") & VbTab & objRecordset.Fields("displayName") & VbTab & objRecordset.Fields("sn") & VbTab & objRecordset.Fields("sAMAccountName") & VbTab & objRecordset.Fields("distinguishedName")
		
		'Ajout des champs qui demandent un traitement
		'Traitement du lastLogon
		LastLogonDate = ""
		' The lastLogon attribute should always have a value assigned,
		' but other Integer8 attributes representing dates could be "Null".
		If (TypeName(objRecordset.Fields("lastLogon").Value) = "Object") Then
			Set objDate = objRecordset.Fields("lastLogon").Value
			LastLogonDate = Integer8Date(objDate, lngBias)
		Else
			LastLogonDate = #1/1/1601#
		End If
		
		varPwdLastSet = ""
		If (TypeName(objRecordset.Fields("pwdLastSet").Value) = "Object") Then
			Set objDate = objRecordset.Fields("pwdLastSet").Value
			varPwdLastSet = Integer8Date(objDate, lngBias)
		Else
			varPwdLastSet = #1/1/1601#
		End If
		
		'dtmPwdExpDate = DateAdd("d", NouvelleValeur, intMaxPwdAge)
		'DelayBeforeExpiration = DateDiff("d", Now , dtmPwdExpDate)
		
		'On ajoute cette nouvelle valeur à la liste des résultats
		MaLigne = MaLigne & VbTab & LastLogonDate & VbTab & varPwdLastSet

		'Traitement du AccountDisabled
		lngFlag = objRecordset.Fields("userAccountControl").Value
		blnPwdExpire = True 'Valeur par défaut

		If ((lngFlag And ADS_UF_PASSWD_CANT_CHANGE) <> 0) Then
			blnPwdExpire = False
		End If

		If ((lngFlag And ADS_UF_DONT_EXPIRE_PASSWD) <> 0) Then
			blnPwdExpire = False
		End If
		
		varAccountDisabled = 0 'Valeur par défaut
		If ((lngFlag And ADS_UF_ACCOUNTDISABLE) <> 0) Then varAccountDisabled = 1 'Si le bit correspondant est à 1, alors cela signifie que le compte est désactivé

		'On ajoute cette nouvelle valeur à la liste des résultats
		MaLigne = MaLigne & VbTab & varAccountDisabled
		
		'Affichage
		objTextFile.WriteLine(MaLigne)
		
		'On passe au prochain enregistrement
		objRecordset.MoveNext

	Loop 
	objConnection.Close
	
	objTextFile.Close 'Fermeture du fichier

	Set objTextFile = Nothing
	Set objFSO = Nothing
Else
	Wscript.echo "Operation annulee"
End If 'CheminFichier

Function Integer8Date(ByVal objDate, ByVal lngBias)

	' Function to convert Integer8 (64-bit) value to a date, adjusted for
	' local time zone bias.

	Dim lngAdjust, lngDate, lngHigh, lngLow
	lngAdjust = lngBias
	lngHigh = objDate.HighPart
	lngLow = objdate.LowPart

	' Account for error in IADsLargeInteger property methods.
	If (lngLow < 0) Then
		lngHigh = lngHigh + 1
	End If
	If (lngHigh = 0) And (lngLow = 0) Then
		lngAdjust = 0
	End If
	
	lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) + lngLow) / 600000000 - lngAdjust) / 1440
	' Trap error if lngDate is ridiculously huge.
	On Error Resume Next
	Integer8Date = CDate(lngDate)
	If (Err.Number <> 0) Then
		On Error GoTo 0
		Integer8Date = #1/1/1601#
	End If

	On Error GoTo 0

End Function
Lien vers le fichier : cliquez ici

Pages Web

Site WebDescription
Post http://community.spiceworks.comArticle expliquant comment interpréter la valeur du champ lastLogonTimeStamp