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 110 111 112 113 114 115 116 117 118
| '========================
'Option Explicit
Dim dtmAdjusted, lngSeconds, str64Bit, dtmDateValue
Dim objShell, lngBiasKey, lngBias, k
Dim objRootDSE, strDNSDomain, objConnection, objRecordset
Dim strBase, strFilter, strAttributes, strQuery, strDN, strFileName
dtmDateValue = #02/11/2008#
' Obtain local Time Zone bias from machine registry.
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
' Convert current date/time value to UTC.
dtmAdjusted = DateAdd("n", lngBias, dtmDateValue)
' Find number of seconds since 1/1/1601.
lngSeconds = DateDiff("s", #1/1/1601#, dtmAdjusted)
' Convert the number of seconds to a string
' and convert to 100-nanosecond intervals.
str64Bit = CStr(lngSeconds) & "0000000"
' Determine DNS domain name.
Set objRootDSE = GetObject("LDAP://rootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
' Use ADO to search Active Directory.
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objRecordset = CreateObject("ADODB.Recordset")
objRecordset.ActiveConnection = objConnection
' cherche domaine.
strBase = "<LDAP://" & strDNSDomain & ">"
' Filtre expiration de compte.
strFilter = "(& (objectCategory=person)(objectClass=user)" _
& "(accountExpires<=" & str64Bit & ")(!accountExpires=0))"
'--- search for object in AD ---
On Error Resume Next
Set objUser = GetObject _
("LDAP://rootDSE")
dtmAccountExpiration = objUser.AccountExpiration
If Err.Number = -2147467259 Or dtmAccountExpiration = #1/1/1601# Then
'WScript.Echo "No account expiration date specified"
Else
'WScript.Echo "Account expiration date: " & objUser.AccountExpiration -1
End If
' Retrieve Distinguished Names.
strAttributes = "distinguishedName,department,name,displayName,dtmaccountExpiration"',accountexpires"
' Use ADO to query AD.
strQuery = strBase & ";" & strFilter & ";" & objectClass & "," & strAttributes & ";subtree"
objRecordset.Source = strQuery
objRecordset.Open
'Declaration des constantes pour gérer les fichiers resultats et sauvegardes
Repsource ="d:\"
RepDest ="d:\essai\"
filename ="test.txt"
'Verification de l'existance du fichier
Set fso = CreateObject("Scripting.FilesystemObject")
If (fso.fileExists (filename)) Then
'Sauvegarde du fichier tous les jours
fso.Copyfile filename, RepDest
Set f = fso.OpenTextFile (filename,2)
Else
Set f = fso.CreateTextFile(filename)
End If
' Enumerate expired user accounts.
Do Until objRecordSet.EOF
strDN = objRecordSet.Fields("distinguishedName")
StrDP = objRecordset.Fields("department")
STRNA = objRecordset.Fields("name")
strDD = objRecordset.Fields("displayName")
strAE = objrecordset.fields("dtmAccountExpiration")
'STREX = objRecordset.Fields("AccountExpires")
'WScript.Echo strDp
f.write strdp & ";" & strna & ";" & strDD & ";" & strAE & ";" & strdn & vbCrLf '";" & strex &
objRecordSet.MoveNext
Loop
f.close
MsgBox "Fin"
' Clean up.
objRecordset.Close
objConnection.Close
Set objRootDSE = Nothing
Set objConnection = Nothing
Set objRecordSet = Nothing |
Partager