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