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

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

该脚本的原理就是：通过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 = "[email protected]"

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