Option Explicit 

Dim objCommand, objConnection, strBase 
Dim strFilter, strAttributes, strPasswordChangeDate, intPassAge 
Dim lngTZBias, objPwdLastSet, strEmailAddress 
Dim objShell, lngBiasKey, k, PasswordExpiry, strRootDomain 
Dim strQuery, objRecordset, strName, strCN 
Dim objEmail, objFSO, strDisabled, debugMode
Dim debugEmail, SMTPServer, owaURL, supportContact

debugMode = "False"
debugEmail = "shunze@XXX.com.tw"

' // Enter the number of days passwords are good for in your domain
PasswordExpiry = 90
' // Enter domain information
strRootDomain = "dc=XXX,dc=com,dc=tw" 
' // URL or IP of SMTP Server
SMTPServer = "mail.XXX.com.tw"
' // URL to OWA server for e-mail message
owaURL = "https://mail.XXX.com.tw/owa/"
supportContact = "Shunze 分機1234"

Set objShell = CreateObject("Wscript.Shell") 
lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias") 

' // HKLM\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias
' //This value is the current time difference from Greenwich Mean Time (GMT) in minutes and is the difference for GMT. 
' // For example, if you’re 1 hour ahead, GMT is 1 hour behind. The value would be ffffffc4, which is hexadecimal for -60.
' // Need to ensure this is in a format we can use.
If UCase(TypeName(lngBiasKey)) = "LONG" Then 
    lngTZBias = lngBiasKey 
ElseIf UCase(TypeName(lngBiasKey)) = "VARIANT()" Then 
    lngTZBias = 0 
    For k = 0 To UBound(lngBiasKey) 
        lngTZBias = lngTZBias + (lngBiasKey(k) * 256^k) 
    Next 
End If 


Set objCommand = CreateObject("ADODB.Command") 
Set objConnection = CreateObject("ADODB.Connection") 
objConnection.Provider = "ADsDSOObject" 
objConnection.Open "Active Directory Provider" 
objCommand.ActiveConnection = objConnection 
strBase = "<LDAP://" & strRootDomain & ">" 


' // Filter on users do not have "password never expires" 
' // or "password not required" set. 
' // userAccountControl:1.2.840.113556.1.4.803:=65536 ' // User accounts with no pwd expiry 
' // userAccountControl:1.2.840.113556.1.4.803:=32 ' // User accounts with no pwd required
' // userAccountControl:1.2.840.113556.1.4.803:=2 ' // Checks to see if the account is disabled
strFilter = "(&(objectCategory=person)(objectClass=user)" _ 
    & "(!userAccountControl:1.2.840.113556.1.4.803:=65536)" _ 
    & "(!userAccountControl:1.2.840.113556.1.4.803:=32)" _ 
    & "(!userAccountControl:1.2.840.113556.1.4.803:=2))"  
strAttributes = "sAMAccountName,cn,mail,pwdLastSet" 
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree" 
objCommand.CommandText = strQuery 
objCommand.Properties("Page Size") = 100 
objCommand.Properties("Timeout") = 30 
objCommand.Properties("Cache Results") = False 
Set objRecordSet = objCommand.Execute 

' // Debug mode pops up messages (WScript) while the script is running.
' // Also e-mails a debug e-mail account rather than the user
If debugMode = "True" then
    WScript.echo "Today's date used in password calculations: " & FormatDateTime(Date() ,1)
End if

Do Until objRecordSet.EOF 
    strName = objRecordSet.Fields("sAMAccountName").Value 
    strCN = objRecordSet.Fields("cn").value 
        
    strEmailAddress = objRecordSet.Fields("mail").value 
           
    Set objPwdLastSet = objRecordset.Fields("pwdLastSet").Value 

    strPasswordChangeDate = Integer8Date(objPwdLastSet, lngTZBias) 
    intPassAge = DateDiff("d", strPasswordChangeDate, Now) 
    
    if debugMode = "True" then
        Wscript.Echo "NT Name: " & strName & ", Common Name: " & strCN  & vbCRLF & vbCRLF _
            & vbTab & "Password last changed at " & strPasswordChangeDate & vbCRLF & vbCRLF _
            & vbTab & "Password changed " & intPassAge & " days ago" & vbCRLF & vbCRLF _
            & vbTab & "E-mail: " & strEmailAddress & vbCRLF & vbCRLF _
            & vbTAB & "Password Change Date: " & strPasswordChangeDate
    End If
    
    If not ( strPasswordChangeDate =  "1/1/1601") then     
    ' // Filter new users who have to change their password at first login.  
    ' // If a password change has never happened the date of last password changed
    ' // is equal to January 1st, 1601.  
        If (intPassAge >  PasswordExpiry) Then 
            If debugMode = "True" then
                WScript.echo vbTab & "Sending user notification to " _ 
                & strEmailAddress & " that password has expired" 
            End if
            Call SendEmailMessage(strEmailAddress, 0) 
        ElseIf intPassAge = (PasswordExpiry - 1) Then 
            If debugMode = "True" then
                WScript.echo vbTab & "Sending user notification to " _ 
                & strEmailAddress & " that password expires in 1 days" 
            End if
            Call SendEmailMessage(strEmailAddress, 1) 
        ElseIf intPassAge = (PasswordExpiry - 2) Then 
            If debugMode = "True" then
                WScript.echo vbTab & "Sending user notification to " _ 
                & strEmailAddress & " that password expires in 2 days" 
            End if
            Call SendEmailMessage(strEmailAddress, 2) 
        ElseIf intPassAge = (PasswordExpiry - 3) Then 
            If debugMode = "True" then
                WScript.echo vbTab & "Sending user notification to " _ 
                & strEmailAddress & " that password expires in 3 days" 
            End if
            Call SendEmailMessage(strEmailAddress, 3) 
        ElseIf intPassAge = (PasswordExpiry - 4) Then 
            If debugMode = "True" then
                WScript.echo vbTab & "Sending user notification to " _ 
                & strEmailAddress & " that password expires in 4 days" 
            End if
            Call SendEmailMessage(strEmailAddress, 4) 
        ElseIf intPassAge = (PasswordExpiry - 5) Then 
            If debugMode = "True" then
                WScript.echo vbTab & "Sending user notification to " _ 
                & strEmailAddress & " that password expires in 5 days" 
            End if
            Call SendEmailMessage(strEmailAddress, 5)
        ElseIf intPassAge = (PasswordExpiry - 6) Then 
            If debugMode = "True" then
                WScript.echo vbTab & "Sending user notification to " _ 
                & strEmailAddress & " that password expires in 6 days" 
            End if
            Call SendEmailMessage(strEmailAddress, 6)
        ElseIf intPassAge = (PasswordExpiry - 7) Then 
            If debugMode = "True" then
                WScript.echo vbTab & "Sending user notification to " _ 
                & strEmailAddress & " that password expires in 7 days" 
            End if
            Call SendEmailMessage(strEmailAddress, 7) 
        ElseIf intPassAge = (PasswordExpiry - 8) Then 
            If debugMode = "True" then
                WScript.echo vbTab & "Sending user notification to " _ 
                & strEmailAddress & " that password expires in 8 days" 
            End if
            Call SendEmailMessage(strEmailAddress, 8) 
        End If 
    End If

    objRecordSet.MoveNext 
