[DC+Exchange 2003]網域內檢查密碼狀態及使用郵件通知密碼到期的User

Server 環境：

• DC Server: Windows 2003 Server
• Mail Server: Windows 2003 Server + Exchange 2003 Enterprise

參考資料來源：

1. 使用邮件通知域帐号密码到期脚本
2. 检查AD用户密码过期状态第3版

使用郵件通知密碼到期的User：

以下內容是參考資料來源一（使用邮件通知域帐号密码到期脚本），下載 exch-pwd-expires.rar 之後，所做的繁體化和調整。

用法：

在任一 Server 上將此程式掛上行程內，我是定義為每天早上9點執行一次。這樣每天9點都會執行一次，對於密碼已經快到期（5天內），每天用郵件通知一次。
此模式比較適用於：常使用筆記型電腦跑來跑去，又幾乎難得登入公司網域作業者。
以此程式內容來說，是定義為5天之內的都會寄送郵件。天數是在下列地方修改：

Const DAYS_FOR_EMAIL  = 5

而在DC上的密碼策略，我則是定義是14天內就通知。（必須登入網域）

程式內容如下：
( 可複製以下程式碼，另存成 exch-pwd-expires2.vbs )

' exch-pwd-expires.vbs
'
' Alan.Zhou
' Jun 26, 2007
'Email: alan.zhou@hi-p.com
'
' This program scans all users in the AD,for users whose passwords have either
' already expired or will expire within DAYS_FOR_EMAIL days.
'
' An email is sent, using CDO, via the SMTP server specified as SMTP_SERVER to the
' user to tell them to change their password. You should change strFrom to match
' the email address of the administrator responsible for password changes.
'
' You will, at a minimum, need to change the SMTP_SERVER,  and the STRFROM constants. 
' If you run this on an Exchange server, then SMTP_SERVER can 
' be "127.0.0.1" - and it may be either an ip address or a resolvable name.
'

 'Option Explicit

 ' Per environment constants - you should change these!
 Const SMTP_SERVER  = "192.168.0.x"
 Const STRFROM   = "Administrator@domain.com"
 Const DAYS_FOR_EMAIL  = 5

 ' System Constants - do not change
 Const ONE_HUNDRED_NANOSECOND    = .000000100   ' .000000100 is equal to 10^-7
 Const SECONDS_IN_DAY            = 86400
 Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
 Const E_ADS_PROPERTY_NOT_FOUND  = &h8000500D

 ' Change to "True" for extensive debugging output
 Const bDebug   = True
 Const ForWriting = 2
 Const ForReading = 1
 Const ForAppending = 8
 Const TristateUseDefault    = -2

