Wrote the following script to enumerate accounts whose passwords haven't
changed in
X number of days.
' Name: staccts.vbs
' Purpose: Lists stale user or computer accounts in a Windows 2000 domain
'
' Author:
'
' History: 3 March, 2001 Created
Option Explicit
' Define constants
Const ADS_SECURE_AUTHENTICATION = 1
Const CONST_ERROR = 0
Const CONST_WSCRIPT = 1
Const CONST_CSCRIPT = 2
Const CONST_SHOW_USAGE = 3
Const CONST_PROCEED = 4
' Declare variables
Dim i, intOpMode
Dim strFQDN, intInterval, strObject
Redim strArgumentArray(0)
' Initialize variables
strArgumentArray(0) = ""
i = 0
intOpMode = 0
strFQDN = ""
intInterval = 0
strObject = "user"
'Get the command line arguments
For i = 0 to Wscript.arguments.count - 1
Redim Preserve strArgumentArray(i)
strArgumentArray(i) = Wscript.arguments.item(i)
Next
'Check whether the script is run using CScript
Select Case intCheckHost()
Case CONST_CSCRIPT
'Do Nothing
Case CONST_WSCRIPT
WScript.Echo "Please run this script using CScript." & vbCRLF &
vbCRLF &
_
"This can be achieved by changing the default Windows Script" &
vbCRLF
& _
"Host setting to CScript using ""CScript //H:CScript //S"" " &
vbCRLF &
_
"and running the script using ""staccts.vbs arguments""."
WScript.Quit
Case Else
WScript.Quit
End Select
'Parse the command line
intOpMode = intParseCmdLine(strArgumentArray, strFQDN, intInterval,
strObject)
If Err.Number then
Wscript.Echo "Error 0x" & CStr(Hex(Err.Number)) & " occurred in parsing
the
command line."
If Err.Description <> "" Then
Wscript.Echo "Error description: " & Err.Description & "."
End If
WScript.Quit
End If
Select Case intOpMode
Case CONST_SHOW_USAGE
Call ShowUsage()
Case CONST_PROCEED
Call Main(strFQDN, intInterval, strObject)
Case CONST_ERROR
'Do nothing.
Case Else 'Default -- should never happen
Wscript.Echo "Error occurred in passing parameters."
End Select
'********************************************************************
'*
'* Function intCheckHost()
'* Purpose: Determines which program is used to run this script.
'* Input: None
'* Output: intCheckHost is set to one of CONST_ERROR, CONST_WSCRIPT,
'* and CONST_CSCRIPT.
'*
'********************************************************************
Private Function intCheckHost()
ON ERROR RESUME NEXT
Dim strFullName, strCommand, i, j
'strFullName should be something like C:\WINNT\SYSTEM32\CSCRIPT.EXE
strFullName = WScript.FullName
If Err.Number then
Wscript.Echo "Error 0x" & CStr(Hex(Err.Number)) & " occurred."
If Err.Description <> "" Then
Wscript.Echo "Error description: " & Err.Description & "."
End If
intCheckHost = CONST_ERROR
Exit Function
End If
i = InStr(1, strFullName, ".exe", 1)
If i = 0 Then
intCheckHost = CONST_ERROR
Exit Function
Else
j = InStrRev(strFullName, "\", i, 1)
If j = 0 Then
intCheckHost = CONST_ERROR
Exit Function
Else
strCommand = Mid(strFullName, j+1, i-j-1)
Select Case LCase(strCommand)
Case "cscript"
intCheckHost = CONST_CSCRIPT
Case "wscript"
intCheckHost = CONST_WSCRIPT
Case Else 'should never happen
Wscript.Echo "An unexpected program is used to run this
script."
Wscript.Echo "Only CScript.Exe or WScript.Exe can be
used to
run this script."
intCheckHost = CONST_ERROR
End Select
End If
End If
End Function
'********************************************************************
'*
'* Function intParseCmdLine()
'* Purpose: Parses the command line.
'* Input: strArgumentArray An array containing input from the command
line
'* strFQDN <empty>
'* intInterval <empty>
'* strObject <empty>
'* Output: strFQDN Fully Qualified Domain Name of the target domain
'* intInterval Password Age Interval
'* strObject "user" or "computer"
'* intParseCmdLine is set to one of CONST_ERROR,
CONST_SHOW_USAGE,
CONST_PROCEED
'*
'********************************************************************
Private Function intParseCmdLine(strArgumentArray, strFQDN, intInterval,
strObject)
ON ERROR RESUME NEXT
Dim i, strFlag
strFlag = LCase(strArgumentArray(0))
If strFlag = "" then 'No arguments have been received
Wscript.Echo "Arguments are required."
intParseCmdLine = CONST_ERROR
Exit Function
End If
If (strFlag="help") OR (strFlag="/h") OR (strFlag="\h") OR
(strFlag="-h") _
OR (strFlag = "\?") OR (strFlag = "/?") OR (strFlag = "?") OR
(strFlag="h")
Then
intParseCmdLine = CONST_SHOW_USAGE
Exit Function
End If
For i = 0 to UBound(strArgumentArray)
strFlag = Left(strArgumentArray(i), InStr(1, strArgumentArray(i),
":")-1)
If Err.Number Then 'An error occurs if there is no : in
the
string
Err.Clear
Select Case LCase(strArgumentArray(i))
Case else
Wscript.Echo "Invalid flag " & strArgumentArray(i) & "."
Wscript.Echo "Please check the input and try again."
intParseCmdLine = CONST_ERROR
Exit Function
End Select
Else
Select Case LCase(strFlag)
Case "/d"
strFQDN = Right(strArgumentArray(i),
Len(strArgumentArray(i))-3)
Case "/i"
intInterval = Right(strArgumentArray(i),
Len(strArgumentArray(i))-3)
Case "/o"
strObject = Right(strArgumentArray(i),
Len(strArgumentArray(i))-3)
Case else
Wscript.Echo "Invalid flag " & strFlag & "."
Wscript.Echo "Please check the input and try again."
intParseCmdLine = CONST_ERROR
Exit Function
End Select
End If
Next
If strFQDN = "" Then
Wscript.Echo "No domain specified."
Wscript.Echo "Please check the input and try again."
intParseCmdLine = CONST_ERROR
Exit Function
End IF
If intInterval = "" Then
Wscript.Echo "No time interval specified."
Wscript.Echo "Please check the input and try again."
intParseCmdLine = CONST_ERROR
Exit Function
End If
intParseCmdLine = CONST_PROCEED
End Function
'********************************************************************
'*
'* Sub ShowUsage()
'* Purpose: Shows the correct usage to the user.
'* Input: None
'* Output: Help messages are displayed on screen.
'*
'********************************************************************
Private Sub ShowUsage()
Wscript.echo ""
Wscript.echo "Queries Active Directory for every user and displays
those" &
vbCRLF & _
"accounts whose password age is older than the interval" &
vbCRLF
& _
"specified."
Wscript.echo ""
Wscript.echo "STACCTS.VBS /d:<fqdn> /i:<interval> [/o:<account type>]"
Wscript.echo ""
Wscript.echo "Parameter specifiers:"
Wscript.echo " <fqdn> Fully Qualified DNS Domain Name of the
target
domain."
Wscript.Echo " <interval> Number of days."
Wscript.Echo " <account type> ""user"" (Default) or ""computer"" "
Wscript.echo ""
End Sub
'********************************************************************
'*
'* Sub Main()
'* Purpose: Main loop in script. Queries AD for user accounts
'* and loops through them, comparing their password
'* age with the interval specified. User accounts with
'* passwords older than the interval are displayed.
'* Input: strFQDN Fully qualified domain name of the
'* target domain
'* intInterval Number of days
'* Output: To STDOUT, a list of user accounts
'*
'********************************************************************
Private Sub Main(strFQDN, intInterval, strObject)
On Error Resume Next
Err.Clear
Dim objectCategory
Dim ADsPath, adoQuery
Dim objConnect, objCommand, objAttributeSet
Dim objUser
Dim strUserName, pwdLastChanged, todaysDate, pwdAge
Select Case LCase(strObject)
Case "user"
' Get the DN of the Person Class
objectCategory = "CN=Person," & GetSchemaNC()
Case "computer"
' Get the DN of the Computer Class
objectCategory = "CN=Computer," & GetSchemaNC()
Case Else
' Should never happen, but just in case
Wscript.Echo "Incorrect object type specified."
Wscript.Echo "Please check the input and try again."
Wscript.Quit
End Select
' Convert the FQDN to a Distinguished Name
ADsPath = ConvertFQDN(strFQDN)
' Formulate ADO query
adoQuery = "<LDAP://" & ADsPath & ">;(objectCategory=" & objectCategory
&
");ADsPath;subtree"
' Create ADO connection object
Set objConnect = CreateObject("ADODB.Connection")
If Err.Number <> 0 Then
ReportError "FAIL: Error creating ADO connection Object."
Wscript.Quit
End If
' Set properties on the connection object
objConnect.Provider = "ADsDSOObject"
objConnect.Open "STACCTS"
' Create ADO command object
Set objCommand = CreateObject("ADODB.Command")
If Err.Number <> 0 Then
ReportError "FAIL: Error creating ADO command Object."
Wscript.Quit
End If
' Link command object to connection object
Set objCommand.ActiveConnection = objConnect
' Set properties on the command object
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Cache Results") = False
objCommand.CommandText = adoQuery
' Run the query and get the result set
Set objAttributeSet = objCommand.Execute
If Err.Number <> 0 Then
ReportError "FAIL: Error running ADO query."
Wscript.Quit
End If
' Create output header
Call PrintReportHeader()
' Loop through results of query
Do While Not objAttributeSet.EOF
' Get object returned from query
Set objUser = GetObject(objAttributeSet.Fields("ADsPath"))
' If we can't get this object, note the error and move on
If Err.Number <> 0 Then
ReportError "FAIL: Error accessing object " &
objAttributeSet.Fields("ADsPath")
Err.Clear
Else
' Otherwise, get properties of object
strUserName = objUser.Name
pwdLastChanged = objUser.PasswordLastChanged
' If the users password has never been set, we'll generate
' an error when we try to access the PasswordLastChanged
' property. Trap the error and assign an arbitrary value
' to the password age.
If Err.Number <> 0 Then
Err.Clear
pwdAge = 999
Else
' Otherwise calculate the difference between today and
' when the password was last set
pwdLastChanged = CDate(pwdLastChanged)
todaysDate = CDate(Now())
pwdAge = DateDiff("d", pwdLastChanged, todaysDate)
End If
' Check to see if the password age is greater than the
' interval specified by the user. If it is, write a record
' to the screen.
If (CInt(pwdAge) > CInt(intInterval)) Then
Wscript.Echo FormatField(strUserName, 20, 1) & vbTab &
FormatField(pwdAge, 7, 3)
End If
End If
' Clean up user object
Set objUser = Nothing
' Next record
objAttributeSet.MoveNext
Loop
' Clean up the ADO objects
Set objAttributeSet = Nothing
Set objCommand = Nothing
Set objConnect = Nothing
End Sub
'********************************************************************
'*
'* Function ConvertFQDN()
'* Purpose: Converts the FQDN of a DNS domain to a Distinguished
'* name.
'* Input: strFQDN Fully qualified domain name of the
'* target domain
'* Output: The distinguished name for the domain
'*
'********************************************************************
Private Function ConvertFQDN(strFQDN)
Dim aryDN, strDN
Dim i
strFQDN = Trim(strFQDN)
aryDN = Split(strFQDN, ".", -1, 1)
strDN = "DC=" & Trim(aryDN(0))
For i = 1 to UBound(aryDN)
If Trim(aryDN(i)) <> "" Then
strDN = strDN & ",DC=" & Trim(aryDN(i))
End If
Next
ConvertFQDN = strDN
End Function
'********************************************************************
'*
'* Function FormatField()
'* Purpose: Format output for display.
'* name.
'* Input: strContents Data to be displayed.
'* intWidth Width of the field in which to place
'* the data.
'* intJustify Justification
'* 1 = Left Justify
'* 2 = Center
'* 3 = Right Justify
'* Output: Properly formatted field
'*
'* Notes: If the width provided is not enough to display all the
'* data, the data is truncated to fit.
'*
'********************************************************************
Private Function FormatField(strContents, intWidth, intJustify)
Dim LSpace, RSpace
Select Case intJustify
Case 1 ' left justify
If Len(strContents) > CInt(intWidth) Then 'truncate
FormatField = Left(strContents, CInt(intWidth))
Else
RSpace = Space(CInt(intWidth) - Len(strContents))
FormatField = strContents & RSpace
End If
Case 2 ' center
If Len(strContents) > CInt(intWidth) Then 'truncate
FormatField = Left(strContents, CInt(intWidth))
Else
LSpace = Space((CInt(intWidth) - Len(strContents)) \ 2)
RSpace = Space(CInt(intWidth) - Len(LSpace & strContents))
FormatField = LSpace & strContents & RSpace
End If
Case 3 ' right justify
If Len(strContents) > CInt(intWidth) Then 'truncate
FormatField = Left(strContents, CInt(intWidth))
Else
LSpace = Space(CInt(intWidth) - Len(strContents))
FormatField = LSpace & strContents
End If
End Select
End Function
'********************************************************************
'*
'* Function GetSchemaNC()
'* Purpose: Binds to a DC and determines the Schema Naming Context
'* Output: Returns the DN of the Schema Naming Context
'*
'********************************************************************
Private Function GetSchemaNC
On Error Resume Next
Err.Clear
' Declare variables
Dim rootDSE, schemaNC
' connect to RootDSE
Set rootDSE = GetObject("LDAP://RootDSE")
If Err.Number <> 0 Then
ReportError "A domain controller could not be contacted."
Wscript.Quit
End If
' get the Schema Naming Context
schemaNC = rootDSE.Get("schemaNamingContext")
If Err.Number <> 0 Then
ReportError "Failed to get schema naming context."
Wscript.Quit
End If
GetSchemaNC = schemaNC
' Clean up
Set rootDSE = Nothing
End Function
'********************************************************************
'*
'* Sub ReportError()
'* Purpose: Outputs error message.
'* Input: errorMessage Error message Text
'* Output: Error messages are displayed on screen.
'*
'********************************************************************
Private Sub ReportError(errorMessage)
Wscript.Echo errorMessage & vbCrLf & vbCrlF
Wscript.Echo "Error: " & Hex(Err.Number) & " - " & Err.Description
End Sub
'********************************************************************
'*
'* Sub PrintReportHeader()
'* Purpose: Prints output header
'*
'* Output: Report Header displayed on screen.
'*
'********************************************************************
Private Sub PrintReportHeader()
Wscript.Echo FormatField("Account Name", 20, 2) & FormatField("Password
Age",
20, 2)
Wscript.Echo Space(20) & FormatField("(999=Pwd never set)", 20, 2)
Wscript.Echo String(40, "=")
End Sub
