Getting to grips with password expirations!

Filed Under (Windows Networking) by Just An Admin on 14-05-2008

Every two months user start calling or e-mailing the helpdesk to request a reset of their Active Directory account. Because a lot of users work at customer locations, they miss the warning about their expiring account. A former collegue brought the following script to my attention, which automaticly sends users a warning message when their password is about to expire. Allthough nearly perfect, some little adjustements have been made:



  • Message are now personlized. Script retreives user name. Mail starts with “Dear XXXXX,”
  • Account name is displayed in the message body, in case user account name differs from real name.
  • CC mail option added so a CC can be send to helpdesk/supportdesk
  • Mail is also send when password is expired, incase user has active session during expiration.
  • Additional logging for users who’s password allready expires and received a mail (prevent spamming of expired account)

[cc width=”600″ lang=”vb”]
———————— Code ——————————


‘ exch-pwd-expires2.vbs

‘ Original by Michael B. Smith
‘ March 21, 2005

‘ Changes by just another admin (www.jadota.com)

‘ This program scans the AD for accounts with expiring passwords.

‘ An email is sent, using CDO, via the SMTP server specified as SMTP_SERVER to the
‘ user to tell them to change their password.

‘ You will, at a minimum, need to change the SMTP_SERVER, the HOSTING_OU, and the
‘ STRFROM constants. If you run this on an Exchange server, then SMTP_SERVER can
‘ be “127.0.0.1” – and it may be either an ip address or a resolvable name.


Option Explicit
‘ Per environment constants – you should change these!
Const SMTP_SERVER = “127.0.0.1”
Const CC_MAIL = “helpdesk@mydomain.com”
Const STRFROM = “support@mydomain.com”
Const DAYS_FOR_EMAIL = 7

‘ System Constants – do not change
Const ONE_HUNDRED_NANOSECOND = .000000100 ‘ .000000100 is equal to 10^-7
Const SECONDS_IN_DAY = 86400
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
Const ADS_UF_ACCOUNTDISABLE = &h02

‘ Change to “True” for extensive debugging output
Const bDebug = True

