'++++++++ Begin of Script ++++++++++++++++
' VB Script for Check User Password Expire on Active Directory Server
' 1st Revision
' By: John Savill, 8th June 2005
' Runs check on last password change date
'
' Last Updated
' By: Chanin Luangingkasut, 24 June 2010
' Create log file
'=================================
Option Explicit
Dim objCommand, objConnection, objChild, objUserConnection, strBase, strFilter, strAttributes, strPasswordChangeDate, intPassAge
Dim lngTZBias, objPwdLastSet, strEmailAddress, objMessage
Dim objShell, lngBiasKey, k, PasswordExpiry, strRootDomain
Dim strQuery, objRecordset, strName, strCN
Dim CheckNoRecord, MAXRECORD, EXPIREIN, PWDNOTIFICATION
' *********** SETUP LOG FILE ***************
Dim objFSO, objFolder, objTextFile, objFile
Dim strDirectory, strFile, strText
Dim myDateString, myTimeString, d
' ****** Check current time and date ********
d = Now
myTimeString = Right("00" & Hour(d), 2) & "" & Right("00" & Minute(d), 2) & "" & Right("00" & Second(d), 2)
myDateString = FormatDateTime(Date(), 1)
' ********* Create file and directory ***********
strDirectory = "d:\PasswordExpireLog"
strFile = "\passwordExpireReport_" & myDateString & "_Time_" & myTimeString & ".log"
' Create the File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Check that the strDirectory folder exists
If objFSO.FolderExists(strDirectory) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFolder = objFSO.CreateFolder(strDirectory)
WScript.Echo "Just created " & strDirectory
End If
If objFSO.FileExists(strDirectory & strFile) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
'Wscript.Echo "Just created " & strDirectory & strFile
End If
set objFile = nothing
set objFolder = nothing
' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
Const ForAppending = 8
Set objTextFile = objFSO.OpenTextFile(strDirectory & strFile, ForAppending, True)
' ************** End of Create Log file ****************
' ***CHANGE THESE VALUES TO PASSWORD EXPIRY AND ROOT OF WHERE USERS WILL BE SEARCHED ******
PasswordExpiry=90
EXPIREIN = 15
MAXRECORD = 150
strRootDomain="dc=example,dc=com"
' ***********************************************
' Obtain local Time Zone bias from machine registry.
Set objShell = CreateObject("Wscript.Shell")
lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias")
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 = "
strFilter = "(&(objectCategory=person)(objectClass=user))"
strAttributes = "sAMAccountName,cn,mail,pwdLastSet,distinguishedName"
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
' WScript.echo "Running at " & Date()
CheckNoRecord = 0
' ******************* IN LOOP *******************
Do Until objRecordSet.EOF
strName = objRecordSet.Fields("sAMAccountName").Value
strCN = objRecordSet.Fields("cn").value
strEmailAddress = objRecordSet.Fields("mail").value
CheckNoRecord = CheckNoRecord + 1
' ********** ALERT BOX & WRITE FILE SHOW USER NAME *************
'Wscript.Echo "NT Name: " & strName & ", Common Name: " & strCN
'objTextFile.WriteLine("NT Name: " & strName & ", Common Name: " & strCN)
Set objUserConnection = GetObject("LDAP://" & objRecordSet.Fields("distinguishedName").Value)
Set objPwdLastSet = objUserConnection.pwdLastSet
strPasswordChangeDate = Integer8Date(objPwdLastSet, lngTZBias)
' *********** ALERT BOX SHOW & WRITE FILE LAST CHANGE DATE ************
'WScript.Echo vbTab & "Password last changed at " & strPasswordChangeDate
'objTextFile.WriteLine("Password last changed at " & strPasswordChangeDate)
intPassAge = DateDiff("d", strPasswordChangeDate, Now)
' **** ALERT BOX SHOW & WRITE FILE TOTAL DAYS FROM LAST CHANGE DATE *****
'WScript.Echo vbTab & "Password changed " & intPassAge & " days ago"
'objTextFile.WriteLine("Password changed " & intPassAge & " days ago")
If intPassAge >= PasswordExpiry Then
objTextFile.WriteLine("-- Following user do not change password long time ago, account may be administrator or disable user. ")
objTextFile.WriteLine("-- NT Name: " & strName & ", Common Name: " & strCN)
objTextFile.WriteLine("-- Password last changed at " & strPasswordChangeDate)
objTextFile.WriteLine("-- Password changed " & intPassAge & " days ago, for security reason must change every " & PasswordExpiry & " days")
objTextFile.WriteLine(" ")
Else
PWDNOTIFICATION = (PasswordExpiry - intPassAge)
If EXPIREIN >= PWDNOTIFICATION Then
objTextFile.WriteLine(">> NT Name: " & strName & ", Common Name: " & strCN)
objTextFile.WriteLine(">> Password last changed at " & strPasswordChangeDate)
objTextFile.WriteLine(">> Password changed " & intPassAge & " days ago")
objTextFile.WriteLine(">> Sending user notification to " & strEmailAddress & " that password expires in " & PWDNOTIFICATION & " days")
objTextFile.WriteLine(" ")
End If
End If
' *** Remove or Comment this part if you want to check all users on your server ****
If CheckNoRecord = MAXRECORD Then
Exit Do
End if
' *****************************************************
objRecordSet.MoveNext
Loop
objTextFile.WriteLine("================================")
objTextFile.WriteLine("TOTAL Scan: " & CheckNoRecord)
objTextFile.Close
objConnection.Close
Function Integer8Date(objDate, lngBias)
' Function to convert Integer8 (64-bit) value to a date, adjusted for
' local time zone bias.
Dim lngAdjust, lngDate, lngHigh, lngLow
lngAdjust = lngBias
lngHigh = objDate.HighPart
lngLow = objdate.LowPart
' Account for error in IADslargeInteger property methods.
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
' Trap error if lngDate is overly large
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 objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Password Expires in " & strNoOfDays & " days"
objMessage.Sender = "IT ADMIN DO NOT REPLY"
objMessage.To = strDestEmail
objMessage.TextBody = "Your password expires in " & strNoOfDays & " days. Please goto http://changepass.com and reset"
objMessage.Send
End Sub
' +++++++++++++++++++ End of Script +++++++++++++++++
ปล. ผมได้ comment ในส่วนที่ใช้ส่ง email ไว้ ถ้าจะให้ส่งเมล์ก็เอา comment ออกได้เลยครับ
ไม่มีความคิดเห็น:
แสดงความคิดเห็น