邮件提醒AD域用户更改密码

假如域用户密码即将过期，可以用邮件提醒用户更改密码么？AD能实现么。 实际上，AD暂时来说没有这个功能，不过在TechNet上有vb script 模板实现此功能，在Exchange 2010配合Active Directory 2008 的环境下实现的。


 

脚本
 

     
     

      
      
'==========================================================================  
      
      
'Milan on 1/12/2011  
      
      
' This script can be used to notify users of when their windows passords  
      
      
' are going to expire. Especially useful in those cases where user does not logon  
      
      
' to windows with individual login and uses OWA for email  
      
      
' Script is currently running fine in a Exchange 2010 env with AD 2008  
      
      
'==========================================================================  
      
      
On Error Resume Next 
      
      
Const ADS_SCOPE_SUBTREE = 2  
      
      
Const SEC_IN_DAY = 86400  
      
      
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000 ' tocheck for accounts that have "no expire" set on the password  
      
      
 
      
      
Dim maxPwdAge  
      
      
maxpwdage = 90 'set this according to policy in your organization  
      
      
Dim numDays  
      
      
Dim warningDays  
      
      
warningDays = 14 ' set this according to policy in your organization  
      
      
 
      
      
'ADO to access Active Directory  
      
      
Set objConnection = CreateObject("ADODB.Connection")  
      
      
Set objCommand = CreateObject("ADODB.Command")  
      
      
objConnection.Provider = "ADsDSOObject" 
      
      
objConnection.Open "Active Directory Provider" 
      
      
Set objCommand.ActiveConnection = objConnection  
      
      
Set objRootDSE = GetObject("LDAP://rootDSE")  
      
      
 
      
      
DomainString = objRootDSE.Get("dnsHostName")  
      
      
 
      
      
objCommand.Properties("Page Size") = 1000  
      
      
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE  
      
      
 
      
      
objCommand.CommandText = "SELECT DisplayName,mail,DistinguishedName,sAMAccountName  FROM 'LDAP://OU=regions, DC=vsc, DC=com'" & _  
      
      
    " where objectClass='user'" 
      
      
    '" WHERE objectCategory='user'" 'This was creating problems where it was picking up two objects that were contacts, not users  
      
      
Set objRecordSet = objCommand.Execute  
      
      
 
      
      
objRecordSet.MoveFirst 'get to the first record in the recordset  
      
      
Do Until objRecordSet.EOF  
      
      
    strUser = objRecordSet.Fields("sAMAccountName").Value  
      
      
    strDN = objRecordSet.Fields("DistinguishedName").Value   'This is important otherwise we cannot pull the "last Password Change date  
      
      
    strMail = objRecordSet.Fields("mail").Value  
      
      
    strFullName = objRecordSet.Fields("DisplayName").Value  
      
      
    
      
      
        For Each objItem in strUser  'one record at a time  
      
      
            Set objUserLDAP = GetObject ("LDAP://" & strDN & "")  
      
      
            intCurrentValue = objUserLDAP.Get("userAccountControl") ' For checking if the account is disabled  
      
      
              
      
      
            '*******************************************************************************************  
      
      
            'BEGIN OF PASSWORD EXPIRATION WARNING  
      
      
            '*******************************************************************************************  
      
      
 
      
      
                numDays = maxpwdage  
      
      
                dtVal = objUserLDAP.PasswordLastChanged 'The latest date the user changed her/his password  
      
      
                whenPasswordExpires = DateAdd("d", numDays, dtval)  
      
      
                fromDate = Date 
      
      
                daysLeft = DateDiff("d",fromDate,whenPasswordExpires)  
      
      
                If (daysLeft < warningDays) and (daysLeft > 0) then  'If 14 days or less remain until Password expires  
      
      
                    If strMail <> "" Then 
      
      
                        Set objEmail = CreateObject("CDO.Message")  
      
      
                        objEmail.From = "admin@watchdog" 
      
      
                        objEmail.To = strmail  
      
      
                        objemail.cc = "xxxxxx@xxx.com" 
      
      
                        objEmail.Subject = strFullname & ", your Windows Password is expiring soon!!"   
      
      
                        objEmail.HTMLBody = "Your Password Expires in " & daysLeft & " day(s)" & vbcrlf & _  
      
      
                        "
Windows users - Press CTRL-ALT-DEL and select the CHANGE A PASSWORD option
" & vbcrlf & _  
      
      
                        "
Outlook Web Users - Please click (Options) and choose (Change your Password)
" & vbcrlf & _  
      
      
                        "
This reminder will continue until you change your password
" & vbcrlf & _  
      
      
                        "
 Please do not reply to this email
" 
      
      
                        objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2  
      
      
                        objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "192.168.xx.xx" 
      
      
                        objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25  
      
      
                        objEmail.Configuration.Fields.Update  
      
      
                        objEmail.Send  
      
      
                      'end if  
      
      
                    End If 
      
      
                End if  
      
      
        Next 
      
      
    objRecordSet.MoveNext ' Keep going down the table  
      
      
Loop 
      
      
 
      
      
Set objConnection = Nothing 
      
      
Set objCommand = Nothing 
      
      
Set objCommand.ActiveConnection = Nothing 
      
      
Set objRootDSE = Nothing 
      
      
Set objRecordSet = Nothing 
      
      
Set objUserLDAP = Nothing 
      
      
Set objEmail = Nothing 
      
      
WScript.Quit  
     
     

本文转自 VirtualTom 51CTO博客，原文链接：http://blog.51cto.com/virtualtom/1142806，如需转载请自行联系原作者