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

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

可以参考下
http://gallery.technet.microsoft.com/scriptcenter/f7f5f7ed-14ee-4d0e-81c2-7d95ce7e08f5
 

脚本
 

1. '==========================================================================  
2. 'Milan on 1/12/2011  
3. ' This script can be used to notify users of when their windows passords  
4. ' are going to expire. Especially useful in those cases where user does not logon  
5. ' to windows with individual login and uses OWA for email  
6. ' Script is currently running fine in a Exchange 2010 env with AD 2008  
7. '==========================================================================  
8. On Error Resume Next 
9. Const ADS_SCOPE_SUBTREE = 2  
10. Const SEC_IN_DAY = 86400  
11. Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000 ' tocheck for accounts that have "no expire" set on the password  
12.  
13. Dim maxPwdAge  
14. maxpwdage = 90 'set this according to policy in your organization  
15. Dim numDays  
16. Dim warningDays  
17. warningDays = 14 ' set this according to policy in your organization  
18.  
19. 'ADO to access Active Directory  
20. Set objConnection = CreateObject("ADODB.Connection")  
21. Set objCommand = CreateObject("ADODB.Command")  
22. objConnection.Provider = "ADsDSOObject" 
23. objConnection.Open "Active Directory Provider" 
24. Set objCommand.ActiveConnection = objConnection  
25. Set objRootDSE = GetObject("LDAP://rootDSE")  
26.  
27. DomainString = objRootDSE.Get("dnsHostName")  
28.  
29. objCommand.Properties("Page Size") = 1000  
30. objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE  
31.  
32. objCommand.CommandText = "SELECT DisplayName,mail,DistinguishedName,sAMAccountName  FROM 'LDAP://OU=regions, DC=vsc, DC=com'" & _  
33.     " where objectClass='user'" 
34.     '" WHERE objectCategory='user'" 'This was creating problems where it was picking up two objects that were contacts, not users  
35. Set objRecordSet = objCommand.Execute  
36.  
37. objRecordSet.MoveFirst 'get to the first record in the recordset  
38. Do Until objRecordSet.EOF  
39.     strUser = objRecordSet.Fields("sAMAccountName").Value  
40.     strDN = objRecordSet.Fields("DistinguishedName").Value   'This is important otherwise we cannot pull the "last Password Change date  
41.     strMail = objRecordSet.Fields("mail").Value  
42.     strFullName = objRecordSet.Fields("DisplayName").Value  
43.     
44.         For Each objItem in strUser  'one record at a time  
45.             Set objUserLDAP = GetObject ("LDAP://" & strDN & "")  
46.             intCurrentValue = objUserLDAP.Get("userAccountControl") ' For checking if the account is disabled  
47.               
48.             '*******************************************************************************************  
49.             'BEGIN OF PASSWORD EXPIRATION WARNING  
50.             '*******************************************************************************************  
51.  
52.                 numDays = maxpwdage  
53.                 dtVal = objUserLDAP.PasswordLastChanged 'The latest date the user changed her/his password  
54.                 whenPasswordExpires = DateAdd("d", numDays, dtval)  
55.                 fromDate = Date 
56.                 daysLeft = DateDiff("d",fromDate,whenPasswordExpires)  
57.                 If (daysLeft < warningDays) and (daysLeft > 0) then  'If 14 days or less remain until Password expires  
58.                     If strMail <> "" Then 
59.                         Set objEmail = CreateObject("CDO.Message")  
60.                         objEmail.From = "admin@watchdog" 
61.                         objEmail.To = strmail  
62.                         objemail.cc = "xxxxxx@xxx.com" 
63.                         objEmail.Subject = strFullname & ", your Windows Password is expiring soon!!"   
64.                         objEmail.HTMLBody = "Your Password Expires in " & daysLeft & " day(s)" & vbcrlf & _  
65.                         "<h3>Windows users - Press CTRL-ALT-DEL and select the CHANGE A PASSWORD option</h3>" & vbcrlf & _  
66.                         "<h3>Outlook Web Users - Please click (Options) and choose (Change your Password)</h3>" & vbcrlf & _  
67.                         "<h3>This reminder will continue until you change your password</h3>" & vbcrlf & _  
68.                         "<h3> Please do not reply to this email</h3>" 
69.                         objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2  
70.                         objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "192.168.xx.xx" 
71.                         objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25  
72.                         objEmail.Configuration.Fields.Update  
73.                         objEmail.Send  
74.                       'end if  
75.                     End If 
76.                 End if  
77.         Next 
78.     objRecordSet.MoveNext ' Keep going down the table  
79. Loop 
80.  
81. Set objConnection = Nothing 
82. Set objCommand = Nothing 
83. Set objCommand.ActiveConnection = Nothing 
84. Set objRootDSE = Nothing 
85. Set objRecordSet = Nothing 
86. Set objUserLDAP = Nothing 
87. Set objEmail = Nothing 
88. WScript.Quit  

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