中 使用郵件通知密碼到期 的部分，所實作的後續內容。
緣由：
- 因為User通常不會知道或是根本就不會去記憶要如何變更密碼。
- 所以，在郵件通知的內容中，最好能加入了一個變更密碼的URL。
- 考慮到外地出差的同仁也能遠端上網連線來變更密碼，
- 所以，最簡單的作法就是：在OWA的網路路徑下增加一網路捷徑和變更密碼的網頁。
原 OWA 變更密碼的路徑：
- 預設在 C:\Windows\System32\inetsrv\iisadmpwd\ 底下
- aexp2.asp – 當你的DC密碼快到期時，進入OWA 會出現問你是否要現在修改密碼，如果是，則會執行這個網頁。（不用輸入Domain）
- aexp2b.asp -- 進入OWA之後，左下角選項，右邊往下將網頁內容拉到最底下，會有一個（變更密碼）按鈕，點進去之後會執行的網頁。（要輸入 Domain）
- 我的作法是使用 aexp2b.asp 當做基本的變更密碼畫面。
- 因為測試過當登入OWA通知你密碼快到期時， 問你要不要先變更密碼，老是會變更失敗。
- 反而進入OWA之後，如上圖，用選項--變更密碼，一次OK 。
- 為了減少未知的麻煩，所以直接使用 aexp2b.asp 。（我真的很懶）
- 而網路上的相關介紹似乎大部分都是選擇用 aexp2.asp。
簡單作法：
第一階段：（在OWA主機上）
- 將 C:\Windows\System32\inetsrv\iisadmpwd\ 整個資料夾，複製到 C:\Inetpub\wwwroot\ 底下。
- 將 C:\Inetpub\wwwroot\iisadmpwd\ 底下的 aexp2b.asp 複製和更名為 default.asp 。
- 打開 系統管理工具--網際網路資訊服務[IIS]管理員。
- 在 預設的網站--新增一個虛擬目錄，假設叫做 ChangePassword。
- 路徑則選擇剛剛建立的 C:\Inetpub\wwwroot\iisadmpwd\。如下圖：
- 按（下一步），記得將 執行指令碼(例如 ASP) 勾選，如下圖：
- 按（下一步）--（完成）。
修改之前的程式碼 exch-pwd-expires2.vbs，將剛剛設定的 ChangePassword 外部網址加入程式碼中，主要是在 SendMail Function 中。
該 Function 程式碼如下：
Sub SendEmail (objUser, iResult)
Dim objMail
Set objMail = CreateObject ("CDO.Message")
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 & _
"請至 <a herf='https://webmail.YourDomaon.com/ChangePassword/'>" & _
"公司網域密碼變更處</a> 變更您的密碼" & vbCRLF & _
"謝謝！" & vbCRLF & _
"資訊部 系統管理者 敬上"
objMail.Send
Set objMail = Nothing
End Sub
' 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@YourDomain.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.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 & _
"請至 <a herf='https://webmail.YourDomain.com/ChangePassword/'>公司網域密碼變更處</a> 變更您的密碼" & 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
沒有留言:
張貼留言