开发者社区> 技术小阿哥> 正文
阿里云
为了无法计算的价值
打开APP
阿里云APP内打开

域帐号密码快过期邮件提醒

简介:
+关注继续查看

社会的快速发展,企业的规模也随之变大,这样企业的人数自然也增多,由于人数的众多,为了便于管理所以用起了域环境,但是根据某些企业的性质,部分员工也可能不登陆域帐号,以至密码过期,这样,时间一长,域帐号的密码重置工作也是个负担对于管理员来说,最后在大家的共同努力下通过一个脚本就能解决这个问题,通过脚本提醒用户密码过期小贴士,

该脚本的原理就是:通过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

clip_image002

以下为脚本的所有内容,该脚本只能运行在一级OU上,不能直接挂载到二级OU上运行;如果真的需要通过脚本实现该功能的话,正常理论下同应该挂载到一级OU上或者直接挂在到域的级别上甚至站点的级别上。下面介绍两种脚本分别能挂在到一级OU及二级OU上。

我的AD架构为见下图;以下脚本我将LDAP路径指为Dahai-Object这个OU上;以下标注红色部分为更改部分。

clip_image004

' 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) &lt;> "$" 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

以下为脚本的测试结果

clip_image006

将配置好的脚本可通过运行计划任务定期运行管理

运行:taskschd.msc,打开任务计划管理器,创建基本任务

clip_image008

任务名称

clip_image010

执行脚本的周期,可根据自己的实际情况选择

clip_image012

每天的某个时间去执行该脚本。

clip_image014

执行的类型为:启动程序

clip_image016

选择需要执行的脚本

clip_image018

执行脚本的确认信息

clip_image020

最后结果

clip_image022

二级OU脚本内容接测试结果:我将LDAP路径直接挂在到Dahai-Object OU下的Dahai-Users OU下运行

clip_image024

以下为执行脚本的内容

' 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 &gt; 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) &gt; 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 &gt;= 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) &lt;> "$" 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,如需转载请自行联系原作者

版权声明:本文内容由阿里云实名注册用户自发贡献,版权归原作者所有,阿里云开发者社区不拥有其著作权,亦不承担相应法律责任。具体规则请查看《阿里云开发者社区用户服务协议》和《阿里云开发者社区知识产权保护指引》。如果您发现本社区中有涉嫌抄袭的内容,填写侵权投诉表单进行举报,一经查实,本社区将立刻删除涉嫌侵权内容。

相关文章
文章
问答
文章排行榜
最热
最新
相关电子书
更多
低代码开发师(初级)实战教程
立即下载
阿里巴巴DevOps 最佳实践手册
立即下载
冬季实战营第三期:MySQL数据库进阶实战
立即下载