' 簡單註記 by Japlin on 2010.12.22
'========================================================
' 使用者帳號      ： Mid (objUser.Name, 4)
' 使用者郵件帳號  ： objUser.userPrincipalName  
'  {  UPN=系統主體用戶，是系統用戶以完整的電子郵件格式書寫的名稱 }
'  {  如：name@domain.com, Email.Name@emailAddress.com }
' 使用者登入名稱  ： objUser.sAMAccountName   
'   {  sAMAccountName = Domain account login name }
' Mailbox         ： objUser.Mail
' 密碼最後變更日期： dtmValue = objUser.PasswordLastChanged
' 密碼保存最長期間： numdays = GetMaximumPasswordAge (strDomainDN)  
'   {  在 UserIsExpired Function 內，變數名稱＝iMaxAge } 
' 密碼變更在幾天前： intTimeInterval = Int (Now - dtmValue)   
'   {  今天日期-密碼最後變更日期 }
' 密碼是否過期    ： if intTimeInterval >= iMaxAge
' 密碼在幾天後到期： iRes = Int ((dtmValue + iMaxAge) - Now)  
'   {  密碼最後變更日期 + 密碼保存最長期間 - 今天日期 }
' 發送郵件通知條件： If iRes <=  DAYS_FOR_EMAIL      
'   {  DAYS_FOR_EMAIL 是在程式內自定義，並非AD上所定義的通知日期 }
'========================================================

 Dim objRoot , objFSO
 Dim numDays, iResult
 Dim strDomainDN , Outputfile
 Dim objContainer, objSub

 Set objFSO = CreateObject("Scripting.FileSystemObject")
 Outputfile = "./exch-pwd-expires-2-log.txt"
 CreateOutputFile OutputFile
 wscript.sleep 1000

 Set objRoot = GetObject ("LDAP://rootDSE")
 strDomainDN = objRoot.Get ("defaultNamingContext")
 Set objRoot = Nothing

 numdays = GetMaximumPasswordAge (strDomainDN)
 dp strDomainDN & " 密碼保存最長期間: " & numDays & vbCRLF

 If numDays > 0 Then
    Set objConnection = CreateObject("ADODB.Connection")
 Set objCommand =   CreateObject("ADODB.Command")
 objConnection.Provider = "ADsDSOObject"
 objConnection.Open "Active Directory Provider"
 Set objCommand.ActiveConnection = objConnection
 
 objCommand.Properties("Page Size") = 1000
 objCommand.Properties("Searchscope") = 2
 'objCommand.CommandText = _
 '    "SELECT AdsPath, whenCreated FROM 'LDAP://"& strDomainDN &"' WHERE objectCategory='user'"
 objCommand.CommandText = _
         "Select AdsPath, whenCreated from 'LDAP://" & strDomainDN & _
             "' where objectClass ='user' and objectClass <>'computer'" 
 Set objRecordSet = objCommand.Execute
 objRecordSet.MoveFirst
 Do Until objRecordSet.EOF
  Set objUser = GetObject(objRecordSet.Fields("AdsPath").Value)
  If Right (objUser.Name, 1) <> "$" Then
   If IsEmpty (objUser.Mail) or IsNull  (objUser.Mail) Then
    dp Mid (objUser.Name, 4) & " 沒有 Mailbox" & vbCRLF
            Else
                If UserIsExpired (objUser, numdays, DAYS_FOR_EMAIL, iResult) Then
     dp "---已經發送 Email 給 " & objUser.Mail & vbCRLF
     Call SendEmail (objUser, iResult)
    Else
     dp "...不需要發送 Email" & vbCRLF
    End If
   End If
  End If
     objRecordSet.MoveNext
 Loop
 
 End If

 WScript.Echo "Done"

Function GetMaximumPasswordAge (ByVal strDomainDN)
 Dim objDomain, objMaxPwdAge
 Dim dblMaxPwdNano, dblMaxPwdSecs, dblMaxPwdDays

 Set objDomain = GetObject("LDAP://" & strDomainDN)
 Set objMaxPWdAge = objDomain.maxPwdAge

 If objMaxPwdAge.LowPart = 0 And objMaxPwdAge.Highpart = 0 Then
  ' Maximum password age is set to 0 in the domain
  ' Therefore, passwords do not expire
  GetMaximumPasswordAge = 0
 Else
  dblMaxPwdNano = Abs (objMaxPwdAge.HighPart * 2^32 + objMaxPwdAge.LowPart)
  dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND
  dblMaxPwdDays = Int (dblMaxPwdSecs / SECONDS_IN_DAY)
  GetMaximumPasswordAge = dblMaxPwdDays
 End If
End Function

Function UserIsExpired (objUser, iMaxAge, iDaysForEmail, iRes)
 Dim intUserAccountControl, dtmValue, intTimeInterval
 Dim strName

 On Error Resume Next
 Err.Clear

 strName = Mid (objUser.Name, 4)
 intUserAccountControl = objUser.Get ("userAccountControl")

 If intUserAccountControl And ADS_UF_DONT_EXPIRE_PASSWD Then
  dp strName & " 的密碼尚未過期."
  UserIsExpired = False
 Else
  iRes = 0
  dtmValue = objUser.PasswordLastChanged
  If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
   UserIsExpired = True
   dp strName & " 的密碼尚未設定." & vbCRLF
  Else
   intTimeInterval = Int (Now - dtmValue)
   dp strName & " 的密碼最後設定日期：" & _
    DateValue(dtmValue) & " 在 " & TimeValue(dtmValue) & _
    " (" & intTimeInterval & " 天以前) 最大日期：" & iMaxAge

   If intTimeInterval >= iMaxAge Then
    dp strName & " 的密碼已經過期."
    UserIsExpired = True
   Else
    iRes = Int ((dtmValue + iMaxAge) - Now)
    dp strName & " 的密碼將於 " & _
     DateValue(dtmValue + iMaxAge) & " (" & _
     iRes & " 天後到期)."

    If iRes <= iDaysForEmail Then
     'dp strName & " 需要一個 email 帳號作為密碼更改通知"
     UserIsExpired = True
    Else
     'dp strName & " 不需要 email 帳號作為密碼更改通知"
     UserIsExpired = False
    End If
   End If

  End If
 End If
