lastlogon.vbs

'======================================================================================
' Title:       lastlogon.vbs
'
' Purpose:     Prints out last logon of all users
'
' Usage:       cscript <path> lastlogon.vbs > <outfile>
'======================================================================================
Option Explicit

Const strProgramName = "lastlogon.vbs"
Const VerNum         = "1"

Const INITIAL_SIZE_OF_ARRAY = 10
Const LowerBound = 70  ' Array size at which sort switches from 'Insert' to 'Quick'.

Class IndexedArray
  Private intTotalNumberOfRows ' How many rows in the array
  Private intNumCols           ' How many cols in the array
  Private intNumRowsInUse      ' How many rows currently in use
  Private intCmpMethod         ' What kind of comparisons to perform : binary or text?
  Private intOrderedCol        ' The number of the column last used for sorting
  Private arrayIndex()         ' An array of pointers serving as the index.
  Private arrayData()          ' The internal data array



  '========================================================================
  ' Constructor
  '========================================================================
  Private Sub class_Initialize( )
    intTotalNumberOfRows  = INITIAL_SIZE_OF_ARRAY
    intNumCols            = 0
    intNumRowsInUse       = 0
    intOrderedCol         = 0
    intOrderedCol         = 0
    intCmpMethod          = -1
    ReDim arrayIndex( intTotalNumberOfRows )
  End Sub


  '========================================================================
  ' Called to define how many columns in the array
  '========================================================================
  Public Sub Initialise( ByVal intHowManyCols, ByVal intCmpType )
    Dim i
    Assert ((intCmpType = vbBinaryCompare) Or (intCmpType = vbTextCompare)), "IndexedArray." _
               & "Initialise: Incorrect comparison type."
    intNumCols   = intHowManyCols
    intCmpMethod = intCmpType
    ReDim arrayData( intNumCols, intTotalNumberOfRows )
    ' Initialise index
    For i = 1 To intTotalNumberOfRows
      arrayIndex(i) = i
    Next
  End Sub


  '========================================================================
  ' Returns how many rows are currently in use.
  '========================================================================
  Public Property Get RowCount
    RowCount = intNumRowsInUse
  End Property


  '========================================================================
  ' Returns how many cols are in the array.
  '========================================================================
  Public Property Get ColCount
    ColCount = intNumCols
  End Property


  '========================================================================
  ' Doubles size of the array when it becomes full
  '========================================================================
  Private Sub DoubleSizeOfArray
    Dim i
    Dim intOldNumRows
    intOldNumRows = intTotalNumberOfRows
    intTotalNumberOfRows = intTotalNumberOfRows * 2
    ReDim Preserve arrayData( intNumCols, intTotalNumberOfRows )
    ReDim Preserve arrayIndex( intTotalNumberOfRows )
    For i = intOldNumRows + 1 To intTotalNumberOfRows
      arrayIndex( i ) = i
    Next
  End Sub


  '========================================================================
  ' Puts a data element directly into a specified pre-existing array cell
  '========================================================================
  Public Property Let Data( ByVal intRow, ByVal intCol, ByVal objData )
    arrayData( intCol, intRow ) = objData
  End Property


  '========================================================================
  ' Returns the data in the specified cell using absolute row number
  ' Note that, for reasons I do not currently understand,
  ' Wscript.Echo a.Data( 1, 1 )  fails, but
  ' x = 1
  ' y = 1
  ' Wscript.Echo( x, y ) works.
  ' Is this a bug or a feature?
  '========================================================================
  Public Property Get Data( ByVal intRow, ByVal intCol)
    Data = arrayData( intCol,  intRow )
  End Property


  '========================================================================
  ' Creates a new row then adds a data element to that row
  '========================================================================
  Public Sub CreateNewRow( ByVal objData, ByVal intCol )
    intNumRowsInUse = intNumRowsInUse + 1
    arrayData( intCol, intNumRowsInUse ) = objData
    If intNumRowsInUse = intTotalNumberOfRows Then DoubleSizeOfArray
  End Sub


  '========================================================================
  ' Writes data into an element of the current last row.
  ' Does not create a new row.
  '========================================================================
  Public Sub PutIntoLastRow( ByVal objData, ByVal intCol )
    arrayData( intCol, intNumRowsInUse ) = objData
  End Sub


  '========================================================================
  ' Searches the column specified in the second parameter.  Returns the
  ' number of the row containing the value.
  ' Because this procedure uses a linear search it is slow.  It will,
  ' however, work on any column.  The BinaryLookup function below is
  ' faster but only works on the sorted row.
  '========================================================================
  Public Property Get Exists( ByVal Object, ByVal intCol )
    Dim i
    i = 1
    Exists = 0
    While i <= intNumRowsInUse And Exists = 0
      If VComp( Object, arrayData( intCol, i ), intCmpMethod ) = 0 Then
        Exists = i
      End If
      i = i + 1
    Wend
  End Property


  '========================================================================
  ' Returns the data in the specified cell using ordered row number.
  '========================================================================
  Public Property Get DataByRank( ByVal intRank, ByVal intCol)
    Assert intOrderedCol <> 0 , "IndexedArray.DataByRank : " _
                  & "Cannot use DataByRank until array has been sorted."
    DataByRank = arrayData( intCol, arrayIndex(intRank) )
  End Property


  '======================================================================
  ' Wrapper for insert sort procedure
  '======================================================================
  Private Sub ISort( ByVal intCol )
    InsertSort 1, intNumRowsInUse, intCol
    intOrderedCol = intCol
  End Sub


  '======================================================================
  ' Procedure that does the work for ISort
  '======================================================================
  Private Sub InsertSort( ByVal Lower, ByVal Upper, ByVal intCol )
    Dim Pass   ' One Pass for each element to be moved
    Dim CurPos ' Current position of element as it moves to the left through the array.
    Dim Done   ' Flag indicates when a shuffle is complete
    Dim Temp   ' Used in swap
    For Pass = Lower+1 To Upper
      CurPos = Pass
      Done   = False
      ' Shuffle next element left-wards through array until in correct position.
      While (CurPos >= Lower+1) And Not done
        If VComp( arrayData(intCol,arrayIndex(CurPos)), arrayData(intCol,arrayIndex(CurPos-1)), intCmpMethod ) = -1 Then
          ' Move element to left by swapping with its left neighbour
          Temp = arrayIndex( CurPos )
          arrayIndex( CurPos ) = arrayIndex( CurPos - 1 )
          arrayIndex( CurPos - 1 ) = Temp
          CurPos = CurPos - 1
        Else
          ' Once element is bigger than its left-hand
          ' neighbour it is correctly positioned.
          Done = True
        End If
      Wend
    Next
  End Sub


  '=====================================================================
  ' Wrapper for two seperate sort procedures:
  ' If the array to be sorted has less than 'LowerBound'+1 elements it
  ' calls 'InsertSort', otherwise it calls 'Quicksort'.
  '=====================================================================
  Public Sub Sort( ByVal intCol )
    If intNumRowsInUse <= LowerBound Then
      InsertSort 1, intNumRowsInUse, intCol
    Else
      QuickSort 1, intNumRowsInUse, intCol
    End If
    intOrderedCol = intCol
  End Sub


  '==================================================================
  ' The internal Quicksort routine
  '==================================================================
  Private Sub QuickSort ( ByVal Lower, ByVal Upper, byVal intCol )
    Dim PivotPosition      ' The index of the pivotal element.
    Partition Lower, Upper, PivotPosition, intCol
    ' Sort left sub-set
    If Lower < PivotPosition-1 Then
      If PivotPosition-Lower < LowerBound Then
        InsertSort Lower, PivotPosition-1, intCol
      Else
        QuickSort Lower, PivotPosition-1, intCol
      End If
    End If
    ' Sort right sub-set
    If Upper > PivotPosition+1 Then
      If Upper - PivotPosition < LowerBound Then
        InsertSort PivotPosition+1, Upper, intCol
      Else
        QuickSort PivotPosition+1, Upper, intCol
      End If
    End If
  End Sub


  '====================================================================
  ' Manipulates the pointers in the index in order to partition the
  ' the array into three subsets:
  '
  ' 1.  Somewhere in the middle is a single element chosen as the
  '     'PivotValue'.  The position of this value is returned through
  '     the 'ByRef' parameter.
  '
  ' 2.  All elements to the left of the PivotValue are <= the PivotValue
  '
  ' 3.  All elements to the right of the PivotValue are >= the PivotValue
  '
  ' Uses the 'median of 3' method to pick a pivotal value, hence will
  ' not work properly on partions with less than three elements.  This
  ' is not a problem here, because 'InserSort' is called once
  ' partitions get small.
  '====================================================================
  Private Sub Partition ( ByVal intLo, ByVal intHi, ByRef intPivotPosition, ByVal intCol )
    Dim objPivotValue          ' The value of the pivotal element.
    Dim intMedianPosition      ' Position of median element.
    Dim objTemp                ' Used in the swaps.
    Dim PointerToobjPivotValue ' Used to remember where in the data array the objPivotValue is.
    ' Calculate the middle position of the array
    intMedianPosition = (intLo+intHi) \ 2   ' \ is integer divison operator
    ' Re-arrange the pointers so that:
    ' The first pointer points to the smallest of the three values
    ' The middle position pointer points to the middle of the three values
    ' The last pointer points to the the largest of the three values
    If VComp( arrayData(intCol,arrayIndex(intMedianPosition)), arrayData(intCol,arrayIndex(intLo)), intCmpMethod ) = -1 Then
      objTemp = arrayIndex( intLo )
      arrayIndex( intLo ) = arrayIndex( intMedianPosition )
      arrayIndex( intMedianPosition ) = objTemp
    End If
    If VComp( arrayData(intCol,arrayIndex(intHi)), arrayData(intCol,arrayIndex(intMedianPosition)), intCmpMethod ) = -1 Then
      objTemp = arrayIndex( intHi )
      arrayIndex( intHi ) = arrayIndex( intMedianPosition )
      arrayIndex( intMedianPosition ) = objTemp
    End If
    If VComp( arrayData(intCol,arrayIndex(intMedianPosition)), arrayData(intCol,arrayIndex(intLo)), intCmpMethod ) = -1 Then
      objTemp = arrayIndex( intLo )
      arrayIndex( intLo ) = arrayIndex( intMedianPosition )
      arrayIndex( intMedianPosition ) = objTemp
    End If
    ' By This point the first, middle and last pointers are sorted.
    ' Set the pivot value to be the value pointed to by the middle pointer.
    objPivotValue = arrayData( intCol, arrayIndex(intMedianPosition) )
    ' Keep a record of where the MedianValue is intLocated.
    PointerToobjPivotValue = arrayIndex(intMedianPosition )
    ' As a result of the above swaps, the elements on the ends must be in
    ' appropriate partitions therefore no need to process these further.
    intLo = intLo + 1
    intHi = intHi - 1
    arrayIndex( intMedianPosition) = arrayIndex( intLo )
    ' Step in from both ends of the array until the pointers meet
    While intLo < intHi
      ' Starting from the left, step right until you either find a value
      ' greater than the objPivotValue or you bump into the 'intHi' pointer
      While VComp( objPivotValue, arrayData(intCol,arrayIndex(intHi)), intCmpMethod ) = -1 And (intLo < intHi)
        intHi = intHi - 1
      Wend
      If intLo <> intHi Then
        arrayIndex( intLo ) = arrayIndex( intHi )
        intLo = intLo + 1
      End If
      ' Starting from the right, step left until you either find a value
      ' less than the objPivotValue or you bump into the 'intLo' pointer
      While VComp( arrayData(intCol,arrayIndex(intLo)), objPivotValue, intCmpMethod ) = -1 And (intLo < intHi)
        intLo = intLo + 1
      Wend
      If intLo <> intHi Then
        arrayIndex( intHi ) = arrayIndex( intLo )
        intHi = intHi - 1
      End If
    Wend
    ' By now the pointers have met (i.e. intLo = intHi).  The place where they meet is
    ' the new pivot position, so make it point to the pivot value.
    arrayIndex( intHi ) = PointerToobjPivotValue
    ' We need to tell the calling procedure where pointers met.  This is the
    ' point that chops the set into subsets.  The 'intPivotPosition'
    ' parameter is passed 'by reference', so setting it here passes this
    ' information back to the caller.
    intPivotPosition = intHi
  End Sub


