VBScript 密码更改电子邮件错误

Question

提前为任何不正确的术语道歉(我是 PC 技术人员，而不是开发人员/程序员)。

我们在其中一台服务器中运行 VBScript，向用户发送电子邮件通知，告知他们的 Windows 密码将过期，他们需要更改密码。脚本如下:

       *******************Begin Code*****
    on error resume next
    Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
    Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
    Const ONE_HUNDRED_NANOSECOND = .000000100
    Const SECONDS_IN_DAY = 86400
    strDomainDN = "DomainNameHere" 'Domain name here - both Netbios and DNS style names should work 
    ReminderAge = 10 'Days before the reminders start being sent
    'strbody - Body of the message being sent
    strbody = "This message is a reminder that your password will be expiring soon." & vbcrlf
    strbody = strbody & "Please change your network password before the date listed above to avoid being locked out of the system." & vbcrlf
    strbody = strbody & "If you need instructions on how to change your password please contact:" & vbcrlf
    strbody = strbody & "the IT Department" & vbcrlf
    strbody = strbody & vbcrlf & "Thank you," & vbcrlf
    strbody = strbody & "IT Department"

    'create logfile
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    strScriptPath = objfso.GetParentFolderName(WScript.ScriptFullName)
    strLogName = TwoDigits(Year(now)) & TwoDigits(Month(now)) & TwoDigits(Day(now)) & TwoDigits(Hour(now)) & TwoDigits(Minute(now)) & 
    TwoDigits(Second(now)) & ".txt"
    strLogFile = strScriptPath & "Logs\" & StrLogName
    Set objLogFile = objFSO.CreateTextFile(strLogFile,1)
    objLogfile.Writeline "Email Password Check Script started: " & Now
    Dim rootDSE,domainObject
    Set rootDSE = GetObject("LDAP://RootDSE")
    Set oDomain = GetObject("LDAP://" & strDomainDN)
    Set maxPwdAge = oDomain.Get("maxPwdAge")
    DomainContainer = rootDSE.Get("defaultNamingContext")
    Set fs = CreateObject ("Scripting.FileSystemObject")
    Set conn = CreateObject("ADODB.Connection")
    conn.Provider = "ADSDSOObject"
    conn.Open "ADs Provider"
    numDays = CCur((maxPwdAge.HighPart * 2 ^ 32) + maxPwdAge.LowPart) / CCur(-864000000000)
    'LDAP string to only find user accounts with mailboxes
    ldapStr = "<LDAP://" & DomainContainer & ">;(& (mailnickname=*) (| 
    (&(objectCategory=person)(objectClass=user)(!(homeMDB=*))(!(msExchHomeServerName=*)))(&(objectCategory=person)(objectClass=user)(|(homeMDB=*)(msExchHomeServerName=*))) ));adspath;subtree"
    Set rs = conn.Execute(ldapStr)
    While Not rs.EOF
    Set oUser = GetObject (rs.Fields(0).Value)
    dtmValue = oUser.PasswordLastChanged
    If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
    whenpasswordexpires = "The password has never been set."
    else
    whenPasswordExpires = DateAdd("d", numDays, oUser.PasswordLastChanged)
    end if
    daysb4expire = Int(whenPasswordExpires - Now)
    'write user info to logfile
    objLogfile.Writeline "-----------------------------------------"
    objLogfile.Writeline "SAM Acct: " & oUser.SamAccountName
    objLogfile.Writeline "Disp Name: " & oUser.displayName
    objLogfile.Writeline "UPN: " & oUser.userprincipalname
    objLogfile.Writeline "PW Changed: " & oUser.PasswordLastChanged
    objLogfile.Writeline "PW Expires: " & whenPasswordExpires
    dblMaxPwdNano = Abs(MaxPwdAge.HighPart * 2^32 + MaxPwdAge.LowPart)
    dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND
    dblMaxPwdDays = Int(dblMaxPwdSecs / SECONDS_IN_DAY)
    objLogfile.Writeline "The password will expire on " & _
    DateValue(dtmValue + dblMaxPwdDays) & " (" & _
    Int((dtmValue + dblMaxPwdDays) - Now) & " days from today)."
    if daysb4expire < ReminderAge and daysb4expire > 0 then
    objLogfile.Writeline "Expiring soon - sending eMail"
    objLogfile.Writeline "*****************************"
    strNoteMessage = "Dear " & oUser.displayName & "," & vbcrlf & vbcrlf
    strNoteMessage = strNoteMessage & "Your Network password will expire on " & _
    DateValue(dtmValue + dblMaxPwdDays) & " (" & _
    Int((dtmValue + dblMaxPwdDays) - Now) & " days from today)." & vbcrlf & vbcrlf

    Set objEmail = CreateObject("CDO.Message")
    objEmail.From = "me@myCompany.com" 'Your From Address
    objEmail.To = oUser.userprincipalname
    objEmail.Subject = "Network Password Expiration Notice" 'Message subject
    objEmail.TextBody = strNoteMessage & strBody
    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = 

    "YOUREXCHANGE.SERVER.DomainName.COM" ' Your mailserver here
    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    objEmail.Configuration.Fields.Update
    'objEmail.Send 'commented out right now---so you won't send out the email.
    End If
    set whenpasswordexpires = nothing
    err.clear
    rs.MoveNext
    Wend
    Set oUser = Nothing
    Set maxPwdAge = Nothing
    Set oDomain = Nothing
    Logfile.Close
    Function TwoDigits(t)
    TwoDigits = Right("00" & t,2)
    End Function
    WScript.quit

