如何生成并导出密码已过期用户列表报告

function foo
Dim adoCommand, adoConnection, strBase, strFilter, strAttributes
Dim objRootDSE, strDNSDomain, strQuery, adoRecordset
Dim dtmDate2, strName, strEmail
Dim lngSeconds2, str64Bit2
Dim objShell, lngBiasKey, lngBias, k
Dim objDomain, objMaxPwdAge, lngHighAge, lngLowAge, sngMaxPwdAge
Dim objDate, dtmPwdLastSet, dtmExpires
Dim strItem, strPrefix, objFSO, objLogFile
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objLogFile = objFSO.CreateTextFile("C:\Scripts\PasswordExp.csv", ForWriting, True)
objLogFile.Write "sAMAccountName,"
objLogFile.Write "mail,"
objLogFile.Write "passwordExpiresAt"
objLogFile.Writeline
' Determine domain maximum password age policy in days.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("DefaultNamingContext")
Set objDomain = GetObject("LDAP://" & strDNSDomain)
Set objMaxPwdAge = objDomain.MaxPwdAge
lngHighAge = objMaxPwdAge.HighPart
lngLowAge = objMaxPwdAge.LowPart
If (lngLowAge < 0) Then
lngHighAge = lngHighAge + 1
End If
' Convert from 100-nanosecond intervals into days.
sngMaxPwdAge = -((lngHighAge * 2^32) _
+ lngLowAge)/(600000000 * 1440)
dtmDate2 = DateAdd("d", - sngMaxPwdAge, Now())
' 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
dtmDate2 = DateAdd("n", lngBias, dtmDate2)
lngSeconds2 = DateDiff("s", #1/1/1601#, dtmDate2)
str64Bit2 = CStr(lngSeconds2) & "0000000"
' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Search entire Active Directory domain.
strBase = ""
' 
'
strFilter = "(&(objectCategory=person)(objectClass=user)" _
& "(!pwdLastSet=0)" _
& "(pwdLastSet<=" & str64Bit2 & ")" _
& "(!userAccountControl:1.2.840.113556.1.4.803:=2)" _
& "(!userAccountControl:1.2.840.113556.1.4.803:=65536)" _
& "(!userAccountControl:1.2.840.113556.1.4.803:=32)" _
& "(!userAccountControl:1.2.840.113556.1.4.803:=48))"
' Comma delimited list of attribute values to retrieve.
strAttributes = "sAMAccountName,mail,pwdLastSet"
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
'Filter on user objects where the password expires between the
dates specified, the account is not disabled, password never
expires is not set, password not required is not set,
and password cannot change is not set.'
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
' Enumerate the resulting recordset.
Do Until adoRecordset.EOF
strName = adoRecordset.Fields("sAMAccountName").Value
strEmail = adoRecordset.Fields("mail").Value & ""
If (TypeName(adoRecordset.Fields("pwdLastSet").Value) = "Object") Then
Set objDate = adoRecordset.Fields("pwdLastSet").Value
dtmPwdLastSet = Integer8Date(objDate, lngBias)
Else
dtmPwdLastSet = #1/1/1601#
End If
dtmExpires = DateAdd("d", sngMaxPwdAge, dtmPwdLastSet)
objLogFile.Write strName & ","
objLogFile.Write strEmail & ","
objLogFile.Write dtmExpires
objLogFile.Writeline
adoRecordset.MoveNext
Loop
' Clean up.
objLogFile.Close
adoRecordset.Close
adoConnection.Close
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