'====================================================================
' Performs a binary search of the sorted column.
' Returns the row number of the target in the main data array
'====================================================================
    Public Function BinaryLookup( ByVal objTarget )
        Dim intFirst     ' Lower boundary of current partition
        Dim intLast      ' Upper boundary of current partition
        Dim boolFound    ' Have we found it yet?
        Dim intMidPoint  ' Approximate mid-point of current partition
        boolFound = False
        intFirst  = 1
        intLast   = intNumRowsInUse
        While Not boolFound And ( intFirst <= intLast )
          intMidPoint = ( intFirst + intLast ) \ 2
          If VComp( arrayData(intOrderedCol, arrayIndex(intMidPoint)), objTarget, intCmpMethod ) = 1 Then
            intLast = intMidPoint - 1
          Else
            If VComp( arrayData(intOrderedCol, arrayIndex(intMidPoint)), objTarget, intCmpMethod ) = -1 Then
              intFirst = intMidPoint + 1
            Else
              boolFound = True
            End If
          End If
        Wend
        If boolFound Then
          BinaryLookup = arrayIndex(intMidPoint)
        Else
          BinaryLookup = 0
        End If
  End Function


End Class


'==============================================================================================
'==============================================================================================
' Main Program
'==============================================================================================
'==============================================================================================
' Constants to define columns within array of users
Const LASTLOGON          = 1
Const SAM_NAME           = 2
Const PROPER_NAME        = 3
Const DISTINGUISHED_NAME = 4
Const CN                 = 5
Const ACCOUNT_DISABLED   = 6
Const WHEN_CREATED       = 7
Const LOGIN_SCRIPT       = 8
' Constants to tell 'QueryDC' function whether we are doing a full query
' of the first DC or a partial query of a subsequent DC.
Const FIRST_DC           = True
Const OTHER_DC           = False


