Password Expiration LDAP script?

> '=======================================================================
> ===
> '
> ' NAME: NotifyPasswordExpireOWA.vbs
> '
> ' AUTHOR: Mark D. MacLachlan , The Spider's Parlor
> ' DATE  : 04/15/2003
> '
> ' COMMENT:
> ' Schedule to notify users that password will expire soon.
> ' This script should be run from the Exchange Server as a scheduled
> task.
> '
> '    THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF
> '    ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED To
> '    THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A
> '    PARTICULAR PURPOSE.
> '
> '    IN NO EVENT SHALL THE SPIDER'S PARLOR AND/OR ITS RESPECTIVE
> SUPPLIERS
> '    BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
> '    DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
> '    WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS
> '    ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE
> '    OF THIS CODE OR INFORMATION.
> '
> '=======================================================================
> ===
>
> '=============================
> ' First enumerate through users
> ' strComputer must be a Domain Controller, use "." for local
> ' or specify a remote server name within the quotes.
> '=============================
> strComputer = "."
> Set objWMIService = GetObject("winmgmts:\\" & strComputer &
> "\root\CIMV2")
> Set colItems = objWMIService.ExecQuery("SELECT * FROM
> Win32_UserAccount",,48)
>
> For Each objItem In colItems
>  strSAM = objItem.Name
>  strLDAP = SearchDistinguishedName(objItem.Name)
>  Set objUser = GetObject("LDAP://" & strLDAP)
>  strUserMail = objUser.mail
>  'Now check for the expiration
>  Check = CheckExpiration(strLDAP, strUserMail)
>  Set ObjUser = Nothing
> Next
>
>
>
>
> Function CheckExpiration(strUserDN, UserEmail)
> '========================================
> ' This section of the script will check the users password for
> expiration
> ' First, get the domain policy.
> '========================================
>    Dim oDomain, oUser,maxPwdAge, numDays, daysToExpiration
>
>    Set sys = CreateObject("ADSystemInfo")
>    strDomainDN =  sys.DomainShortName
>
>    Set oDomain = GetObject("LDAP://" & strDomainDN)
>    Set maxPwdAge = oDomain.Get("maxPwdAge")
>
>    '========================================
>    ' Calculate the number of days that are
>    ' held in this value.
>    '========================================
>    numDays = CCur((maxPwdAge.HighPart * 2 ^ 32) + _
>                    maxPwdAge.LowPart) / CCur(-864000000000)
>    WScript.Echo "Maximum Password Age: " & numDays
>
>    '========================================
>    ' Determine the last time that the user
>    ' changed his or her password.
>    '========================================
>    Set oUser = GetObject("LDAP://" & strUserDN)
>
>    '========================================
>    ' Add the number of days to the last time
>    ' the password was set.
>    '========================================
>    whenPasswordExpires = DateAdd("d", numDays,
> oUser.PasswordLastChanged)
>
> '========================================
> ' Now get the number of days until expiration
> '========================================
>    daysToExpiration = DateDiff("d", Now(),whenPasswordExpires)
>
>    '========================================
> ' Send the email if expiration is within parameters
> '========================================
>    If daysToExpiration <= 10 Then
>       NotifyExpiration(UserEmail)
>    End If
>
>    '========================================
>    ' Clean up.
>    '========================================
>    Set oUser = Nothing
>    Set maxPwdAge = Nothing
>    Set oDomain = Nothing
>
> End Function
>
>
>
>
> Function NotifyExpiration(oTo)
> '=====================================
> ' You must customize the entry for oMyIP (your SMTP server address)
> with the proper company information.
> '=====================================
>
> Dim oName, ODomain, oMyIP, sys
> Set sys = CreateObject("ADSystemInfo")
> 'Below will use the AD DNS name for the email automatically or you can
> 'specifically set the value if the email domain is different.
> ODomain = sys.DomainDNSName
> ' Company Internet Domain Name Uncomment next line and change value if
> desired.
> 'ODomain = "YOURCOMPANY.com"
>
> ' Set the SMTP server IP
> oMyIP = "192.168.1.2"
>
>
> ' Set the visual basic constants as they do not exist within VBScript.
> ' Do not set your smtp server information here.
> Const cdoSendUsingMethod =
> "http://schemas.microsoft.com/cdo/configuration/sendusing", _
> cdoSendUsingPort = 2, _
> cdoSMTPServer =
> "http://schemas.microsoft.com/cdo/configuration/smtpserver"
>
> 'Create the CDO connections.
> Dim iMsg, iConf, Flds
> Set iMsg = CreateObject("CDO.Message")
> Set iConf = CreateObject("CDO.Configuration")
> Set Flds = iConf.Fields
>
> 'SMTP server configuration.
> With Flds
> .Item(cdoSendUsingMethod) = cdoSendUsingPort
>
> 'Set the SMTP server address here.
> .Item(cdoSMTPServer) = oMyIP
> .Update
> End With
>
> 'Set the message properties.
> With iMsg
> Set .Configuration = iConf
> .To = oTo
> .From = oName & "@" & oDomain
> .Subject = "Password About To Expire"
> .TextBody = "This is a reminder that you must change your password.
> To avoid being locked out, change your password now."
> End With
>
> 'An attachment can be included.
> 'iMsg.AddAttachment Attachment
>
> 'Send the message.
> iMsg.Send
> End Function
>
> Public Function SearchDistinguishedName(ByVal vSAN)
>    ' Function:     SearchDistinguishedName
>    ' Description:  Searches the DistinguishedName for a given
> SamAccountName
>    ' Parameters:   ByVal vSAN - The SamAccountName to search
>    ' Returns:      The DistinguishedName Name
>    Dim oRootDSE, oConnection, oCommand, oRecordSet
>
>    Set oRootDSE = GetObject("LDAP://rootDSE")
>    Set oConnection = CreateObject("ADODB.Connection")
>    oConnection.Open "Provider=ADsDSOObject;"
>    Set oCommand = CreateObject("ADODB.Command")
>    oCommand.ActiveConnection = oConnection
>    oCommand.CommandText = "<LDAP://" &
> oRootDSE.get("defaultNamingContext") & _
>        ">;(&(objectCategory=User)(samAccountName=" & vSAN &
> "));distinguishedName;subtree"
>    Set oRecordSet = oCommand.Execute
>    On Error Resume Next
>    SearchDistinguishedName = oRecordSet.Fields("DistinguishedName")
>    On Error GoTo 0
>    oConnection.Close
>    Set oRecordSet = Nothing
>    Set oCommand = Nothing
>    Set oConnection = Nothing
>    Set oRootDSE = Nothing
> End Function
>