All geek questions in one place

Email Error to Change VBScript Password

Sorry in advance for any incorrect terminology (I am a computer technician, not a developer / programmer).

We have VBScript running on one of our servers to send an email notification to users that their Windows password will expire and they need to change it. The script looks like this:

       *******************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

Obviously, I deleted our information from the script for this post.

The errors are as follows:

  • He does not send an email every day if the user does not change his password for several days. He sends them randomly.

  • , , 5 6 , Outlook . , ().

-, script, ?

.

+4
1

, .

  • on error resume next , oUser.PasswordLastChanged, on error goto 0 script , - , . 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, -, , . , LDAP, , , .
  • LDAP , , 1000 () . , ( 250).
  • , , . , . - objLogFile.Close(not logfile.Close). (, \), (, )
  • logfile not objLogFile , Option Explicit . , , , , , .
  • WScript.Quit - , - . - script, WScript.Quit , - - if.
  • ... days, dtmValue + dblMaxPwdDays .. , , .

, , , , , , script, .

, ...

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
+1

Source: https://habr.com/ru/post/1584964/

More articles:


All Articles