End Function

Sub SendEmail (objUser, iResult)
 Dim objMail

 Set objMail = CreateObject ("CDO.Message")

 'objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing")      = 2
 'objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver")     = SMTP_SERVER
 'objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
 'objMail.Configuration.Fields.Update

 objMail.From     = STRFROM
 objMail.To       = objUser.Mail

 objMail.Subject  = "密碼到期通知：" & Mid (objUser.Name, 4)
 objMail.Textbody = "Dear " & objUser.userPrincipalName & ":" & vbCRLF & _
    "您的網域和郵件帳號 (" & objUser.sAMAccountName & ")" & vbCRLF & _
    "密碼將於 " & iResult & " 天後到期了。 " & vbCRLF & _
    "請您儘快更換您的密碼." & vbCRLF & vbCRLF & _
    "謝謝！" & vbCRLF & _
    "資訊部 系統管理者 敬上"

 objMail.Send

 Set objMail = Nothing
End Sub

Sub dp (str)
 If bDebug Then
  WriteOutputToFile str
 End If
End Sub


'---------------------------------------------------------------------------------------
'Function: CreateOutputFile
'Last Modified: 10/11/05 .csm
'This function writes the output file for the script.  The name and destination of the
'file is passed in as string variable. Uses Wscript.network to find current user id
'and domain, tries Win32_ComputerSystem and prompts if both of these methods fail.
'---------------------------------------------------------------------------------------
Function CreateOutputFile(OutputFile)
Dim tmpCurrentUser, objNetwork
strComputer = "."
'get local user information and add to the header file
Set objNetwork = CreateObject("Wscript.Network")
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystem")
For Each objItem In colItems
 tmpCurrentUser = objItem.UserName
Next

If IsNull(tmpCurrentUser) Then
    ScriptDomain = objNetwork.UserDomain
 ScriptUser = objNetwork.UserName
 If ISNull(ScriptDomain) or IsNull(ScriptUser) Then ' have user manually enter information as a last resort
  ScriptDomain = InputBox("請輸入 Domain:")
  ScriptUser = InputBox("請輸入 User ID:")
 End if