Dim strFirstDC          ' The name of the DC that authenticated the current user
Dim colOtherDCs         ' Collection of DCs
Dim strOUName           ' The name of the OU from which to start searching
Dim iaUsers             ' List of users' details
Dim lngTimeOffset       ' The difference between the computer's time and
                        ' Universal time as held in AD
Dim objDC               ' Holds each DC in turn

' Create and initialise dynamic array for user details
Set iaUsers = New IndexedArray
iaUsers.Initialise 8, vbTextCompare
' Create dictionary to hold list of DCs
Set colOtherDCs = CreateObject( "scripting.dictionary" )
' Call function to get local time zone
lngTimeOffset = GetLocalTimeZone
' Get OU from command line parameter
strOUName = GetTargetFQDN
' Print program name and version number
WScript.Echo "ll.vbs (v." & VerNum & ")"
WScript.Echo "Date of run = " & Date()
WScript.Echo "Time of run = " & Time() & vbCrLf
' Get a list of all DCs in the domain
GetDCs strFirstDC, colOtherDCs
' Query first DC
QueryDC strFirstDC, FIRST_DC
' Sort users by SAM account name to permit fast updates
iaUsers.Sort( SAM_NAME )
' Query each other DC in turn
For Each objDC In colOtherDCs
    QueryDC objDC, OTHER_DC
