社会的快速发展，企业的规模也随之变大，这样企业的人数自然也增多，由于人数的众多，为了便于管理所以用起了域环境，但是根据某些企业的性质，部分员工也可能不登陆域帐号，以至密码过期，这样，时间一长，域帐号的密码重置工作也是个负担对于管理员来说，最后在大家的共同努力下通过一个脚本就能解决这个问题，通过脚本提醒用户密码过期小贴士，
该脚本的原理就是：通过LDAP协议查询域策略密码设置，比如域策略设置密码最长使用180天，然后查询用户的最后一次更改密码的时间这样就计算出用户的密码过期时间。通过这样
这样就能减轻管理员的压力。当然有很多人会说可以将用户的属性更改为密码永不过期，但是对于某些企业来说这样很不安全的，所以也不会这样去做，因为在大企业中域帐号会应用在多个应用系统上，所以每个员工的账户会设置账户过期时间，一般设置为60天或180天，今天就带大家一起来观摩一下我的实验环境。
首先，我当前环境的邮箱服务器是Notus Server而不是exchange server，我们大家都知道，exchange跟AD是紧密集成的，而Notus 跟AD没有集成关系，因为他们是两家不同的产品，所以更改域帐号的密码不会更改邮箱的密码，所以在Exchange环境下比较好实现的。我之所以不用Exchange作为我的邮箱服务器，因为我在模仿一个真实的环境。
环境
Hostname:dahai-dca
IP:192.168.221.254
Roles:DC,DNS,DHCP,CA
Hostname:dahai-mail02
IP:192.168.221.248
Roles:Notus Server
Hostname:dahai-mail03
IP:192.168.221.247
Roles: Notus Server
Hostname:dahai-tmg
IP:192.168.221.252
Roles:gateway
Hostname:dahai-client
IP:192.168.221.100
Roles:client
以下为脚本的所有内容，该脚本只能运行在一级OU上，不能直接挂载到二级OU上运行；如果真的需要通过脚本实现该功能的话，正常理论下同应该挂载到一级OU上或者直接挂在到域的级别上甚至站点的级别上。下面介绍两种脚本分别能挂在到一级OU及二级OU上。
我的AD架构为见下图；以下脚本我将LDAP路径指为Dahai-Object这个OU上；以下标注红色部分为更改部分。
' 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 = "Dahai-Object"
Const SMTP_SERVER = "Dahai-mail02.dahai.com"
Const STRFROM = "admin@dahai.com"
Const DAYS_FOR_EMAIL = 90
' 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
' Change to "True" for extensive debugging output
Const bDebug = False
Dim objRoot
Dim numDays, iResult
Dim strDomainDN
Dim objContainer, objSub
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=Dahai-Object," & strDomainDN)
Call ProcessFolder (objContainer, numDays)
Set objContainer = Nothing
If Len (HOSTING_OU) > 0 Then
Set objContainer = GetObject ("LDAP://OU=" & HOSTING_OU & "," & strDomainDN)
For each objSub in objContainer
Call ProcessFolder (objSub, numDays)
Next
Set objContainer = Nothing
End If
'========================================
' Add the number of days to the last time
' the password was set.
'========================================
'whenPasswordExpires = DateAdd ("d", numDays, oUser.PasswordLastChanged)
'WScript.Echo "Password Last Changed: " & oUser.PasswordLastChanged
'WScript.Echo "Password Expires On: " & whenPasswordExpires
End If
'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, iDaysForEmail, iRes)
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)."
If iRes <= iDaysForEmail Then
dp strName & " needs an email for password change"
UserIsExpired = True
Else
dp strName & " does not need an email for password change"
UserIsExpired = False
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, DAYS_FOR_EMAIL, 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)
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 = "Password needs to be set for " & Mid (objUser.Name, 4)
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"
objMail.Textbody = "测试环境用户管理中心提示： " & vbCRLF & _
"您的域账户密码即将过期，请及时进行更改，具体更改方法如下：" & vbCRLF & _
"1. 如果您的计算机已加入到Dahai域内，请通过按Ctrl+Alt+Del并选择更改密码选项，输入旧密码及新密码确认即可." & vbCRLF & _
"2. 如果您的计算机没有加入到Dahai域，请通过浏览https://changepwd.dahai.com/iisadmpwd 链接后通过Dahai\id code的格式输入旧密码及新密码更改即可。" & vbCRLF & _
"请注意：Dahai域策略规定，用户的域密码最长使用周期为：180天，最短使用周期为：1天，密码由至少8位字母，数字及字符组成，同时不能使用5个历史记录密码。" & vbCRLF & _
""& vbCRLF & vbCRLF & _
"同时，因公司邮件系统与域帐号系统无法实现口令的自动同步，为了您的账户安全，请您同步更改邮箱帐户密码，具体更改方法如下：" & vbCRLF & _
"1. 登录您的个人网页邮箱（每个人的个人网页邮箱的登录链接与您当前设置在outlook中的接收邮件服务器相同，如您的接收邮件服务器为mail.dahai.com，则您的个人网页邮箱链接为：https://mail.dahai.com)." & vbCRLF & _
"2. 单击右上角的首选项，然后选择安全性，单击Internet选项，输入旧密码及新密码确认即可。" & vbCRLF & _
"请注意：邮箱密码更改需要30分钟左右的时间与邮件服务器同步，同步期内，建议不要使用邮箱。" & vbCRLF & _
"如有疑问，请联系我们（admin@dahai.com） 或致电010 88880000 转 0000" & vbCRLF & _
""& vbCRLF & vbCRLF & _
"The Prompting Made by dahai Corporation Accounts Management Center" & vbCRLF & _
"Your domain account will be expired, please change your password to a new one. The ways to reach that as followed:" & vbCRLF & _
"one.If your PCs or Laptops have already joined dahai Domain, please press Ctrl-Alt-Del group keys, when you have logged into system with your domain account. Another import thing , make sure your net cable link is well. After you press the group keys, you will find the option “Change Password”, so no doubt, please right click it, and make your password changed, then you will get a new one." & vbCRLF & _
"two.If you don’t have your PCs or Laptops joining dahai Domain, please access this URL: https://changepwd.dahai.com/iisadmpwd . The authentication interface will be in front of you. But the format of username is anyone listed as followed:dahait\username,After authenticate your old password, you will have right to change your password." & vbCRLF & _
"Please notice that: As the compliance of dahai Policy, the days of password in working are not more than180s, and not less than 1 day. The length of password is not less than 8, which is made up of numbers and characters, and five latest password you had used in past are not allowed." & vbCRLF & _
""& vbCRLF & vbCRLF & _
"You must know a important thing, your domain account’s password does not sync with your mail account’s password automatically. So for your security of your account, please change your mail account’s password, after do the change of your domain account." & vbCRLF & _
"one.please log into your web mailbox, the domain name is the same as that you set in your outlook. For example, if you set your sending server and outgoing server are mail.dahai.com, so your web mailbox link is: https://mail.dahai.com," & vbCRLF & _
"two.Click“Preference”, and choose Security option to?Internet Option, type your old password and new password twice. That’s Ok, but password change in your web mailbox will sync with your server in about 30 minutes. You’d better not make your mail account online. That is a suggestion we give, but if urgent things to handle, the old password is allowed within password change syncing." & vbCRLF & _
"If any question, please contact us. Mail:admin@.com Call: 010-88880000 to 0000." & vbCRLF & _
""& vbCRLF & vbCRLF & _
"Thank you," & vbCRLF & _
"IT Serivce Dept"
objMail.Send
Set objMail = Nothing
End Sub
Sub dp (str)
If bDebug Then
WScript.Echo str
End If
End Sub
以下为脚本的测试结果
将配置好的脚本可通过运行计划任务定期运行管理
运行:taskschd.msc，打开任务计划管理器，创建基本任务
任务名称
执行脚本的周期，可根据自己的实际情况选择
每天的某个时间去执行该脚本。
执行的类型为:启动程序
选择需要执行的脚本
执行脚本的确认信息
最后结果
二级OU脚本内容接测试结果：我将LDAP路径直接挂在到Dahai-Object OU下的Dahai-Users OU下运行
以下为执行脚本的内容
' 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 = "Dahai-Object"
Const HOSTING_OU_LEVEL2 = "Dahai-Users"
Const SMTP_SERVER = "Dahai-mail02.dahai.com"
Const STRFROM = "admin@dahai.com"
Const DAYS_FOR_EMAIL = 90
' 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
' Change to "True" for extensive debugging output
Const bDebug = False
Dim objRoot
Dim numDays, iResult
Dim strDomainDN
Dim objContainer, objSub
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=Dahai-Users,ou=Dahai-Object," & strDomainDN)
Call ProcessFolder (objContainer, numDays)
Set objContainer = Nothing
If Len (HOSTING_OU_LEVEL2) > 0 Then
Set objContainer = GetObject ("LDAP://ou=Dahai-Users,ou=Dahai-Object," & strDomainDN)
For each objSub in objContainer
Call ProcessFolder (objSub, numDays)
Next
Set objContainer = Nothing
End If
'========================================
' Add the number of days to the last time
' the password was set.
'========================================
'whenPasswordExpires = DateAdd ("d", numDays, oUser.PasswordLastChanged)
'WScript.Echo "Password Last Changed: " & oUser.PasswordLastChanged
'WScript.Echo "Password Expires On: " & whenPasswordExpires
End If
'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, iDaysForEmail, iRes)
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)."
If iRes <= iDaysForEmail Then
dp strName & " needs an email for password change"
UserIsExpired = True
Else
dp strName & " does not need an email for password change"
UserIsExpired = False
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, DAYS_FOR_EMAIL, 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)
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 = "Password needs to be set for " & Mid (objUser.Name, 4)
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"
objMail.Textbody = "Dahai管理中心提示： " & vbCRLF & _
"您的域账户密码即将过期，请及时进行更改，具体更改方法如下：" & vbCRLF & _
"1. 如果您的计算机已加入到dahai域内，请通过按Ctrl+Alt+Del并选择更改密码选项，输入旧密码及新密码确认即可." & vbCRLF & _
"2. 如果您的计算机没有加入到dahai域，请通过浏览https://changepwd.dahai.com/iisadmpwd 链接后通过dahai\id code的格式输入旧密码及新密码更改即可。" & vbCRLF & _
"请注意：dahai域策略规定，用户的域密码最长使用周期为：180天，最短使用周期为：1天，密码由至少8位字母，数字及字符组成，同时不能使用5个历史记录密码。" & vbCRLF & _
""& vbCRLF & vbCRLF & _
"同时，因公司邮件系统与域帐号系统无法实现口令的自动同步，为了您的账户安全，请您同步更改邮箱帐户密码，具体更改方法如下：" & vbCRLF & _
"1. 登录您的个人网页邮箱（每个人的个人网页邮箱的登录链接与您当前设置在outlook中的接收邮件服务器相同，如您的接收邮件服务器为mail-huabei01.dahai.com，则您的个人网页邮箱链接为：https://mail-huabei01.dahai.com)." & vbCRLF & _
"2. 单击右上角的首选项，然后选择安全性，单击Internet选项，输入旧密码及新密码确认即可。" & vbCRLF & _
"请注意：邮箱密码更改需要30分钟左右的时间与邮件服务器同步，同步期内，建议不要使用邮箱。" & vbCRLF & _
"如有疑问，请联系我们（is@dahai.com） 或致电010 82826100 转 2220" & vbCRLF & _
""& vbCRLF & vbCRLF & _
"The Prompting Made by dahai Corporation Accounts Management Center" & vbCRLF & _
"Your domain account will be expired, please change your password to a new one. The ways to reach that as followed:" & vbCRLF & _
"one.If your PCs or Laptops have already joined dahai Domain, please press Ctrl-Alt-Del group keys, when you have logged into system with your domain account. Another import thing , make sure your net cable link is well. After you press the group keys, you will find the option “Change Password”, so no doubt, please right click it, and make your password changed, then you will get a new one." & vbCRLF & _
"two.If you don’t have your PCs or Laptops joining dahai Domain, please access this URL: https://changepwd.dahai.com/iisadmpwd . The authentication interface will be in front of you. But the format of username is anyone listed as followed:dahai\username,After authenticate your old password, you will have right to change your password." & vbCRLF & _
"Please notice that: As the compliance of dahai Policy, the days of password in working are not more than180s, and not less than 1 day. The length of password is not less than 8, which is made up of numbers and characters, and five latest password you had used in past are not allowed." & vbCRLF & _
""& vbCRLF & vbCRLF & _
"You must know a important thing, your domain account’s password does not sync with your mail account’s password automatically. So for your security of your account, please change your mail account’s password, after do the change of your domain account." & vbCRLF & _
"one.please log into your web mailbox, the domain name is the same as that you set in your outlook. For example, if you set your sending server and outgoing server are mail-huadong01.dahai.com, so your web mailbox link is: https://mail-huadong01.dahai.com," & vbCRLF & _
"two.Click“Preference”, and choose Security option to?Internet Option, type your old password and new password twice. That’s Ok, but password change in your web mailbox will sync with your server in about 30 minutes. You’d better not make your mail account online. That is a suggestion we give, but if urgent things to handle, the old password is allowed within password change syncing." & vbCRLF & _
"If any question, please contact us. Mail:is@dahai.com Call: 010-82826100 to 2220." & vbCRLF & _
""& vbCRLF & vbCRLF & _
"Thank you," & vbCRLF & _
"IT Serivce Dept"
objMail.Send
Set objMail = Nothing
End Sub
Sub dp (str)
If bDebug Then
WScript.Echo str
End If
End Sub
第三：为了灵活应用起见，将域帐号密码过期邮件提醒的检查日期设置多个，比如设置域账户密码过期前30，15，10，5，3，2，1等天数发提醒邮件，具体脚本内容见下：
' 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 = "dahai Users"
Const HOSTING_OU_LEVEL2 = "IT服务部"
Const SMTP_SERVER = "smtp.dahai.com"
Const STRFROM = "is@dahai.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=IT服务部,ou=dahai Users," & strDomainDN)
Call ProcessFolder (objContainer, numDays)
Set objContainer = Nothing
If Len (HOSTING_OU_LEVEL2) > 0 Then
Set objContainer = GetObject ("LDAP://ou=IT服务部,ou=dahai Users," & 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)
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)
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 = "dahai 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"
objMail.Textbody = "账号管理中心提示： " & vbCRLF & _
"您的dahai域账号密码将于" & iResult & "日后到期，请按下述方法进行进行更改：" & vbCRLF & _
"1. 如果您的计算机已加入到dahai域内，请通过按Ctrl+Alt+Del并选择更改密码选项，输入旧密码及新密码确认即可." & vbCRLF & _
"2. 如果您的计算机没有加入到dahai域，请通过登录https://changepwd.dahai.com/iisadmpwd 链接后通过dahai\id code的格式输入旧密码及新密码更改即可." & vbCRLF & _
"同时，因公司邮件系统密码与dahai域帐号密码无法自动同步，请按下述方法同时更改邮件系统密码：" & vbCRLF & _
""& vbCRLF & vbCRLF & _
"1. 登录您的个人网页邮箱，地址为Outlook中配置的接收邮件服务器，同时添加Https://（如 https://mail-huazhong01.dahai.com）." & vbCRLF & _
"2. 单击右上角的首选项，然后选择安全性，单击Internet选项，输入旧密码及新密码确认即可." & vbCRLF & _
"新、旧密码可以并存30分钟，所有服务器完成同步后，新密码正式生效." & vbCRLF & _
"dahai密码策略：用户密码周期：180天，最短使用周期：1天，密码由至少8位字母，数字及字符组成，同时不能使用5个历史密码." & vbCRLF & _
"如有疑问，请联系我们（is@dahai.com） 或致电010 82826100 转 2220" & vbCRLF & _
""& vbCRLF & vbCRLF & _
"dahai account management center reminder:" & vbCRLF & _
"Your dahai domain account password in " & iResult & " later expired, please according to the following methods to make changes:" & vbCRLF & _
"1.if your computer has been added to the dahai domain, please press the Ctrl+Alt+Del and select change password option, enter old password and confirm new password;" & vbCRLF & _
"2.if your computer is not joined to the dahai domain, please login via https://changepwd.dahai.com/iisadmpwd link through the dahai\id code format enter old password and the new password change." & vbCRLF & _
"At the same time, because of the company's mail system code and dahai domain account password can not be automatically synchronized, please according to the following method at the same time change mail system password:" & vbCRLF & _
""& vbCRLF & vbCRLF & _
"1.login your personal webpage mailbox, address for the Outlook in the configuration of the receiving mail server, while adding Https:// ( such as https://mail-huazhong01.dahai.com )." & vbCRLF & _
"2.Click the upper right corner of the preferences, and then select safe, click Internet options, enter old password and confirm new password.." & vbCRLF & _
"The New and the old password can coexist in 30minutes, all servers when synchronization is complete, the new password entered into force." & vbCRLF & _
"dahai 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 ( is@dahai.com) 010 82826100 -2220" & vbCRLF & _
""& vbCRLF & vbCRLF & _
"Thank you," & vbCRLF & _
"Dahai账号管理中心"
objMail.Send
Set objMail = Nothing
End Sub
Sub dp (str)
If strTestMode Then
WScript.Echo str
End If
oLog.WriteLine str
End Sub
实验到此结束
本文转自 高文龙 51CTO博客，原文链接：http://blog.51cto.com/gaowenlong/924688，如需转载请自行联系原作者