Else
 tmpCurrentUser = Split(tmpCurrentUser,"\")
 ScriptDomain = tmpCurrentUser(0)
 ScriptUser = tmpCurrentUser(1)
End if

Set objFile = objFSO.CreateTextFile(Outputfile) 'Create the File
objFile.Close
'Re-open file, write the headcer & 1st line of output
Set objFile = objFSO.OpenTextFile(Outputfile, ForWriting, true, TristateUseDefault)
objFile.WriteLine "Check domain password log"
objFile.WriteLine "Created: " & Now
objFile.WriteLine "Computer Domain: " & ScriptDomain
objFile.WriteLine "Current User: " & ScriptUser & vbcrlf
objFile.Close
End Function 


'---------------------------------------------------------------------------------------
'Function: WriteOutputToFile
'Last Modified: 9/28/05 .csm
'This function accepts a string and writes it to the output file
'---------------------------------------------------------------------------------------
Function WriteOutputToFile(strOutput)
'Check if file exists & write the data
On Error Resume Next
'Wscript.echo (strOutput)

If objFSO.FileExists(Outputfile) Then
 Set objFile = objFSO.OpenTextFile(Outputfile, ForAppending)  
 objFile.Write strOutput
 objFile.WriteBlankLines(1)
 objExplorer.Document.Body.InnerHTML = "Script progress: <br>" & strOutput
Else 
 ' file not found
 'Wscript.echo "Error file not found.  Please run the script again."
End If
objFile.Close
End Function

檢查密碼狀態：

以下內容是參考資料來源一（检查AD用户密码过期状态第3版），所做的繁體化和調整。

用法：

此程式比較適用於MIS自行檢查AD內帳號密碼設定狀況。

內容如下：
( 可複製以下程式碼，另存成 AD密碼狀態檢查.hta )

<head>
<title>AD密碼狀態檢查</title>
<HTA:Application
      ApplicationName = "AD帳戶密碼狀態檢查" 
      SingleInstance  = "yes"
      ShowInTaskbar   = "yes"
      WindowState     = "normal"

      Caption         = "yes"
      Sysmenu         = "yes"
      MaximizeButton  = "no"
      Border          = "dialog"
      BorderStyle     = "normal"
      InnerBorder     = "yes"
      Scroll          = "no"
      ContextMenu     = "no"
      Selection       = "no" />
      <style>
       H1{ font-family:Tahoma; font-weight:bold; font-size:18pt; color:black;  text-align:left;
                margin-top:2pt; margin-bottom:10pt; }
       H2{ font-family:Tahoma; font-weight:bold; font-size:10pt; color:maroon; text-align:left;
                margin-top:2pt; margin-bottom:2pt; }
       body{ font-family:Verdana; font-weight:normal; font-size:8.5pt; background-color:#99CCFF;
                margin-left:10pt; margin-rigth:2pt; margin-top:7pt; }
       .hd { font-weight:bold; font-size:8pt; text-align:left; vertical-align:middle; background-color:#DDD; }
       .hd2{ font-weight:bold; font-size:8pt; text-align:left; vertical-align:middle; color:gray; }
       .col{ font-size:8pt; text-align:left; vertical-align:top; background-color:#EEE; }
       .col2{ font-size:8pt; text-align:left; vertical-align:top; }
      </style>
</head>

<script language="VBScript">

Const strAbout  = "3.0 (2007年8月8日)"
Const strCopyr  = "上海賽衛思 許震 / xz1215@263.net"
Const strHelp  = "在域控上以管理員身份運行本腳本，在文本框中輸入正確的域名後綴再點擊按鈕。"
Const strModify  = "Modify by Japlin 2010.12.22"

Window.resizeTo 400, 230
    
Sub RunScript
 
 On Error Resume Next
 Const ADS_SCOPE_SUBTREE = 2
 Const SEC_IN_DAY = 86400
 Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
 Const ForWriting = 2
 Const E_ADS_Property_Not_Found = &h8000500D
 Const E_Table_Not_Found = &h80040E37
 
 If BasicTextBox.value="" Then 
  InfoArea.InnerHTML="請在文本框中輸入本域的域名後綴，再點擊按鈕！"
  Exit Sub 
 Else 
  document.body.style.cursor = "wait"
  InfoArea.InnerHTML="正在運行,請稍候..."
  DomainName=BasicTextBox.value
  intDotPlace=Instr(1,DomainName,".",1)
  If intDotPlace=0 Then
   LDAPDomain="LDAP://DC=" +DomainName
   BiosDomain=DomainName
  Else 
   LDAPDomain="LDAP://DC=" +Replace(DomainName, ".", ",DC=") 
   BiosDomain=Left(DomainName,intDotPlace-1)
  End If
 End If
  
 Set fso = CreateObject("Scripting.FileSystemObject")
    
 Set objConnection = CreateObject("ADODB.Connection")
 Set objCommand =   CreateObject("ADODB.Command")
 objConnection.Provider = "ADsDSOObject"
 objConnection.Open "Active Directory Provider"


 Set objCommand.ActiveConnection = objConnection
 objCommand.CommandText = _
    "Select distinguishedName from '" & LDAPDomain & _
        "' where objectClass ='user' and objectClass <>'computer'" 
 objCommand.Properties("Page Size") = 1000
 objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
 Set objRecordSet = objCommand.Execute
 IF err.number = E_Table_Not_Found Then
  InfoArea.InnerHTML="域名輸入錯誤，請重新輸入！"
  document.body.style.cursor = "default"
  Exit Sub
 End If
 objRecordSet.MoveFirst

'設置輸出結果，用戶可以自行修改文件名稱和路徑
 OutFile = "passstate.csv" 
 Set txtStreamOut = fso.OpenTextFile(OutFile,ForWriting,true)
'結果集的表頭信息
 txtStreamOut.WriteLine "帳戶名稱,帳戶狀態,郵件位址,上次修改時間,上次修改時間距今幾天,下一次修改時間,密碼有效時間"

 Do Until objRecordSet.EOF        
  LDAPUser="LDAP://" +objRecordSet.Fields("distinguishedName").Value

'獲得用戶帳號信息
 Set objUserLDAP = GetObject(LDAPUser)
 intCurrentValue = objUserLDAP.Get("userAccountControl")
'根據控制位最後兩位判斷，如果最後兩位是二進制10，說明帳戶被禁用
 If (intCurrentValue and 3)=2 Then 
     AccountControl = "**禁用"
 Else  
     AccountControl = "啟用"
 End If

'判斷用戶密碼是否設置為永不過期 
 If intCurrentValue And ADS_UF_DONT_EXPIRE_PASSWD Then
    OutText=objUserLDAP.Get("sAMAccountName") & "," & objUserLDAP.Get("Name") & "," &_
 AccountControl &",密碼永不過期,,," 
    txtStreamOut.WriteLine OutText
 Else
'如果用戶密碼沒有設置為永不過期，
'獲得最後一次修改密碼的時間，並計算最後一次修改密碼距今的時間
    dtmValue = objUserLDAP.Passwordlastchanged
    If err.number = E_ADS_Property_Not_Found Then
      intTimeInterval = -1
    Else
      intTimeInterval = int(now - dtmValue)
     End If
    Err.number = 0
 

'獲得密碼最長時間
    Set objDomainNT = GetObject("WinNT://" & BiosDomain)
    intMaxPwdAge = objDomainNT.Get("MaxPasswordAge")

'如果密碼最長時間沒有設置，提示用戶並退出腳本運行 
    If intMaxPwdAge < 0 Then
      InfoArea.InnerHTML "該域密碼最長有效期設置為0，因此用戶帳戶密碼永不過期，程序結束！"
      Exit Sub 
    Else
'否則，如果用戶帳戶最後一次修改密碼距今時間超過密碼最長期限，
'顯示上次密碼已過期  
      intMaxPwdAge = (intMaxPwdAge/SEC_IN_DAY)
      If intTimeInterval >= intMaxPwdAge Then
          OutText=objUserLDAP.Get("sAMAccountName") & "," & objUserLDAP.Get("Name") & "," &_
    AccountControl & "," & DateValue(dtmValue) & " " & _
          TimeValue(dtmValue) & "," & int(now - dtmValue) & ",密碼過期!," 
    txtStreamOut.WriteLine OutText
      Else
        If intTimeInterval = -1 Then
           OutText=objUserLDAP.Get("sAMAccountName") & "," & objUserLDAP.Get("Name") & "," &_
     AccountControl & ",下次登陸修改密碼,,," 
           txtStreamOut.WriteLine OutText
        Else 
'否則，顯示密碼有效時間 
           OutText=objUserLDAP.Get("sAMAccountName") & "," & objUserLDAP.Get("Name") & "," &_
     AccountControl & "," & DateValue(dtmValue) & " " & _
           TimeValue(dtmValue) & "," & int(now - dtmValue) & "," & _
           DateValue(dtmValue + intMaxPwdAge) & "," & int((dtmValue + intMaxPwdAge) - now) 
           txtStreamOut.WriteLine OutText
        End If
       End If
    End If
 End If
objRecordSet.MoveNext
Loop
InfoArea.InnerHTML= "請打開" & OutFile & "檢查帳號密碼狀態. 按F5重新運行！"
document.body.style.cursor = "default" 
End Sub
 
Sub setx(t)
 Dim obj : Set obj = window.event.srcElement
 If t = "" Then
     obj.style.color  = "gray"
        obj.style.cursor = "default"
    Else
        obj.style.color  = "darkblue"
        obj.style.cursor = "hand"
    End If
    footer.innerHTML = t
End Sub
</script>

<body>
<H2>AD帳戶密碼狀態檢查</H2>
    在下面的文本框中輸入本地域名後綴，其格式類似於:aaa.bbb.ccc <br>
    然後點擊開始按鈕:  <br><br>
    
<input type="text" name="BasicTextBox" size="50">
<input id=runbutton  class="button" type="button" value="開始" name="run_button"  onClick="RunScript">
<br><br>
<span id=InfoArea>信息:無</span>
<br>
<hr size=1 color=silver>
<span style="color:gray">
<span onmouseover=setx(strAbout) onmouseout=setx('')>版本</span> |
<span onmouseover=setx(strCopyr) onmouseout=setx('')>作者</span> |
<span onmouseover=setx(strHelp) onmouseout=setx('')>幫助</span> |
<span onmouseover=setx(strModify) onmouseout=setx('')>調整</span> |
</span>
<span style="color:darkblue" id="footer"></span>
</body>