Main Page / Index

Password Expiring Notification

First, the batch file that is called by windows scheduler daily and in turn calls the vbscript.
Second, the vbscript works it's magic. These notices have cut our password reset call in half!

A log file is created that contains all usernames, days since last pw change, and the date of the change. It also tells you when it sent out a notice. I have a copy of each notice sent to my email to make sure everything is working right. I wish I could find who I got this from, it looks like Richard L. Mueller's work, THANK YOU! I did spend several days modifying it to get it working in my domain (AD 2003, Exchange 2003) I left some of the original code commented out. Things you need to change are in red. Be sure to run these scripts from an always on machine under a non-expiring account. Notices are sent out at 9 days til, 6 days and 3,2,1.

PWexpirenotice.bat

for /f "tokens=2-4 delims=/ " %%a in ('date /T') do set year=%%c
for /f "tokens=2-4 delims=/ " %%a in ('date /T') do set month=%%a
for /f "tokens=2-4 delims=/ " %%a in ('date /T') do set day=%%b
set TODAY=%month%-%day%-%year%
echo **************************************************** >> PasswordLogs\Password.expiryCSV-%TODAY%.txt
date /t >> PasswordLogs\Password.expiryCSV-%TODAY%.txt
cscript PasswordExpireNotificationCSV.vbs >> PasswordLogs\Password.expiryCSV-%TODAY%.txt

PasswordExpireNotificationCSV.vbs 

Option Explicit

Dim objCommand, objConnection, objChild, objUserConnection, strBase, strFilter, strAttributes, strPasswordChangeDate, intPassAge
Dim lngTZBias, objPwdLastSet, strEmailAddress, objMessage
Dim objShell, lngBiasKey, k, PasswordExpiry, strRootDomain
Dim strQuery, objRecordset, strName, strCN, strFN, strLN

' ********************* CHANGE THESE VALUES TO PASSWORD EXPIRY AND ROOT OF WHERE USERS WILL BE SEARCHED 

PasswordExpiry=90
strRootDomain="DC=your,DC=domain,DC=here"

' 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
  lngTZBias = lngBiasKey
ElseIf UCase(TypeName(lngBiasKey)) = "VARIANT()" Then
  lngTZBias = 0
  For k = 0 To UBound(lngBiasKey)
    lngTZBias = lngTZBias + (lngBiasKey(k) * 256^k)
  Next
End If

Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection
strBase = "<LDAP://" & strRootDomain & ">"
 
' ********************* USER FILTERING LIKE DISABLE ACCOUNTS ***********************************

strFilter = "(&(objectCategory=person)(objectClass=user))"
'strFilter = "(&(objectCategory=person)(objectClass=user)(!userAccountControl:1.2.840.113556.1.4.803:=65536))"
'strFilter = ((objectCategory=person)(objectClass=user)(userAccountControl1.2.840.113556.1.4.803:=2)(!userAccountControl:1.2.840.113556.1.4.803:=65536))"

strAttributes = "sAMAccountName,distinguishedName,mail,pwdLastSet,cn,givenName,sn"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 100
objCommand.Properties("Timeout") = 30
objCommand.Properties("Cache Results") = False
Set objRecordSet = objCommand.Execute

WScript.echo "Running at " & Date()

Do Until objRecordSet.EOF
  strName = objRecordSet.Fields("sAMAccountName").Value
  strCN = objRecordSet.Fields("cn").value
  strFN = objRecordSet.Fields("givenName").value
  strLN = objRecordSet.Fields("sn").value
'  strEmailAddress = objRecordSet.Fields("mail").value
  strEmailAddress = strName & "@yourdomain.com"
 
  Set objUserConnection = GetObject("LDAP://" & Replace(objRecordSet.Fields("distinguishedName").Value, "/", "\/"))
  Set objPwdLastSet = objUserConnection.pwdLastSet
  strPasswordChangeDate = Integer8Date(objPwdLastSet, lngTZBias)
'  WScript.Echo vbTab & "Password last changed at " & strPasswordChangeDate
  intPassAge = DateDiff("d", strPasswordChangeDate, Now)
'  WScript.Echo vbTab & "Password changed " & intPassAge & " days ago"
  Wscript.Echo strName & ", " & vbTab & intPassAge & ", " & vbTab & strPasswordChangeDate

' ********************* DAYS CONFIGURATION FOR SCANNING ***********************************

  If intPassAge = (PasswordExpiry-1) Then
    WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 1 days"
    Call SendEmailMessage(strEmailAddress, 1)
  ElseIf intPassAge = (PasswordExpiry-2) Then
    WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 2 days"
    Call SendEmailMessage(strEmailAddress, 2)
  ElseIf intPassAge = (PasswordExpiry-3) Then
    WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 3 days"
    Call SendEmailMessage(strEmailAddress, 3)
  ElseIf intPassAge = (PasswordExpiry-6) Then
    WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 6 days"
    Call SendEmailMessage(strEmailAddress, 6)
  ElseIf intPassAge = (PasswordExpiry-9) Then
    WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 9 days"
    Call SendEmailMessage(strEmailAddress, 9)
  End If
'    WScript.Echo "------------------------------------------------------"

  objRecordSet.MoveNext
Loop

objConnection.Close

Function Integer8Date(objDate, 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 overly large
  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

' ********************* EMAIL CONFIGURATION DETAILS ***********************************

Sub SendEmailMessage(strDestEmail, strNoOfDays)
  Set objMessage = CreateObject("CDO.Message")
  objMessage.Subject = "Your Password for Your Domain expires in " & strNoOfDays & " days"
  objMessage.Sender = "sender@address.com"
  objMessage.From = "sender@address.com"
  objMessage.To = strDestEmail
  objMessage.cc = "yourname@address.com" 'I have a copy of each notice sent to myself, make sure it's still working
' You will probably want to modify the following outgoing message 
  objMessage.HTMLBody = "<html> <head><style>div {font-family: tahoma,verdana,arial;font-size: 11px;color: #38465A;}td {font-family: tahoma,verdana,arial;font-size: 11px;color: #38465A;}a {color: #38465A;}.dt {background-color:#DDE1E8;color: #556988;font-weight: bold;padding-left: 4px;}.dt1 {background-color: #F1F3F6;}.dt2 {background-color: #F8F9FA;}</style><div> </head> <Body> " & strFN &" " & strLN &",<BR> <BR> Your password for the domain ID, <B> " & strName & " </B>, is going to expire in <B> " & strNoOfDays & " </B>days. The last time you have changed your password was on <B> " & strPasswordChangeDate & "</B>. Please change the login password as soon as possible to prevent further logon problems.<BR>  <BR> If you connect directly to the network, please use 'Ctrl-Alt-Del' and choose Change Password. <br> <a href=https://yourOWAserver/iisadmpwd/aexp2b.asp> If you use only OWA, you can use this link </a> - You can leave Domain blank and in Account enter yourdomain\YourUserName <BR> <BR> Thank you!<BR> <BR> This is an automatically generated message. </Body> </html>"

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

 
' ********************* 'Name or IP of Remote SMTP Server ***********************************
 
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "YOUR-MAIL-SERVER"

'Server port (typically 25)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

objMessage.Configuration.Fields.Update

  objMessage.Send
  Set objMessage = nothing
End Sub




Document made with Nvu