VBS域密碼過(guò)期郵件提醒

成都創(chuàng)新互聯(lián)主營(yíng)新沂網(wǎng)站建設(shè)的網(wǎng)絡(luò)公司,主營(yíng)網(wǎng)站建設(shè)方案,App定制開發(fā),新沂h5微信平臺(tái)小程序開發(fā)搭建,新沂網(wǎng)站營(yíng)銷推廣歡迎新沂等地區(qū)企業(yè)咨詢

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

腳本內(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 ""
 
' 開始運(yùn)行功能
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 = " " & VbCrLf & _
"
IIOSOFT account management center reminder：
" & VbCrLf & _
"  "&objUser.sAMAccountName&" Your password In " & iResult & " later expired, please according to the following methods to make changes:" & vbCRLF & _
"
Please Click Here 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 & _
"

"& vbCRLF & vbCRLF & _
"
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 & _
"
If you have any questions, please contact us or call ( resetpwd@IIOSOFT.com)    010 88881111 -2220" & VbCrLf & _
"

"& VbCrLf & vbCRLF & _
" "&objUser.sAMAccountName&" 您的密碼將于" & iResult & "日后到期，請(qǐng)按下述方法進(jìn)行進(jìn)行更改：" & vbCRLF & _
"
請(qǐng)單擊這注:系統(tǒng)進(jìn)行了集成，郵箱密碼會(huì)同步更新.由于服務(wù)需要同步更新，郵箱密碼將會(huì)在5分鐘過(guò)后生效."& VbCrLf & _
"

"& VbCrLf & VbCrLf & _
"IIOSOFT密碼策略：用戶密碼周期：180天，最短使用周期：1天，密碼由至少8位字母，數(shù)字及字符組成，同時(shí)不能使用5個(gè)歷史密碼." & vbCRLF & _
"如有疑問(wèn)，請(qǐng)聯(lián)系我們（resetpwd@IIOSOFT.com） 或致電010 88881111 轉(zhuǎn) 2220" & VbCrLf & _
""& VbCrLf & VbCrLf & _
"

Thank you," & VbCrLf & _
"
xx科技賬號(hào)管理中心" & _
"" & VbCrLf & _
"" 
Else
objMail.htmlbody = " " & VbCrLf & _
"
IIOSOFT account management center reminder：
" & VbCrLf & _
"  "&objUser.sAMAccountName&" Your password Had expired , please according to the following methods to make changes:" & vbCRLF & _
"
Please Click Here 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 & _
"

"& vbCRLF & VbCrLf & _
"
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 & _
"
If you have any questions, please contact us or call ( resetpwd@IIOSOFT.com)    010 88881111 -2220" & VbCrLf & _
"

"& VbCrLf & vbCRLF & _
" "&objUser.sAMAccountName&" 您的密碼已經(jīng)過(guò)期，請(qǐng)通過(guò)以下方法進(jìn)行進(jìn)行更改：" & VbCrLf & _
"
請(qǐng)單擊注:系統(tǒng)進(jìn)行了集成，郵箱密碼會(huì)同步更新.由于服務(wù)需要同步，郵箱密碼將在5分鐘后生效."& VbCrLf & _
"

"& VbCrLf & VbCrLf & _
"IIOSOFT密碼策略：用戶密碼周期：180天，最短使用周期：1天，密碼由至少8位字母，數(shù)字及字符組成，同時(shí)不能使用5個(gè)歷史密碼." & vbCRLF & _
"如有疑問(wèn)，請(qǐng)聯(lián)系我們（resetpwd@IIOSOFT.com） 或致電010 88881111 轉(zhuǎn) 2220" & VbCrLf & _
""& VbCrLf & vbCRLF & _
"

Thank you," & VbCrLf & _
"
xx科技賬號(hào)管理中心" & _
"" & VbCrLf & _
"" 
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

用戶收到的郵件測(cè)試：