Next
' Sort by last login time
iaUsers.Sort( LASTLOGON )
' Display results
Wscript.Echo
DisplayResults
' End of main program



'==============================================================================================
'==============================================================================================
' Sub-Routines
'==============================================================================================
'==============================================================================================


'==============================================================================================
' Interprets command line argument to build FQDN of target OU / domain
'==============================================================================================
Function GetTargetFQDN
  Dim objRootDSE
  Dim strDomain
  Dim strArgument0
  Dim colTemp        ' Temporary collection of objects - used only in error checking
  If WScript.Arguments.Count > 1 Then
    ' More than one argument
    HelpInfo
    Wscript.Quit
  End If
  ' Get FQDN of current domain
  Set objRootDSE = GetObject("LDAP://rootDSE")
  strDomain = objRootDSE.Get("defaultNamingContext")
  If WScript.Arguments.Count = 1 Then
    ' One Argument
    strArgument0 = UCase(WScript.Arguments(0))
    If strComp( strArgument0, "/V" ) = 0 Or _
      strComp( strArgument0, "/VER" ) = 0 Then
      WScript.Echo strProgramName & " - " & "Version " & verNum
      WScript.Quit
    End If
    If strComp( strArgument0, "/?" ) = 0 Or _
      strComp( strArgument0, "-?" )  = 0 Or _
      StrComp( strArgument0, "/H" )  = 0 Then
      HelpInfo
      WScript.Quit
    End If
    GetTargetFQDN = addDistinguishers (strArgument0 ) & "," & strDomain
    ' Check that we can connect to the OU
    On Error Resume Next
    Set coltemp = GetObject("LDAP://" & GetTargetFQDN )
    If Err.Number <> 0 Then
      ErrorInfo
      On Error Goto 0
      WScript.Quit
    End If
  Else
    ' No OU specified
    GetTargetFQDN = strDomain
  End If
  Set colTemp = Nothing
End Function


'=======================================================================================
' Displays help information
'=======================================================================================
Sub HelpInfo
  WScript.Echo strProgramName & " (last logon)"
  WScript.Echo "Program dumps last login time for whole domain or specified OU."
  Wscript.echo
  WScript.Echo "Usage: cscript " & strProgramName & " [ path_to_OU ] [ > textfile.txt ]"
  WScript.Echo "  e.g. cscript ll.vbs users.calt.env.holding  >  c:\calt.txt"
End Sub


'=======================================================================================
' Displays error information
'=======================================================================================
Sub ErrorInfo
  WScript.Echo "Could not connect to specified OU."
  WScript.Echo VbTab & "- Is path correct?"
  WScript.Echo VbTab & "- Do you have the necessary rights?" & VbCrLf
End Sub


