VBS域密码过期邮件提醒

VBS域密码过期邮件提醒

作为一个企业管理员来说，日常的密码创建及重置工作会浪费很多时间，对于我们公司来说，很多客户确实不自觉，经常忘记自己的密码，忘记密码后就给IT部门发送邮件重置密码，一天重置密码最多的一次是400-500左右，作为IT人员肯定只能在心里说这些没有职业道德的人员，但是工作必需支持啊，为了降低管理员的日常工作，只能借助功能提醒用户密码即将过期了，今天呢，我模仿公司的架构来完成一个密码提醒功能；公司的策略设置密码最长使用周期为180天，用户的密码在过期的前30、15、7、3、2、1天进行提醒，该程序是用vbs脚本写的，为了执行，我们也同时借助了系统自带的计划任务来完成程序的运行；我们环境内设置，通过计划任务每天中午运行程序，如果用密码即将过期，系统就会给用户发送一封邮件。为了提醒的有效性，程序内通过判断，如果用户的密码大于等于30天的不给提醒，用户密码小于等回1，就提示用户通过某种方式去修改密码；当用户的密码小于等于0==那就是等于过期了，就提示用户通过自助的功能自己完成密码重置。这样就给管理员的日常维护工作上减少很多时间。具体见下：供大家学习。

脚本内容：

' This program scans all users in the Users container and all organizational units
' beneath the HOSTING_OU organizational unit, for users whose passwords have either
' already expired or will expire within DAYS_FOR_EMAIL days.
'
' An email is sent, using CDO, via the SMTP server specified as SMTP_SERVER to the
' user to tell them to change their password. You should change strFrom to match
' the email address of the administrator responsible for password changes.
'
' You will, at a minimum, need to change the SMTP_SERVER, the HOSTING_OU, and the
' STRFROM constants. If you run this on an Exchange server, then SMTP_SERVER can 
' be "127.0.0.1" - and it may be either an ip address or a resolvable name.
'
' If you don't have an OU containing sub-OU's to scan, then set HOSTING_OU to the
' empty string ("").
'
'Option Explicit
' Per environment constants - you should change these!
Const HOSTING_OU = "IIOSOFT Users"
Const HOSTING_OU2 = "iio Users"
Const SMTP_SERVER = "bj-smtp.IIOSOFT.com"
Const STRFROM = "resetpwd@IIOSOFT.com"
'Const aDaysForEmail = Array( 1, 3, 5, 10, 15, 30)
' System Constants - do not change
Const ONE_HUNDRED_NANOSECOND = .000000100 ' .000000100 is equal to 10^-7
Const SECONDS_IN_DAY = 86400
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
Const ForWriting = 2
Dim objRoot
Dim numDays, iResult
Dim strDomainDN
Dim objContainer, objSub
Dim aDaysForEmail(6)
aDaysForEmail(1) = 1
aDaysForEmail(2) = 3
aDaysForEmail(3) = 5
aDaysForEmail(4) = 10
aDaysForEmail(5) = 15
aDaysForEmail(6) = 30
' 存放log到外部文件 -- Jerry
' 从这里开始
'Declare variables
Dim strTestMode
strTestMode = False  'use for debuging
'Cretae log file
Set WshSHell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
strFileName = Replace(Datevalue(Now), "-", "_")
strFileName = Replace(strFileName, "/", "_")
 
Public fLog
Set oLog = objFSO.OpenTextFile(strFileName & ".txt", ForWriting, TRUE)
dp Now
dp ""
 
' 开始运行功能
Set objRoot = GetObject ("LDAP://RootDSE")
strDomainDN = objRoot.Get ("defaultNamingContext")
Set objRoot = Nothing
numdays = GetMaximumPasswordAge (strDomainDN)
dp "Maximum Password Age: " & numDays
If numDays > 0 Then
Set objContainer = GetObject ("LDAP://ou=IIOSOFT Users," & strDomainDN)
Call ProcessFolder (objContainer, numDays)
Set objContainer = Nothing
If Len (HOSTING_OU2) > 0 Then
Set objContainer =  GetObject ("LDAP://ou=BYS Users,ou=IIOSOFT Users," & strDomainDN)'GetObject ("LDAP://OU=" & HOSTING_OU & "," & strDomainDN)
For Each objSub in objContainer
 Call ProcessFolder (objSub, numDays)
Next
Set objContainer = Nothing
End If
End If
dp ""
dp "The command runs successfully!"
dp Now
 
