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 = ";(objectCategory=User);name,cn,displayName,sn,mail,mailNickname,sAMAccountName,distinguishedName,lastLogon,pwdLastSet,userAccountControl;subtree" objCommand.CommandText = ";(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