Vista - passwords about to expire

Hi,

Has anybody a script that will list all users whose passwords are about to
expire in n days.
Then e-mails the user?

Ta

Mark.

Mark wrote:
This script assumes that the mail attribute of the user object is the
correct email address to use. It also assumes you have CDO installed:
==============
' VBScript program to find all user accounts where the password
' is about to expire.

Option Explicit

Dim adoCommand, adoConnection, strBase, strFilter, strAttributes
Dim objRootDSE, strDNSDomain, strQuery, adoRecordset
Dim dtmDate1, dtmDate2, intDays, strName, strEmail
Dim lngSeconds1, str64Bit1, lngSeconds2, str64Bit2
Dim objShell, lngBiasKey, lngBias, k
Dim objDomain, objMaxPwdAge, lngHighAge, lngLowAge, sngMaxPwdAge
Dim objDate, dtmPwdLastSet, dtmExpires

' Specify number of days. Any users whose password expires within
' this many days of today will be listed.
intDays = 10

' 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

' Account for bug in IADslargeInteger property methods.
lngHighAge = objMaxPwdAge.HighPart
lngLowAge = objMaxPwdAge.LowPart
If (lngLowAge < 0) Then
lngHighAge = lngHighAge + 1
End If
sngMaxPwdAge = -((lngHighAge * 2^32) _
+ lngLowAge)/(600000000 * 1440)

' Determine the password last changed date such that the password
' would just now be expired.
dtmDate1 = DateAdd("d", - sngMaxPwdAge, Now())

' Determine the password last changed date such that the password
' will expire intDays in the future.
dtmDate2 = DateAdd("d", intDays - sngMaxPwdAge, Now())

' 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 the datetime values to UTC.
dtmDate1 = DateAdd("n", lngBias, dtmDate1)
dtmDate2 = DateAdd("n", lngBias, dtmDate2)

' Find number of seconds since 1/1/1601 for these dates.
lngSeconds1 = DateDiff("s", #1/1/1601#, dtmDate1)
lngSeconds2 = DateDiff("s", #1/1/1601#, dtmDate2)

' Convert the number of seconds to a string
' and convert to 100-nanosecond intervals.
str64Bit1 = CStr(lngSeconds1) & "0000000"
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"
adoCommand.ActiveConnection = adoConnection

' Search entire Active Directory domain.
strBase = "<LDAP://" & strDNSDomain & ">"

' Filter on user objects where password expires in near future,
' account is not disabled, password never expires is not set,
' password not required is not set, and password cannot
' change is not set.
strFilter = "(&(objectCategory=person)(objectClass=user)" _
& "(pwdLastSet>=" & str64Bit1 & ")" _
& "(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
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
' Retrieve values.
strName = adoRecordset.Fields("sAMAccountName").Value
strEmail = adoRecordset.Fields("mail").Value & ""
' Determine when password expires.
Set objDate = adoRecordset.Fields("pwdLastSet").Value
dtmPwdLastSet = Integer8Date(objDate, lngBias)
dtmExpires = DateAdd("d", sngMaxPwdAge, dtmPwdLastSet)
Call SendEmailMessage(strEmail, strName, dtmExpires)
Wscript.Echo "Message for " & strName & " sent to " & strEmail
' Move to the next record in the recordset.
adoRecordset.MoveNext
Loop

' Clean up.
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

Sub SendEmailMessage(ByVal strDestEmail, ByVal strNTName, ByVal dtmDate)
' Send email message.
Dim objMessage

If (strDestEmail = "") Then
Exit Sub
End If

Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Password Will Expire"
objMessage.Sender = "jimsmith@newsgroup"
objMessage.To = strDestEmail
objMessage.TextBody = "The password for account " & strNTName _
& " will expire " & CStr(dtmDate)
objMessage.Send
End Sub

--
Richard Mueller
MVP Directory Services
Hilltop Lab - http://www.rlmueller.net
--

Many thanks


"<snip>