显然，我从这篇文章的脚本中删除了我们的信息。

错误是:

如果用户几天不更改密码，它不会每天发送电子邮件。它随机发送它们。

一些随机用户，如果他们没有更改密码，在第 5 天或第 6 天左右将开始在短短几秒钟内收到数十万封电子邮件，完全锁定他们计算机上的 Outlook。如果他们更改密码，他们将停止获取密码(显然)。

是否有什么我遗漏或需要从这个脚本中删除以使其至少停止一次发送这么多电子邮件？

谢谢你。

Answer 1

一些想法可以帮助您追踪问题。

只有on error resume next在需要它的命令之前 oUser.PasswordLastChanged ，在那行之后 on error goto 0然后手动运行脚本，您将有更好的机会找到一些失败的语句。 update - should store the value in a variable and use

与变量的用途保持一致。 whenpasswordexpires在 if err.number 的一部分中设置为文本另一个日期。然后将其用作日期来计算天数，最后 set whenpasswordexpires = nothing把它当作一个对象。这可能意味着您的某些 if 语句出错并且只是转到下一行，而不是跳过 if - 因此人们可能会在不应该收到邮件时收到邮件。

考虑计算传递给 LDAP 查询的日期，并且只返回要发送电子邮件的人 - 而不是一直通过所有用户

(与 LDAP 查询没有太大关系)我认为您当前的查询简化为 ldapStr = "<LDAP://" & DomainContainer & ">;(& (mailnickname=*)(objectCategory=person)(objectClass=user));adspath;subtree" homeMDB 和 msExchHomeServerName 的所有 ors 和 ands 似乎意味着包括任何组合。可能值得在 LDAP 资源管理器工具中运行您的查询以检查您是否真的得到了您想要的东西。

LDAP 通常对返回的记录数有限制，因此您可能会一直出错，因为返回的记录数超过 1000(典型)。这可以通过在较小的页面(比如 250)中获取数据来解决。

每次登录到一个新文件可能会对您隐藏问题，例如，如果任务被调度程序重新启动。如果每天只有一个日志，则更容易诊断。您也没有正确关闭日志文件 - 应该是 objLogFile.Close(不是 logfile.Close)。您没有将日志放在脚本文件夹的子目录中(例如脚本和脚本\日志)，而是在同一级别(例如脚本和脚本日志)

logfile not objLogFile 问题突出了为什么最好将 Option Explicit 放在代码顶部。这意味着您必须调暗您使用的每个变量，这可能会很痛苦，但要确保您的变量名称中没有错别字，这可能会导致您非常头痛。

WScript.Quit 是最后一行，所以不会做任何事情 - 反正代码即将完成。如果您想中止脚本的执行，WScript.Quit 需要到您想要中止的位置 - 通常在某个 if 之内。陈述。

有许多重复的计算......天，dtmValue + dblMaxPwdDays 等。我只是提到这一点，因为它使代码更难阅读，因此更难理解可能出错的地方。

综上所述，我现在可能已经发表了太多评论让您无法真正理解，而我只是进行更改并发布更新的脚本供您尝试。

看看这个版本是否对你没有错误...

option explicit 

Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
Const ONE_HUNDRED_NANOSECOND = .000000100
Const SECONDS_IN_DAY = 86400

Dim strDomainDN, strBody, strNoteMessage
Dim objFSO, objLogFile, objEmail
Dim strScriptPath, strLogName, strLogFile

strDomainDN = "DomainNameHere" 'Domain name here - both Netbios and DNS style names should work 
Const ReminderAge = 10 'Days before the reminders start being sent
'strbody - Body of the message being sent
strbody = "This message is a reminder that your password will be expiring soon." & vbcrlf
strbody = strbody & "Please change your network password before the date listed above to avoid being locked out of the system." & vbcrlf
strbody = strbody & "If you need instructions on how to change your password please contact:" & vbcrlf
strbody = strbody & "the IT Department" & vbcrlf
strbody = strbody & vbcrlf & "Thank you," & vbcrlf
strbody = strbody & "IT Department"

