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
'
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
'
********************* 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
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>"