oLog.Close
'Program ending
wscript.quit
'WScript.Echo "Done"
Function GetMaximumPasswordAge (ByVal strDomainDN)
Dim objDomain, objMaxPwdAge
Dim dblMaxPwdNano, dblMaxPwdSecs, dblMaxPwdDays
Set objDomain = GetObject("LDAP://" & strDomainDN)
Set objMaxPWdAge = objDomain.maxPwdAge
If objMaxPwdAge.LowPart = 0 And objMaxPwdAge.Highpart = 0 Then
' Maximum password age is set to 0 in the domain
' Therefore, passwords do not expire
GetMaximumPasswordAge = 0
Else
dblMaxPwdNano = Abs (objMaxPwdAge.HighPart * 2^32 + objMaxPwdAge.LowPart)
dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND
dblMaxPwdDays = Int (dblMaxPwdSecs / SECONDS_IN_DAY)
GetMaximumPasswordAge = dblMaxPwdDays
End If
End Function
Function UserIsExpired (objUser, iMaxAge, aDaysForEmail, iRes)
On Error Resume Next 
Dim intUserAccountControl, dtmValue, intTimeInterval
Dim strName
Err.Clear
strName = Mid (objUser.Name, 4)
intUserAccountControl = objUser.Get ("userAccountControl")
If intUserAccountControl And ADS_UF_DONT_EXPIRE_PASSWD Then
dp "The password for " & strName & " does not expire."
UserIsExpired = False
Else
iRes = 0
dtmValue = objUser.PasswordLastChanged
If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
UserIsExpired = True
dp "The password for " & strName & " has never been set."
Else
intTimeInterval = Int (Now - dtmValue)
dp "The password for " & strName & " was last set on " & _
DateValue(dtmValue) & " at " & TimeValue(dtmValue) & _
" (" & intTimeInterval & " days ago)"
If intTimeInterval >= iMaxAge Then
dp "The password for " & strName & " has expired."
UserIsExpired = True
Else
iRes = Int ((dtmValue + iMaxAge) - Now)
dp "The password for " & strName & " will expire on " & _
DateValue(dtmValue + iMaxAge) & " (" & _
iRes & " days from today)."
 
