AD用户的密码过期通知（可指定OU)的VBS脚本

Const HOSTING_OU = "ou=dl,ou=City"
Const SMTP_SERVER = "10.15.0.10"
Const STRFROM = "[email protected]"
Const DAYS_FOR_EMAIL = 7

' 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,oUser
Dim objContainer, objSub
dim fso,f1
Dim FileName
ServerAddress = "\\10.15.0.5\itonly$\logs\"
FileName=ServerAddress & "密码过期信息.txt"
Set fso = CreateObject("Scripting.FileSystemObject")

If  (fso.FileExists(FileName)) Then         
   Set f1 = fso.CreateTextFile(FileName,True)

Set objRoot = GetObject ("LDAP://RootDSE")
strDomainDN = objRoot.Get ("defaultNamingContext")
'wscript.echo strDomainDN
Set objRoot = Nothing

numdays = GetMaximumPasswordAge (strDomainDN)
'wscript.echo  "Maximum Password Age: " & numDays
f1.WriteLine  "  最大密码周期:" & numDays & "天"

If numDays > 0 Then

Set objContainer = GetObject ("LDAP://ou=dl,ou=City," & strDomainDN)
Call ProcessFolder (objContainer, numDays)
Set objContainer = Nothing

If Len (HOSTING_OU) > 0 Then
Set objContainer = GetObject ("LDAP://" & 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
end if
WScript.Echo "执行完毕!"

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."
'wscript.echo strName & " password does not expire."
'f1.WriteLine  strName & "      密码未过期!"

UserIsExpired = False
Else
iRes = 0
dtmValue = objUser.PasswordLastChanged
'wscript.echo strName & "     上次改变密码时间：" & dtmValue
'f1.WriteLine  strName & "     上次改变密码时间：" & dtmValue

If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
UserIsExpired = True
dp "The password for " & strName & " has never been set."
'wscript.echo "The password for " & strName & " has never been set."
'f1.WriteLine   strName & "    密码未设定"

Else
intTimeInterval = Int (Now - dtmValue)
dp "The password for " & strName & " was last set on " & DateValue(dtmValue) & " at " & TimeValue(dtmValue) & " (" & intTimeInterval & " days ago)"
'wscript.echo "The password for " & strName & " was last set on " & DateValue(dtmValue) & " at " & TimeValue(dtmValue) & " (" & intTimeInterval & " days ago)"
'f1.WriteLine  strName & "                   密码上次设定日期是" & DateValue(dtmValue) & ",时间是" & TimeValue(dtmValue) & "," & intTimeInterval & "天前"

If intTimeInterval >= iMaxAge Then
dp "The password for " & strName & " has expired."
'wscript.echo "The password for " & strName & " has expired."
f1.WriteLine  strName & "     密码已经过期"

UserIsExpired = True
Else
iRes = Int ((dtmValue + iMaxAge) - Now)
dp "The password for " & strName & " will expire on " & DateValue(dtmValue + iMaxAge) & " (" & iRes & " days from today)."
'wscript.echo "The password for " & strName & " will expire on " & DateValue(dtmValue + iMaxAge) & " (" & iRes & " days from today)."
f1.WriteLine strName & "      密码将在" & DateValue(dtmValue + iMaxAge) & "过期," & "从今天起第" & iRes & "天"

If iRes <= iDaysForEmail Then
dp strName & " needs an email for password change"
'f1.WriteLine strName & "      需要一封邮件来提示改变密码!"

UserIsExpired = True
Else
dp strName & " does not need an email for password change"
'f1.WriteLine strName & "        不需要一封邮件来提示改变密码!"

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 信息 = " & 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"
'Wscript.Echo Mid (objUser.Name, 4) & " has no mailbox"
f1.WriteLine  Mid (objUser.Name, 4) & "        没有邮箱"

Else
If UserIsExpired (objUser, iMaxPwdAge, DAYS_FOR_EMAIL, iResult) Then
'wscript.Echo "...sending an email for " & objUser.Mail
f1.WriteLine "...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.From = STRFROM

objMail.To = "[email protected]"

objMail.Subject =  Mid (objUser.Name, 4) & "       密码已经到期!"
objMail.Textbody = "用户" & objUser.userPrincipalName & " (" & objUser.sAMAccountName & ")" & vbCRLF & "密码将在" & iResult & " 天后过期. " & vbCRLF & "为了不影响你邮箱等的使用，请立即更改密码." & vbCRLF & vbCRLF & "谢谢," & vbCRLF & "前程无忧IT "

objMail.Send

Set objMail = Nothing
End Sub

Sub dp (str)
If bDebug Then
WScript.Echo str
f1.WriteLine str
f1.Close
End If
End Sub