'create logfile
Set objFSO = CreateObject("Scripting.FileSystemObject")
strScriptPath = objfso.GetParentFolderName(WScript.ScriptFullName)
strLogName = TwoDigits(Year(now)) & TwoDigits(Month(now)) & TwoDigits(Day(now)) & ".txt"
strLogFile = strScriptPath & "Logs\" & StrLogName
Set objLogFile = objFSO.OpenTextFile(strLogFile, 8, True)
objLogFile.Writeline "Email Password Check Script started: " & Now

Dim rootDSE, oDomain, DomainContainer
Dim maxPwdAge, numDays
Dim conn, command
Dim ldapStr
Dim rs, oUser, passwordChanged, whenPasswordExpires, daysb4expire

Set rootDSE = GetObject("LDAP://RootDSE")
Set oDomain = GetObject("LDAP://" & strDomainDN)
Set maxPwdAge = oDomain.Get("maxPwdAge")
DomainContainer = rootDSE.Get("defaultNamingContext")
Set conn = CreateObject("ADODB.Connection")
Set command = CreateObject("ADODB.Command")
conn.Provider = "ADSDSOObject"
conn.Open "ADs Provider"
Set command.ActiveConnection = conn
command.Properties("Page Size") = 250
numDays = ABS(CCur((maxPwdAge.HighPart * 2 ^ 32) + maxPwdAge.LowPart) / CCur(864000000000))

'LDAP string to only find user accounts with mailboxes
Dim dteCnv, sec1601, strExpireDate, strRemindDate
dteCnv = DateAdd("d", -numDays, Now)                             
sec1601 = DateDiff("s","1/1/1601",dteCnv)                              
strExpireDate = CStr(sec1601) & "0000000"                              

dteCnv = DateAdd("d", ReminderAge - numDays, Now)                             
sec1601 = DateDiff("s","1/1/1601",dteCnv)                              
strRemindDate = CStr(sec1601) & "0000000"                              

ldapStr = "<LDAP://" & DomainContainer & ">;(& (mailnickname=*)(objectCategory=person)(objectClass=user)(pwdLastSet>=" & strExpireDate & ")(pwdLastSet<=" & strRemindDate & "));adspath;subtree"
command.CommandText = ldapStr
Set rs = command.Execute
While Not rs.EOF
    Set oUser = GetObject (rs.Fields(0).Value)
    on error resume next
    passwordChanged = oUser.PasswordLastChanged
    If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
        passwordChanged = "Never"
        whenPasswordExpires = Now
    elseIf Err.Number <> 0 Then
        passwordChanged = "Unknown - " & Err.Description
        whenPasswordExpires = Now
    else
        whenPasswordExpires = DateAdd("d", numDays, passwordChanged)
    end if
    on error goto 0
    daysb4expire = Int(whenPasswordExpires - Now)

    'write user info to logfile
    objLogFile.Writeline "-----------------------------------------"
    objLogFile.Writeline "SAM Acct: " & oUser.SamAccountName
    objLogFile.Writeline "Disp Name: " & oUser.displayName
    objLogFile.Writeline "UPN: " & oUser.userprincipalname
    objLogFile.Writeline "PW Changed: " & passwordChanged
    objLogFile.Writeline "PW Expires: " & whenPasswordExpires

    objLogFile.Writeline "The password will expire on " & whenPasswordExpires & " (" & daysb4expire & " days from today)."

    if daysb4expire <= ReminderAge and daysb4expire > 0 then
        objLogFile.Writeline "Expiring soon - sending eMail"
        objLogFile.Writeline "*****************************"
        strNoteMessage = "Dear " & oUser.displayName & "," & vbcrlf & vbcrlf
        strNoteMessage = strNoteMessage & "Your Network password will expire on " & whenPasswordExpires & " (" & daysb4expire & " days from today)." & vbcrlf & vbcrlf

        Set objEmail = CreateObject("CDO.Message")
        objEmail.From = "me@myCompany.com" 'Your From Address
        objEmail.To = oUser.userprincipalname
        objEmail.Subject = "Network Password Expiration Notice" 'Message subject
        objEmail.TextBody = strNoteMessage & strBody
        objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "YOUREXCHANGE.SERVER.DomainName.COM" ' Your mailserver here
        objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        objEmail.Configuration.Fields.Update
        'objEmail.Send 'commented out right now---so you won't send out the email.
    End If

    err.clear
    rs.MoveNext
Wend
Set oUser = Nothing
Set maxPwdAge = Nothing
Set oDomain = Nothing
objLogFile.Writeline "Email Password Check completed: " & Now & vbcrlf & vbcrlf
objLogFile.Close


Function TwoDigits(t)
    TwoDigits = Right("00" & t,2)
End Function