Loop 

objConnection.Close 


Function Integer8Date(objDate, lngBias) 
    Dim lngAdjust, lngDate, lngHigh, lngLow 

    lngAdjust = lngBias 
    lngHigh = objDate.HighPart 
    lngLow = objdate.LowPart 

    If lngLow < 0 Then 
        lngHigh = lngHigh + 1 
    End If 

    If (lngHigh = 0) And (lngLow = 0) Then 
        lngAdjust = 0 
    End If 

    lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) + lngLow) / 600000000 - lngAdjust) / 1440 

    On Error Resume Next 
    Integer8Date = CDate(lngDate) 
    If Err.Number <> 0 Then 
        On Error GoTo 0 
        Integer8Date = #1/1/1601# 
    End If 
    On Error GoTo 0 
    
End Function 

Sub SendEmailMessage (strDestEmail,strNoOfDays)

    Set objEmail = CreateObject("CDO.Message")
    Set objFSO = CreateObject("Scripting.FileSystemObject") 
    Set objShell = WScript.CreateObject ("WScript.Shell") 
    
    If IsNull(strDestEmail) Then 
        If debugMode = "True" then
            Wscript.Echo "No email address, no message sent." 
        End If
        Exit Sub 
    End If 

    objEmail.From = debugEmail
    If debugMode = "True" then
        objEmail.To = debugEmail
        wscript.echo "Using debug e-mail address: " & debugEmail
    Else
        'wscript.echo "Sending e-mail address: " & strDestEmail
        objEmail.To = strDestEmail & "; " & debugEmail
    End if
    objEmail.Subject = "您的郵件(網域)密碼將在幾 " & strNoOfDays & " 天內過期!!"
    objEmail.Textbody = "您的郵件(網域)帳號 " & strDestEmail & " 密碼將在幾 " & strNoOfDays & " 天內過期!" & vbCRLF & vbCRLF _
        & "請在密碼過期前變更您的郵件(網域)帳號密碼. " & vbCRLF & vbCRLF _
        & "以下是目前的密碼政策:" & vbCRLF _
        & vbTAB & " 1) 郵件(網域)帳號密碼有限期限為90天." & vbCRLF _
        & vbTAB & " 2) 郵件(網域)帳號密碼是唯一的. 您無法重覆使用最近1次內的密碼." & vbCRLF _
        & vbTAB & " 3) 郵件(網域)帳號密碼長度必需大於6個長度." & vbCRLF  _
        & "基於安全性的理由, 強列建議您使用較複雜的密碼以維護您的帳號安全." & vbCRLF & vbCRLF _
        & "如何變更您的密碼?" & vbCRLF _
        & "加入網域的電腦可直接按下“Ctrl + Alt+ Del”來變更密碼." & vbCRLF _
        & "未加入網域的電腦可透過webmail來變更您的密碼, 步驟如下:" & vbCRLF _
        & vbTAB & "1) 以您的帳號密碼登入Webmail網址 " & owaURL &  vbCRLF _
        & vbTAB & "2) 點選右上角帳號下方的“選項”功能." & vbCRLF _
        & vbTAB & "3) 進入“選項”功能後, 在畫面右側“您可以執行其他工作的捷徑”最下方, 按下“變更您的密碼”連結來變更密碼." & vbCRLF _
        & vbTAB & "4) 輸入網域FQDN、您的帳號及新舊密碼後, 按下確定即可變更密碼." & vbCRLF & vbCRLF _
        & "如果您需要其它協助, 請聯絡郵件管理員 " & supportContact
        
    objEmail.Configuration.Fields.Item _
        ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objEmail.Configuration.Fields.Item _
        ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTPServer
    objEmail.Configuration.Fields.Item _
        ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    objEmail.Configuration.Fields.Update
    objEmail.Send

End Sub