'=============================================================================
' Returns
' a) The name of the DC that authenticated the current login.
'     (It is assumed that this will be the closest / fastest.)
' b) A collection of all other DCs in the current domain.
'
' Pass a string and an empty collection to the procedure via the
'    reference paremeters and the procedure will populate them.
'
' Based on - Scripting Guide p.718 and code by Mueller found on the Net
'=============================================================================
Sub GetDCs( ByRef strFirstDC, ByRef colOtherDCs )
  Dim objRootDSE
  Dim objConnection
  Dim objCommand
  Dim objRecordSet
  Dim strConfig
  Dim objDC
  Dim strDomain
  Dim strDCFQDN
  Dim objWshShell
  Dim strLogonServerShortName

  ' Get the shortname of the DC that logged in the current user
  Set objWshShell = CreateObject("Wscript.Shell")
  strLogonServerShortName = objWshShell.ExpandEnvironmentStrings("%Logonserver%")
  ' Chop '\\' off front of name and convert to lower case
  strLogonServerShortName = LCase(Right(strLogonServerShortName,Len(strLogonServerShortName)-2))

  ' Get the current domain
  Set objRootDSE = GetObject("LDAP://rootDSE")
  strDomain = objRootDSE.Get("defaultNamingContext")
  ' Strip out the distiinguishers (CN= etc.)
  strDomain = LCase(StripDistinguishers( strDomain ))

  ' Append the domain to the shortname of the DC
  ' and convert it all to lower case
  strFirstDC = strLogonServerShortname & "." & strDomain

  ' Get the configuration container for the tree.
  ' This holds info about the tree's DCs
  Set objRootDSE = GetObject("LDAP://RootDSE")
  strConfig = objRootDSE.Get("configurationNamingContext")
  ' Build a query to get all of the DCs
  Set objConnection = CreateObject("ADODB.Connection")
  Set objCommand = CreateObject("ADODB.Command")
  objConnection.Provider = "ADsDSOObject"
  objConnection.Open "Active Directory Provider"
  objCommand.ActiveConnection = objConnection
  objCommand.CommandText = _
       "Select AdsPath from 'LDAP://" & strConfig & "' where objectClass='nTDSDSA'"
  objCommand.Properties("Timeout")       = 30
  objCommand.Properties("Cache Results") = False
  ' Execute the query
  Set objRecordSet = objCommand.Execute
  Do Until objRecordSet.EOF
    Set objDC = GetObject(GetObject(objRecordSet.Fields("AdsPath")).Parent)
    strDCFQDN = LCase(objDC.DNSHostName)
    ' Check that DC is in current domain - not in a parent
    If Instr( strDCFQDN, stripDistinguishers(strDomain) ) > 0 Then
      ' Avoid re-adding the logon DC
      If strComp( strFirstDC, strDCFQDN ) <> 0 Then
        colOtherDCs.Add strDCFQDN, ""
      End If
    End If
      objRecordSet.MoveNext
    Loop
End Sub


'==============================================================================================
' Contacts the specified DC and retrieves the spcified list of attributes for aach user
'==============================================================================================
Sub QueryDC( ByVal strDCName, ByVal boolFirstDC )
  ' Type of object to query for
  Const strFilter     = "(&(objectCategory=person)(objectClass=user))"
  ' Subsets of attributes to return
  Const strFullAttributes = "distinguishedName,lastLogon,givenName,sn,sAMAccountname,userAccountControl,whenCreated,scriptPath,cn"
  Const strPartAttributes = "lastLogon,sAMAccountname"
  ' Constant used in checking if account is disabled
  Const ADS_UF_ACCOUNTDISABLE = 2

  Dim strBase        ' Used to build query
  Dim strQuery       ' Holds complete query
  Dim objCommand     ' Used in executing query
  Dim objRecordSet   ' Record set returned by query
  Dim objConnection  ' Used in executing query
  Dim intPosition    ' Position within array of user already seen
  Dim strSAMName     ' SAM account name of users
  Dim lngLastLogon   ' Last log on time as returned from AD
  Dim dtmLastLogon   ' Last log on time after conversion to date / time
  Dim lngWhenCreated
  Dim strGivenName   ' User's first name
  Dim strLastName    ' User's last name
  Dim strName        ' Users complete, formatted, name
  Dim strDName       ' User's distinguihsed name
  Dim strCN          ' User's common name
  Dim boolDisabled   ' Is user's account disabled?
  Dim strScriptPath  ' User's login script
  Dim intRecordCount ' Counts number of records being processed
  Dim temp
  Wscript.Echo "Querying DC: " & strDCName
  ' Set up query
  Set objCommand = CreateObject("ADODB.Command")
  Set objConnection = CreateObject("ADODB.Connection")
  objConnection.Provider = "ADsDSOObject"
  objConnection.Open "Active Directory Provider"
  objCommand.ActiveConnection = objConnection
  objCommand.CommandText = strQuery
  ' Setting a 'Page Size' turns on paging.
  ' Paging tells the server to return the data in chunks.  In the line below,
  ' we will get 100 records per chunk.  This is important because if paging
  ' is not enabled, then only the first 1000 records are returned.
  ' This is explained at the following URL
  ' http://msdn.microsoft.com/library/default.asp? <continued on next line...>
  ' url=/library/en-us/adsi/adsi/retrieving_large_results_sets.asp
  objCommand.Properties("Page Size")     = 100
  objCommand.Properties("Timeout")       = 60
  objCommand.Properties("Cache Results") = False
  ' Query DC
  strBase = "<LDAP://" & strDCName & "/" & strOUName & ">"
  If boolFirstDC Then
    strQuery = strBase & ";" & strFilter & ";" & strFullAttributes & ";subtree"
  Else
    strQuery = strBase & ";" & strFilter & ";" & strPartAttributes & ";subtree"
  End If
  objCommand.CommandText = strQuery
  On Error Resume Next
  Set objRecordSet = objCommand.Execute
  If Err.Number <> 0 Then
    Wscript.Echo vbTab & "DC unavailable."
  Else
    ' Able to contact DC
    On Error Goto 0
    intRecordCount = 0
    Do Until objRecordSet.EOF
      ' Do these lines for ALL DCs
      intRecordCount = intRecordCount + 1
      ' Get unique name and logon time
      strSAMName = objRecordSet.Fields("sAMAccountName")
      lngLastLogon = objRecordSet.Fields("Lastlogon")
      ' Convert last logon time to a readable format
      dtmLastLogon = LastLogonDate( lngLastLogon, GetLocalTimeZone )
      If boolFirstDC Then
        ' Do this stuff only on the first DC
        '
        ' Write username and login time
        iaUsers.CreateNewRow   dtmLastLogon,   LASTLOGON
        iaUsers.PutIntoLastRow strSAMName,     SAM_NAME
        ' Get remaining attributes
        strGivenName   = GetOptionalAttribute( objRecordSet, "givenName"         )
        strLastName    = GetOptionalAttribute( objRecordSet, "sn"                )
        strDName       = GetOptionalAttribute( objRecordSet, "distinguishedName" )
        strCN          = GetOptionalAttribute( objRecordSet, "cn"                )
        strName        = Proper( strGivenName & " " & strLastName                )

        Temp           = objRecordSet.Fields("userAccountControl")
        If IsNull( Temp ) Then
          boolDisabled = True
        Else
          boolDisabled   = CBool( Temp And ADS_UF_ACCOUNTDISABLE)
        End If

        lngWhenCreated = objRecordSet.Fields("WhenCreated")
        strScriptPath  = GetOptionalAttribute( objRecordSet, "scriptPath"        )
        ' Save remaining attributes
        iaUsers.PutIntoLastRow strName,        PROPER_NAME
        iaUsers.PutIntoLastRow strDName,       DISTINGUISHED_NAME
        iaUsers.PutIntoLastRow strCN,          CN
        iaUsers.PutIntoLastRow boolDisabled,   ACCOUNT_DISABLED
        iaUsers.PutIntoLastRow lngWhenCreated, WHEN_CREATED
        iaUsers.PutIntoLastRow strScriptPath,  LOGIN_SCRIPT
      Else
        ' Do this for all DCs
        '
        ' Find this user in order to see if logon time needs updating
        intPosition = iaUsers.BinaryLookup( strSAMName )
            If intPosition > 0 Then
              ' Seen him before - so, if necessary, update last logon time.
              ' Note that we ignore any users encountered on subsequent DCs
              ' but not on the first.  This will only happen with brand new
              ' user accounts that have yet to be replicated.
              ' These are of no interest to this program.
          If dtmLastLogon > iaUsers.Data( intPosition, LASTLOGON ) Then
            iaUsers.Data( intPosition, LASTLOGON ) = dtmLastLogon
              End If
        End If
      End If
      objRecordSet.MoveNext
    Loop
    Wscript.Echo VbTab & intRecordCount & " accounts processed."
  End If
