RE: PEWA
I use a vbs-script that runs every night.
It's a modified script from John Savill (=vbs guru).
The sending of the email part is not action here (').
Put in the name of your root-domain and test carefully.
It will create txt-files and you can check there if the script works
correctly.
' pwchangemail.vbs
' Runs check on last password change date
' Will send email to user when password expires within 5 days.
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
Dim FSO, logfile, Messagelog
Set FSO = Createobject("Scripting.FileSystemObject")
' ********************* CHANGE THESE VALUES TO PASSWORD EXPIRY AND ROOT OF
WHERE USERS WILL BE SEARCHED
***********************************
PasswordExpiry=42
strRootDomain="dc=domain,dc=com"
'
***************************************************************************************************************
**************************
' 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 & ">"
strFilter =
"(&(objectCategory=person)(objectClass=user)(!userAccountControl:1.2.840.113556.1.4.803:=2)(!userAccountControl
:1.2.840.113556.1.4.803:=65536))"
strAttributes = "sAMAccountName,cn,mail,pwdLastSet,distinguishedName"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 30
objCommand.Properties("Cache Results") = False
Set objRecordSet = objCommand.Execute
WScript.echo "Running at " & Date()
'Write to LogFile:
If (FSO.FileExists("pwexpire.txt")) Then
Set Logfile = FSO.OpenTextFile("pwexpire.txt", 8)
Else
Set Logfile = FSO.OpenTextFile("pwexpire.txt", 2, "True")
End If
MessageLog = Date()
Logfile.WriteLine Messagelog
Logfile.Close
Do Until objRecordSet.EOF
On error resume next
strName = objRecordSet.Fields("sAMAccountName").Value
strCN = objRecordSet.Fields("cn").value
strEmailAddress = objRecordSet.Fields("mail").value
Wscript.Echo "NT Name: " & strName & ", Common Name: " & strCN
Set objUserConnection = GetObject("LDAP://" &
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)
'Write to LogFile:
If (FSO.FileExists("allusers.txt")) Then
Set Logfile = FSO.OpenTextFile("allusers.txt", 8)
Else
Set Logfile = FSO.OpenTextFile("allusers.txt", 2, "True")
End If
MessageLog = strName & " => Password last changed at " &
strPasswordChangeDate
Logfile.WriteLine Messagelog
Logfile.Close
WScript.Echo vbTab & "Password changed " & intPassAge & " days ago"
If intPassAge = (PasswordExpiry-1) Then
WScript.echo vbTab & "Sending user notification to " & strEmailAddress &
" that password expires in 1 day"
'Write to LogFile:
If (FSO.FileExists("pwexpire.txt")) Then
Set Logfile = FSO.OpenTextFile("pwexpire.txt", 8)
Else
Set Logfile = FSO.OpenTextFile("pwexpire.txt", 2, "True")
End If
MessageLog = strName & " => password expires in 1 day, email send to
user!"
Logfile.WriteLine Messagelog
Logfile.Close
Call SendEmailMessage(strEmailAddress, 5)
ElseIf intPassAge = (PasswordExpiry-3) Then
WScript.echo vbTab & "Sending user notification to " & strEmailAddress &
" that password expires in 3 days"
'Write to LogFile:
If (FSO.FileExists("pwexpire.txt")) Then
Set Logfile = FSO.OpenTextFile("pwexpire.txt", 8)
Else
Set Logfile = FSO.OpenTextFile("pwexpire.txt", 2, "True")
End If
MessageLog = strName & " => password expires in 3 days, email send to
user!"
Logfile.WriteLine Messagelog
Logfile.Close
Call SendEmailMessage(strEmailAddress, 6)
ElseIf intPassAge = (PasswordExpiry-5) Then
WScript.echo vbTab & "Sending user notification to " & strEmailAddress &
" that password expires in 5 days"
'Write to LogFile:
If (FSO.FileExists("pwexpire.txt")) Then
Set Logfile = FSO.OpenTextFile("pwexpire.txt", 8)
Else
Set Logfile = FSO.OpenTextFile("pwexpire.txt", 2, "True")
End If
MessageLog = strName & " => password expires in 5 days, email send to
user!"
Logfile.WriteLine Messagelog
Logfile.Close
Call SendEmailMessage(strEmailAddress, 9)
End If
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 = "Password Expires in " & strNoOfDays & " days"
' objMessage.Sender = "helpdesk@domain.com"
' objMessage.To = strDestEmail
' objMessage.TextBody = "Your login password expires in " & strNoOfDays & "
days. Please change it now"
' objMessage.Send
End Sub
--
Regards,
Rene Frenger
MCITP E2K7
MCP EX5.5, 2000, 2003
MCSE
"SAFairfax" wrote:
> Hi,
>
> I am looking for Exchange PEWA tool that has the capaility to send email
> notification to users before their password expire. I was told that the tool
> is available in Exchange 2000 Resource kit but not Exchange 2003 Resource
> Kit. I am having hard time locating tools. Does anyone know where to find
> it or other similar tools?
>
> Thanks!
date: Fri, 15 Feb 2008 06:14:04 -0800
author: Rene Frenger
