VBS域密碼過期郵件提醒

VBS域密碼過期郵件提醒

作為一個企業(yè)管理員來說，日常的密碼創(chuàng)建及重置工作會浪費很多時間，對于我們公司來說，很多客戶確實不自覺，經(jīng)常忘記自己的密碼，忘記密碼后就給IT部門發(fā)送郵件重置密碼，一天重置密碼最多的一次是400-500左右，作為IT人員肯定只能在心里說這些沒有職業(yè)道德的人員，但是工作必需支持啊，為了降低管理員的日常工作，只能借助功能提醒用戶密碼即將過期了，今天呢，我模仿公司的架構來完成一個密碼提醒功能；公司的策略設置密碼最長使用周期為180天，用戶的密碼在過期的前30、15、7、3、2、1天進行提醒，該程序是用vbs腳本寫的，為了執(zhí)行，我們也同時借助了系統(tǒng)自帶的計劃任務來完成程序的運行；我們環(huán)境內(nèi)設置，通過計劃任務每天中午運行程序，如果用密碼即將過期，系統(tǒng)就會給用戶發(fā)送一封郵件。為了提醒的有效性，程序內(nèi)通過判斷，如果用戶的密碼大于等于30天的不給提醒，用戶密碼小于等回1，就提示用戶通過某種方式去修改密碼；當用戶的密碼小于等于0==那就是等于過期了，就提示用戶通過自助的功能自己完成密碼重置。這樣就給管理員的日常維護工作上減少很多時間。具體見下：供大家學習。

腳本內(nèi)容：

' 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 = &h20000
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 & _
"<h3>IIOSOFT account management center reminder：</h3>" & 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 & 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  & VbCrLf & _
"<br/>注:系統(tǒng)進行了集成，郵箱密碼會同步更新.由于服務需要同步更新，郵箱密碼將會在5分鐘過后生效."& VbCrLf & _
"<br/><br/>"& VbCrLf & VbCrLf & _
"IIOSOFT密碼策略：用戶密碼周期：180天，最短使用周期：1天，密碼由至少8位字母，數(shù)字及字符組成，同時不能使用5個歷史密碼." & vbCRLF & _
"如有疑問，請聯(lián)系我們（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 & _
"<h3>IIOSOFT account management center reminder：</h3>" & 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 & 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> 您的密碼已經(jīng)<font color='Red'>過期</font>，請通過以下方法進行進行更改：" & VbCrLf & _
"<br/>請單擊<a  & VbCrLf & _
"<br/>注:系統(tǒng)進行了集成，郵箱密碼會同步更新.由于服務需要同步，郵箱密碼將在5分鐘后生效."& VbCrLf & _
"<br/><br/>"& VbCrLf & VbCrLf & _
"IIOSOFT密碼策略：用戶密碼周期：180天，最短使用周期：1天，密碼由至少8位字母，數(shù)字及字符組成，同時不能使用5個歷史密碼." & vbCRLF & _
"如有疑問，請聯(lián)系我們（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

用戶收到的郵件測試：