End Sub


'=======================================================================================
' My current understanding is:
'  In order to reduce the amount of data moving around the network AD
'  does not hold a full set of optional attributes for every user.
'  Instead, it only holds those attributes that have been given values.
'  Uninitialised attributes literally do not exist.
'  If you try to access an attribute that does not exist, then there
'  is no vaildation technique that can prevent your code throwing an error.
'  For this reason the only way to handle accessing optional attributes
'  is by surrounding the access with 'On Error..." statements.
'=======================================================================================
Function GetOptionalAttribute( ByVal objRecord, ByVal strAttributeName )
  On Error Resume Next
    GetOptionalAttribute = objRecord.Fields( strAttributeName )
    On Error Goto 0
    If Err.Number <> 0 Then
     GetOptionalAtrribute = ""
    End If
End Function


'=======================================================================================
' The last logon time returned by AD is expressed as the number of 100 nanosecond intervals
' since 12:00 AM January 1, 1601.  This algorithm - pinched off the Internet from R. Mueller
' - converts this to a conventional time and date.
'=======================================================================================
Function LastLogonDate( byVal LastLogon, byVal TimeOffset )
  Const TwoToThePower32  = 4294967296
  Const PeriodsPerMinute = 600000000
  Const StartDate        = #1/1/1601#
  Const MinutesPerDay    = 1440
  Dim objDate
  Dim lngHigh
  Dim lngLow
  If IsNull( LastLogon ) Then
    LastLogonDate = #1/1/1601#
  Else
    ' Vbscript cannot do arithmetic with 64-bit integers, so we convert it to an object then
    ' use the in-built HightPart and LowPart methods to split it into two 32-bit components.
    Set objDate = LastLogon
    lngHigh = objDate.HighPart
    lngLow = objDate.LowPart
    ' The 32nd bit becomes the MSB of the lower half.
    ' If this bit is 1, then the lower half is interpreted as a negative number
    ' because vbscript stores integers using two's complement - so it is intepreted as -2^32
    ' instead of +2^32  - so the overall value is 2 x 2^32 = 2^64 too low.  So add one to the
    ' second 32-bit block to compensate for this.
    If lngLow < 0 Then
      lngHigh = lngHigh + 1
    End If
    If (lngHigh = 0) And (lngLow = 0 ) Then
      LastLogonDate = #1/1/1601#
    Else
      LastLogonDate = StartDate + (((lngHigh * TwoToThePower32) + lngLow)/PeriodsPerMinute - (TimeOffset * 60) ) / MinutesPerDay
    End If
  End If
