VBScript密码更改电子邮件错误

时间：2015-04-27 18:47:53

标签： vbscript

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

我们在其中一台服务器上运行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

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

错误是：

  1. 如果用户几天没有更改密码，则每天都不会发送电子邮件。它随机发送。

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

    3. 我是否缺少或需要从此脚本中删除以使其至少停止一次发送这么多电子邮件？

    谢谢。

1 个答案:

答案 0 :(得分：1)

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

  1. 在需要on error resume next的命令之前只有oUser.PasswordLastChanged，在该行之后on error goto 0然后手动运行脚本，您将更有可能找到一些失败的语句。 update - should store the value in a variable and use
  2. 与变量的用途保持一致。 whenpasswordexpires的一部分设置为if err.number，另一部分设置为日期。然后将其用作计算天数的日期，最后set whenpasswordexpires = nothing将其视为对象。这可能意味着你的一些if语句出错并且只是跳到下一行，而不是跳过if - 所以人们可能会在不应该邮寄的时候邮寄。
  3. 考虑计算传递给LDAP查询的日期，只返回要通过电子邮件发送的人 - 而不是一直通过所有用户
  4. （没有与LDAP查询有太多关系）我认为您当前的查询简化为ldapStr = "<LDAP://" & DomainContainer & ">;(& (mailnickname=*)(objectCategory=person)(objectClass=user));adspath;subtree"所有ors和homeMDB和msExchHomeServerName的ands似乎意味着包含任何组合。可能值得在LDAP资源管理器工具中运行您的查询来检查您是否真正得到了您想要的内容。
  5. LDAP通常对返回的记录数有限制，因此您可能会一直出错，因为您返回的记录超过1000条（典型值）。这可以通过在较小的页面中获取数据（例如250）来解决。
  6. 每次登录到新文件可能会隐藏您的问题，例如，如果任务由调度程序重新启动。如果每天只有一个日志，则更容易诊断。您也没有正确关闭日志文件 - 应该是objLogFile.Close（不是logfile.Close）。您不是将日志放在脚本文件夹的子目录中（例如脚本和脚本\日志），而是放在同一级别（例如脚本和脚本日志）
  7. 日志文件而不是objLogFile问题突出了为什么最好将Option Explicit放在代码的顶部。这意味着你必须调暗你使用的每个变量，这可能很难，但确保你的变量名中没有拼写错误，这可能会让你头疼。
  8. WScript.Quit是最后一行，因此不会做任何事情 - 无论如何都要完成的代码。如果你想中止脚本的执行，WScript.Quit需要你想要中止的地方 - 通常在一些if语句中。
  9. 有很多重复的计算...天，dtmValue + dblMaxPwdDays等我只是提到这个，因为它使代码更难阅读，因此更难理解可能出错的地方。

    10. 所有这一切，我现在可能已经做了太多评论，让你真正理解，如果没有我只是进行更改并发布更新的脚本供你试用。

    查看此版本是否为您运行错误... 

    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
相关问题
最新问题