UserIsExpired = False
For i = 1 To  UBound(aDaysForEmail) - LBound(aDaysForEmail) 
If iRes <= aDaysForEmail(i) Then 
dp strName & " needs an email for password change"
UserIsExpired = True
Exit For
End If 
Next
If Not UserIsExpired Then 
dp strName & " does not need an email for password change"
End If
End If
End If
End If
End Function
Sub ProcessFolder (objContainer, iMaxPwdAge)
Dim objUser, iResult
objContainer.Filter = Array ("User")
'Wscript.Echo "Checking company = " & Mid (objContainer.Name, 4)
For each objUser in objContainer
If Right (objUser.Name, 1) <> "$" Then
If IsEmpty (objUser.Mail) Or IsNull (objUser.Mail) Then
dp Mid (objUser.Name, 4) & " has no mailbox"
Else
If UserIsExpired (objUser, iMaxPwdAge, aDaysForEmail, iResult) Then
'WScript.Echo "...sending an email for " & objUser.Mail
Call SendEmail (objUser, iResult)
Else
dp "...don't send an email"
End If
End If
End If
Next
End Sub
Sub SendEmail (objUser, iResult)
On Error Resume next
Dim objMail
Set objMail = CreateObject ("CDO.Message")
objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTP_SERVER
objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMail.Configuration.Fields.Update
objMail.From = STRFROM
objMail.To = objUser.Mail
objMail.Subject = "IIOSOFT Password Expiration Reminder"
objMail.Textbody = "The system password for user " & objUser.userPrincipalName & _
" (" & objUser.sAMAccountName & ")" & vbCRLF & _
"will expire in " & iResult & " days. " & vbCRLF & _
"Please change it as soon as possible." & vbCRLF & vbCRLF & _
"Thank you," & vbCRLF & _
"IT administrator"
If iResult > 0 Then
objMail.htmlbody = "<html> <body background='http://pic16.nipic.com/20110827/8091326_084040035000_2.jpg' align='left' style='color: #000000; font-family: Arial; font-size: 10pt; font-style: normal;'>" & VbCrLf & _
"<h2>IIOSOFT account management center reminder：</h2>" & VbCrLf & _
"<b> <font color='blue'> "&objUser.sAMAccountName&"</font></b> Your password In <b><font color='red'>" & iResult & "</font></b> later expired, please according to the following methods to make changes:" & vbCRLF & _
"<br/>Please Click Here <a href='https://iis.IIOSOFT.com'>Change Password?</a> , input your IIOSOFT Acount <b><font color='blue'> "&objUser.sAMAccountName&"</font></b> and old password,then submit the new password.The new password will be effective 5 minutes later after directory synchronization."& VbCrLf & _
"<br/>Note:The system was integrated,mailbox password will also be modified.Because the server requires synchronization update, mailbox password will take effect in 5 minutes."& VbCrLf & _
"<br/><br/>"& vbCRLF & vbCRLF & _
"<br/>IIOSOFT password policy : the user's password period: 180 days, the shortest period : 1 days, the password by at least 8 letters, numbers and characters, but can not use the 5 code of history." & vbCRLF & _
"<br/>If you have any questions, please contact us or call ( resetpwd@IIOSOFT.com)    010 88881111 -2220" & VbCrLf & _
"<br/><br/>"& VbCrLf & vbCRLF & _
"<b><font color='blue'> "&objUser.sAMAccountName&"</font></b> 您的密码将于<b><font color='red'>" & iResult & "</font></b>日后到期，请按下述方法进行进行更改：" & vbCRLF & _
"<br/>请单击这<a href='https://iis.IIOSOFT.com'>修改密码?</a>  ,IIOSOFT Account <b><font color='blue'> "&objUser.sAMAccountName&"</font></b> ,输入旧密码及新密码提交即可。由于需要进行目录同步，密码将在5分钟后生效." & VbCrLf & _
"<br/>注:系统进行了集成，邮箱密码会同步更新.由于服务需要同步更新，邮箱密码将会在5分钟过后生效."& VbCrLf & _
"<br/><br/>"& VbCrLf & VbCrLf & _
"IIOSOFT密码策略：用户密码周期：180天，最短使用周期：1天，密码由至少8位字母，数字及字符组成，同时不能使用5个历史密码." & vbCRLF & _
"如有疑问，请联系我们（resetpwd@IIOSOFT.com） 或致电010 88881111 转 2220" & VbCrLf & _
""& VbCrLf & VbCrLf & _
"<br/><br/>Thank you," & VbCrLf & _
"<br/>xx科技账号管理中心" & _
"</body>" & VbCrLf & _
"</html>" 
Else
objMail.htmlbody = "<html> <body background='http://pic16.nipic.com/20110827/8091326_084040035000_2.jpg' align='left' style='color: #000000; font-family: Arial; font-size: 10pt; font-style: normal;'>" & VbCrLf & _
"<h2>IIOSOFT account management center reminder：</h2>" & VbCrLf & _
"<b> <font color='blue'> "&objUser.sAMAccountName&"</font></b> Your password <font color='red'>Had expired</font> , please according to the following methods to make changes:" & vbCRLF & _
"<br/>Please Click Here <a href='https://changepassword.IIOSOFT.com:9001/Home/VerifyIDcode'>Forgot Password?</a> , input your ID Code <b><font color='blue'> "&objUser.sAMAccountName&"</font></b> and old password,then submit the new password.The new password will be effective 5 minutes later after directory synchronization."& VbCrLf & _
"<br/>Note:The system was integrated,mailbox password will also be modified.Because the server requires synchronization update, mailbox password will take effect in 5 minutes."& VbCrLf & _
"<br/><br/>"& vbCRLF & VbCrLf & _
"<br/>IIOSOFT password policy : the user's password period: 180 days, the shortest period : 1 days, the password by at least 8 letters, numbers and characters, but can not use the 5 code of history." & vbCRLF & _
"<br/>If you have any questions, please contact us or call ( resetpwd@IIOSOFT.com)    010 88881111 -2220" & VbCrLf & _
"<br/><br/>"& VbCrLf & vbCRLF & _
"<b><font color='blue'> "&objUser.sAMAccountName&"</font></b> 您的密码已经<font color='Red'>过期</font>，请通过以下方法进行进行更改：" & VbCrLf & _
"<br/>请单击<a href='https://changepassword.IIOSOFT.com/'>忘记密码?</a>  ,ID Code <b><font color='blue'> "&objUser.sAMAccountName&"</font></b> ,输入旧密码及新密码提交即可。由于需要进行目录同步，密码将在5分钟后生效." & VbCrLf & _
"<br/>注:系统进行了集成，邮箱密码会同步更新.由于服务需要同步，邮箱密码将在5分钟后生效."& VbCrLf & _
"<br/><br/>"& VbCrLf & VbCrLf & _
"IIOSOFT密码策略：用户密码周期：180天，最短使用周期：1天，密码由至少8位字母，数字及字符组成，同时不能使用5个历史密码." & vbCRLF & _
"如有疑问，请联系我们（resetpwd@IIOSOFT.com） 或致电010 88881111 转 2220" & VbCrLf & _
""& VbCrLf & vbCRLF & _
"<br/><br/>Thank you," & VbCrLf & _
"<br/>xx科技账号管理中心" & _
"</body>" & VbCrLf & _
"</html>" 
End If
'objMail.AddAttachment "c:2.jpg " '添加附件
objMail.Send
Set objMail = Nothing
End Sub
Sub dp (str)
If strTestMode Then
WScript.Echo str
End If
oLog.WriteLine str
End Sub

用户收到的邮件测试：