End Function


'=================================================
' Returns offset from standard time (in hours)
' Reads this info from machine registry.
'=================================================
Function GetLocalTimeZone
  Dim objShell
  Dim lngBiasKey
  Dim i
  Set objShell = CreateObject("Wscript.Shell")
  lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias")
  If UCase(TypeName(lngBiasKey)) = "LONG" Then
    GetLocalTimeZone = lngBiasKey / 60
  ElseIf UCase(TypeName(lngBiasKey)) = "VARIANT()" Then
    GetLocalTimeZone = 0
    For i = 0 To UBound(lngBiasKey)
      GetLocalTimeZone = GetLocalTimeZone + (lngBiasKey(i) * 256^i)
    Next
    GetLocalTimeZone = GetLocalTimeZone / 60
  End If
End Function


'====================================================================================
' Function returns a string changed to 'Title' case,
' and with superflouous spaces removed.
' Jim, 9th June 2004
'====================================================================================
Function Proper( byVal strInput )
  Dim ArrayofWords ' String is split into an array of individual words
  Dim objWord      ' Used for Each individual word in turn
  Dim i            ' Used to increment through the string
  Dim ch           ' The character currently being inspected
  Dim chPrevious   ' The previously inspected character
  Dim strTemp      ' Used to hold words while capitalisation is handled
  If Not IsNull( strInput ) Then
    ' Make sure its a string
    CStr( strInput )
    ' Remove leading and trailing spaces.
    strInput = Trim( strInput )
    ' Replace multiple spaces with single spaces
    Proper = ""
    chPrevious = " "
    For i = 1 To Len( strInput )
      ch = Mid( strInput, i, 1 )
      If ch <> " " Then
        Proper = Proper & ch
      Else ' Its a space
        If chPrevious <> " " Then
          Proper = Proper & ch
        End If
      End If
      chPrevious = ch
    Next
    ' Split into words
    ArrayOfWords = Split( Proper )
    Proper = ""
    ' Handles capitalisation
    For Each objWord In ArrayOfWords
      ' First letter in upper case
      strTemp = UCase( Mid( ObjWord, 1, 1 ) )
      ' Other letters in lower case
      If Len( objWord ) >= 2 Then
        For i = 2 To Len( objWord )
          strTemp = strTemp & LCase( Mid( ObjWord, i, 1 ) )
        Next
      End If
      ' Handle special cases
      If StrComp( Mid( strTemp, 1, 2 ), "O'" ) = 0 Then
        strTemp = "O'" & UCase( Mid( strTemp, 3, 1 ) ) & Right( strTemp, Len( strTemp ) - 3 )
      End If
      If StrComp( Mid( strTemp, 1, 2 ), "Mc" ) = 0 Then
        strTemp = "Mc" & UCase( Mid( strTemp, 3, 1 ) ) & Right( strTemp, Len( strTemp ) - 3 )
      End If
      ' Append a space between words
      Proper = Proper & strTemp & " "
    Next
    ' Trim trailing space
    Proper = RTrim( Proper )
  End If
End Function


'======================================================================================
' Implements 'C'-like assertions (except cannot so easily be switched off)
'======================================================================================
Sub Assert( objQuery, strMessage )
  If Not objQuery Then
    WScript.Echo VbCrlf & strMessage
    WScript.Quit
  End If
End Sub


'======================================================================================
' Versatile Compare
' Compares first two parameters.  Handles nunmbers, characters or strings.
'======================================================================================
Function VComp( byVal object1, byVal object2, strCompMethod )
  Assert TypeName( object1) = TypeName( Object2 ), "Error in VComp - comparisands of different types."
  If TypeName( object1 ) = "String" Then
    VComp = StrComp( object1, object2, strCompMethod )
    Else
      If object1 = object2 Then
        VComp = 0
      Else
        If object1 < object2 Then
          VComp = -1
        Else
          VComp = 1
      End If
    End If
    End If
End Function


