Const HOSTING_OU = "ou=dl,ou=City"
Const SMTP_SERVER = "10.15.0.10"
Const STRFROM = "test@51cto.com"
Const DAYS_FOR_EMAIL = 7
Const SMTP_SERVER = "10.15.0.10"
Const STRFROM = "test@51cto.com"
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
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
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")
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 f1 = fso.CreateTextFile(FileName,True)
Set objRoot = GetObject ("LDAP://RootDSE")
strDomainDN = objRoot.Get ("defaultNamingContext")
'wscript.echo strDomainDN
Set objRoot = Nothing
strDomainDN = objRoot.Get ("defaultNamingContext")
'wscript.echo strDomainDN
Set objRoot = Nothing
numdays = GetMaximumPasswordAge (strDomainDN)
'wscript.echo "Maximum Password Age: " & numDays
f1.WriteLine " 最大密码周期:" & numDays & "天"
'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
Call ProcessFolder (objContainer, numDays)
Set objContainer = Nothing
If Len (HOSTING_OU) > 0 Then
Set objContainer = GetObject ("LDAP://" & HOSTING_OU & "," & strDomainDN)
Set objContainer = GetObject ("LDAP://" & HOSTING_OU & "," & strDomainDN)
For each objSub in objContainer
Call ProcessFolder (objSub, numDays)
Call ProcessFolder (objSub, numDays)
Next
Set objContainer = Nothing
End If
End If
'========================================
' Add the number of days to the last time
' the password was set.
'========================================
'whenPasswordExpires = DateAdd ("d", numDays, oUser.PasswordLastChanged)
' 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 "执行完毕!"
'WScript.Echo "Password Expires On: " & whenPasswordExpires
End If
end if
WScript.Echo "执行完毕!"
Function GetMaximumPasswordAge (ByVal strDomainDN)
Dim objDomain, objMaxPwdAge
Dim dblMaxPwdNano, dblMaxPwdSecs, dblMaxPwdDays
Dim objDomain, objMaxPwdAge
Dim dblMaxPwdNano, dblMaxPwdSecs, dblMaxPwdDays
Set objDomain = GetObject("LDAP://" & strDomainDN)
Set objMaxPWdAge = objDomain.maxPwdAge
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
' 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
Dim intUserAccountControl, dtmValue, intTimeInterval
Dim strName
Err.Clear
strName = Mid (objUser.Name, 4)
intUserAccountControl = objUser.Get ("userAccountControl")
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 & " 密码未过期!"
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
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 & " 密码未设定"
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 & "天前"
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 & " 密码已经过期"
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 & "天"
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 & " 需要一封邮件来提示改变密码!"
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 & " 不需要一封邮件来提示改变密码!"
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 If
End If
End Function
End If
End Function
Sub ProcessFolder (objContainer, iMaxPwdAge)
Dim objUser, iResult
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) & " 没有邮箱"
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
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
Else
dp "...don't send an email"
End If
End If
End If
Next
End Sub
Sub SendEmail (objUser, iResult)
Dim objMail
Dim objMail
Set objMail = CreateObject ("CDO.Message")
objMail.From = STRFROM
objMail.To = "laffer.li@51cto.com"
objMail.Subject = Mid (objUser.Name, 4) & " 密码已经到期!"
objMail.Textbody = "用户" & objUser.userPrincipalName & " (" & objUser.sAMAccountName & ")" & vbCRLF & "密码将在" & iResult & " 天后过期. " & vbCRLF & "为了不影响你邮箱等的使用,请立即更改密码." & vbCRLF & vbCRLF & "谢谢," & vbCRLF & "前程无忧IT "
objMail.Textbody = "用户" & objUser.userPrincipalName & " (" & objUser.sAMAccountName & ")" & vbCRLF & "密码将在" & iResult & " 天后过期. " & vbCRLF & "为了不影响你邮箱等的使用,请立即更改密码." & vbCRLF & vbCRLF & "谢谢," & vbCRLF & "前程无忧IT "
objMail.Send
Set objMail = Nothing
End Sub
End Sub
Sub dp (str)
If bDebug Then
WScript.Echo str
f1.WriteLine str
f1.Close
End If
End Sub
If bDebug Then
WScript.Echo str
f1.WriteLine str
f1.Close
End If
End Sub
转载于:https://blog.51cto.com/lzy821218/273523