【问题标题】:VBScript password change email errorVBScript 密码更改电子邮件错误
【发布时间】:2015-04-27 18:47:53
【问题描述】:

对于任何不正确的术语,提前致歉(我是 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

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

错误是:

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

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

我是否缺少或需要从该脚本中删除某些内容以使其至少停止一次发送如此多的电子邮件?

谢谢。

【问题讨论】:

  • 如果循环由 LDAP 查找的结果控制,我将检查它返回的值作为我的故障排除的一部分。
  • 请原谅我的经验不足,但我不确定您所说的“检查它返回的值”是什么意思。脚本每次运行时是否会在服务器中创建某种事件日志?
  • 每次调用应用程序时,代码都会写入“\Logs”文件夹。您应该在与此脚本相同的文件夹级别找到此文件夹。
  • 我在任务调度程序中找到了历史记录(我猜这就是它运行的地方)。有很多错误,但都是同一个错误。启动任务失败,事件 ID 101。这是否意味着脚本在特定时间无法运行?有些日子它会运行而没有错误,但有些日子会出错并且无法运行并被终止。我不知道是什么导致了这些错误。
  • 追踪那个 eventid 是什么。您可能需要将日志文件与服务器的应用程序日志文件进行比较,以收集有关正在发生的事情的更多信息。

标签: vbscript


【解决方案1】:

一些想法可以帮助您找出问题所在。

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

话虽如此,我现在可能已经制作了太多的 cmets,如果我不进行更改并发布更新的脚本供您尝试,您可能无法真正理解。

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


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

【讨论】:

  • 好的,我删除了on error resume next。我还删除了WScript.Quit,因为它似乎是错误的语法并且它实际上并没有退出脚本。在End Function 之后,我在脚本WScript.Timeout = 120 的最后添加了一个超时。我不知道 VBScript 的运行速度有多快,如果它们在几秒钟内运行整个脚本并且每个应该收到电子邮件的人都会收到一封。我对 VBScripts 几乎一无所知,所以我试图解决的所有问题我也在这个过程中学习。如果您认为这些添加会起作用,请告诉我。谢谢。
  • WScript.Timeout 应该靠近您的代码顶部以获得任何好处,但我认为这不会有太大帮助,这样做需要尽可能长的时间......进行查询更聪明会节省时间。在上面查看我的编辑
  • 首先感谢您对此事的帮助。我将对其进行测试并告诉你它是如何工作的。
猜你喜欢
  • 1970-01-01
  • 2012-06-24
  • 2019-12-06
  • 2014-05-24
  • 2012-05-16
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
相关资源
最近更新 更多