'==============================================================================================
' Write output to screen.
'==============================================================================================
Sub DisplayResults
  Dim i               ' Loop control variable
  Dim strName         ' Users proper name
  Dim strOU           ' Name of OU holding account
  Dim strSAMName      ' SAM name of user account
  Dim dtmLastLogon    ' Date / time of last logon
  Dim strLastLogon    ' String showing data of last logon
  Dim strDisabled     ' Is account disabled
  Dim strScript       ' Login script
  Dim objRootDSE      ' Used in finding current domain
  Dim strDomain       ' Current domain - needed in conversion of distinguished name to OU
  Dim dtmWhenCreated  ' Date/time account was created
  Dim strCreationDate ' String showing date account was created

  ' Get the current domain - again!
  Set objRootDSE = GetObject("LDAP://rootDSE")
  strDomain = objRootDSE.Get("defaultNamingContext")
  ' Display column headings
  Wscript.Echo "Last logon" & vbTab & "Date Created" & VbTab & "User name" & VbTab & "Account name" & vbTab & "OU" & vbTab & "Enabled/Disabled" & vbTab & "login script"
  For i = 1 To iaUsers.RowCount
    ' Last logon time
    dtmLastLogon = iaUsers.DataByRank( i, LASTLOGON )
    If dtmLastLogon = #1/1/1601# Then
      strLastLogon = "Never"
    Else
      strLastLogon = Day(dtmLastLogon) & "/" & Month(dtmLastLogon) & "/" & Year(dtmLastLogon)
    End If
    ' Date created
    dtmWhenCreated = iaUsers.DatabyRank( i, WHEN_CREATED )
    strCreationDate = Day(dtmWhenCreated) & "/" & Month(dtmWhenCreated) & "/" & Year(dtmWhenCreated)
    ' Users name
    strName = iaUsers.DataByRank( i, PROPER_NAME )
    If StrComp( strName, "" ) = 0 Then
      strName = "<No Name>"
    End If
    ' Extract OU from distinguished name
    strOU = DNtoOU( iaUsers.DataByRank( i, DISTINGUISHED_NAME ), iaUsers.DataByRank( i, CN ), Len( strDomain ) )
    strSAMName = iaUsers.DatabyRank( i, SAM_NAME )
    ' Is account disabled?
    If iaUsers.DataByRank( i, ACCOUNT_DISABLED ) Then
      strDisabled = "Disabled"
    Else
      strDisabled = "Enabled"
    End If
    strScript = iaUsers.DataByRank( i, LOGIN_SCRIPT )
    If StrComp( strScript, "" ) = 0 Then
      strName = "<No login script>"
    End If
    ' Display details. Use tabs to ease import into Excel
    Wscript.Echo strLastlogon & vbTab & strCreationDate & VbTab & strName & VbTab & strSAMName & vbTab & strOU & vbTab & strDisabled & vbTab & strScript
  Next
End Sub


'=============================================================================
' Passed a distingushed name of a directory object, the common name and
' length of the name of the domaion, it returns a string representing the
' list of OUs holding the object.
'=============================================================================
Function DNtoOU ( ByVal strDN, byVal strCN, ByVal intDomainNameLength )
  Dim noDom
  Dim commacount
  Dim i
  Dim CNLength
  Dim OU

  ' Chop the domain of the end (and the comma)
  noDom = Left( strDN, Len( strDN ) - intDomainNameLength - 1)

  ' Every comma in the CN is preceeded by a \ in the DN
  ' So we need to count them and add them to the total to be removed.
  commacount = 0
  for i = 1 to len( noDom )
    if mid( noDom, i, 1 ) = Chr(92) Then
      commacount = commacount + 1
    end if
  Next

  ' Chop the CN off the front
  CNLength = Len( strCN ) + commacount + 3 ' for prefix
  OU = Right ( noDom, Len( noDom ) - CNLength )

  ' By now, if the object is in the root of the domain, OU will be ""
  ' otherwise it will still have a leading comma that needs to be removed
  if OU = "" Then
    DNtoOU = "<None>"
  else
    ' Remove comma
    OU = Right( OU, Len(OU) - 1 )
    ' Now cut out the OU= and the CN=
    OU = Replace( OU, "OU=", "" )
    OU = Replace( OU, "CN=", "" )
    DNtoOU = OU
  End If

End Function



'=============================================================================
' Passed a string of the form "CN=jim,ou=aaa,dc=xxx,o=yyy,dc=12345"
' Returns "jim.aaa.xxx.yyy.12345"  (Note: Commas replaced by full=stops.)
'=============================================================================
Function stripDistinguishers( ByVal strDName )
  Dim arrayParts
  Dim i
  Dim strtemp
  Dim intPosition
  arrayParts = Split( strDName, "," )
  strTemp = ""
  For i = LBound( arrayParts ) To UBound( arrayParts )
    intPosition = InStr( arrayParts(i), "=" )
    strTemp = strTemp & Right( arrayParts(i), Len(arrayParts(i)) - intPosition ) & "."
  Next
  stripDistinguishers = Left( strTemp, Len(strTemp) -1 )
End Function


'=============================================================================
' Passed a string of the form "a.bb.ccc.dddd"
' Returns "ou=a.ou=bb.ou=ccc.ou=dddd" - Note fullstops replaced by commas
'=============================================================================
Function addDistinguishers( ByVal strRaw )
  Dim OUs
  Dim i
  Dim strTemp

  OUs = Split( strRaw, "." )
  strTemp = ""
  For i = LBound( OUs ) To UBound( OUs )
    strTemp = strTemp & "ou=" & OUs(i) & ","
  Next
  addDistinguishers = Left( strTemp, Len(strTemp) -1 )
End Function