Dim objRoot
Dim numDays, iResult
Dim strDomainDN
Dim objContainer, objSub
Dim objContainer2, objSub2
Set objRoot = GetObject (“LDAP://RootDSE”)
strDomainDN = objRoot.Get (“defaultNamingContext”)
Set objRoot = Nothing
numdays = GetMaximumPasswordAge (strDomainDN)
dp “Maximum Password Age: ” & numDays
If numDays > 0 Then
Set objContainer = Nothing
Set objContainer = GetObject (“LDAP://” & strDomainDN)
For each objSub in objContainer
Call ProcessFolder (objSub, numDays)
Next
Set objContainer = Nothing
‘ End If
‘========================================
‘ Add the number of days to the last time
‘ the password was set.
‘========================================
‘whenPasswordExpires = DateAdd (“d”, numDays, oUser.PasswordLastChanged)
‘WScript.Echo “Password Last Changed: ” & oUser.PasswordLastChanged
‘WScript.Echo “Password Expires On: ” & whenPasswordExpires
End If
WScript.Echo “Done”

Function GetMaximumPasswordAge (ByVal strDomainDN)
Dim objDomain, objMaxPwdAge
Dim dblMaxPwdNano, dblMaxPwdSecs, dblMaxPwdDays
Set objDomain = GetObject(“LDAP://” & strDomainDN)
Set objMaxPWdAge = objDomain.maxPwdAge
If objMaxPwdAge.LowPart = 0 And objMaxPwdAge.Highpart = 0 Then
‘ Maximum password age is set to 0 in the domain
‘ Therefore, passwords do not expire
GetMaximumPasswordAge = 0
Else
dblMaxPwdNano = Abs (objMaxPwdAge.HighPart * 2^32 + objMaxPwdAge.LowPart)
dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND
dblMaxPwdDays = Int (dblMaxPwdSecs / SECONDS_IN_DAY)
GetMaximumPasswordAge = dblMaxPwdDays
End If
End Function

Function UserIsExpired (objUser, iMaxAge, iDaysForEmail, iRes)
Dim intUserAccountControl, dtmValue, intTimeInterval
Dim strName
On Error Resume Next
Err.Clear
strName = Mid (objUser.Name, 4)
intUserAccountControl = objUser.Get (“userAccountControl”)
If intUserAccountControl And ADS_UF_DONT_EXPIRE_PASSWD Then
dp “The password for ” & strName & ” never expires.”
UserIsExpired = False
Else
If intUserAccountControl And ADS_UF_ACCOUNTDISABLE Then
dp “the account for ” & strName & ” is disabled.”
UserIsExpired = False
iRes = 0
Else
iRes = 0
dtmValue = objUser.PasswordLastChanged
If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
UserIsExpired = False
dp “No password is set for ” & strName & “.”
Else
intTimeInterval = Int (Now – dtmValue)
dp “The password for ” & strName & ” was changed on ” & DateValue(dtmValue) & ” at ” & TimeValue(dtmValue) & ” (” & intTimeInterval & ” days ago)”
If intTimeInterval >= (iMaxAge + 3) Then
dp “The password has expired more then three days ago. No more mail warnings required.”
UserIsExpired = False
Else
If intTimeInterval >= iMaxAge Then
dp “The password for ” & strName & ” expired.”
UserIsExpired = True
Else
iRes = Int ((dtmValue + iMaxAge) – Now)
dp “The password for ” & strName & ” expires on ” & _
DateValue(dtmValue + iMaxAge) & ” (” & _
iRes & ” days from now).”
If iRes < = iDaysForEmail Then dp strName & " needs an email for password change" UserIsExpired = True Else dp strName & " does not need an email for password change" UserIsExpired = False End If End If End If End If End If End If End Function Sub ProcessFolder (objContainer, iMaxPwdAge) Dim objUser, iResult, objun ' objContainer.Filter = Array ("User") Wscript.Echo "Checking company = " & Mid (objContainer.Name, 4) For each objUser in objContainer Wscript.Echo Right (objUser.Name, 40) If objUser.Class = "user" Then If Right (objUser.Name, 1) <> “$” Then
If IsEmpty (objUser.Mail) or IsNull (objUser.Mail) Then
dp Mid (objUser.Name, 4) & ” has no mailbox”
Else
If UserIsExpired (objUser, iMaxPwdAge, DAYS_FOR_EMAIL, iResult) Then
wscript.Echo “…sending an email for ” & objUser.Mail
Call SendEmail (objUser, iResult)
Else
dp “…don’t send an email”
End If

End If
End If
End If

If objUser.Class = “organizationalUnit” or ObjUser.Class = “container” Then
Call ProcessFolder (objUser, iMaxPwdAge) ‘this is needed for scanning sub-OU’s for users (irrative)
End IF
Next
End Sub
Sub SendEmail (objUser, iResult)
Dim objMail
Set objMail = CreateObject (“CDO.Message”)
objMail.Configuration.Fields.Item (“http://schemas.microsoft.com/cdo/configuration/sendusing”) = 2
objMail.Configuration.Fields.Item (“http://schemas.microsoft.com/cdo/configuration/smtpserver”) = SMTP_SERVER
objMail.Configuration.Fields.Item (“http://schemas.microsoft.com/cdo/configuration/smtpserverport”) = 25
objMail.Configuration.Fields.Update
objMail.From = STRFROM
objMail.To = objUser.Mail
objMail.Cc = CC_MAIL
if iResult = 0 then
objMail.Subject = “The password for ” & Mid (objUser.Name, 4) & ” has expired!”
ObjMail.Textbody = “Dear ” & objUser.givenName & “,” & vbCRLF & vbCRLF & “The password for your domain account ” & objUser.userPrincipalName & ” (account ” & objUser.sAMAccountName & ” with the Contoso domain)” & vbCRLF & ” has expired. ” & vbCRLF & vbCRLF & “We advise you to change your password or contact the supportdesk for support.” & vbCRLF & vbCRLF & “With kind regards,” & vbCRLF & “Support Desk”
else
objMail.Subject = “The password for ” & Mid (objUser.Name, 4) & ” is about ot expire!”
ObjMail.Textbody = “Dear ” & objUser.givenName & “,” & vbCRLF & vbCRLF & “The password for your domain account ” & objUser.userPrincipalName & ” (account ” & objUser.sAMAccountName & ” with the Contoso domain)” & vbCRLF & “wil expire in ” & iResult & ” day(s). ” & vbCRLF & vbCRLF & “We advise you to change your password as soon as possible.” & vbCRLF & vbCRLF & “With kind regards,” & vbCRLF & “Support Desk”
End If
objMail.Send
Set objMail = Nothing
End Sub
Sub dp (str)
If bDebug Then
WScript.Echo str
End If
End Sub
[/cc]

Incoming search terms:

Comments:

(2) Comments for the first post!

Post a comment