' AllUsersLogonHours.vbs
' VBScript program to document the logon hours of all users in the
' domain. These are the hours when each user is allowed to logon,
' as specified on the Account tab of ADUC.
'
' ----------------------------------------------------------------------
' Copyright (c) 2008 Richard L. Mueller
' Hilltop Lab web site - http://www.rlmueller.net
' Version 1.0 - April 25, 2008
' Version 1.1 - September 19, 2012 - Modify rounding of local time
'               zone bias to handle fractions of hour properly.
'
' This script is designed to be run at a command prompt, using the
' Cscript host. For example to redirect the output to a text file:
'
' cscript //nologo AllUsersLogonHours.vbs > report.txt
'
' You have a royalty-free right to use, modify, reproduce, and
' distribute this script file in any way you find useful, provided that
' you agree that the copyright owner above has no warranty, obligations,
' or liability for such use.

Option Explicit

Dim objShell, lngBias, arrstrDayOfWeek
Dim arrbytLogonHours(20)
Dim arrintLogonHoursBits(167)
Dim bytLogonHours, lngBiasKey
Dim bytLogonHour, intLogonHour, strLine
Dim k, intCounter, intLoopCounter, j, m, strDN
Dim objRootDSE, strDNSDomain, adoCommand, adoConnection
Dim strBase, strFilter, strAttributes, adoRecordset, strQuery

' Determine the time zone bias from the local registry.
' This bias does not change with Daylight Savings Time.
Set objShell = CreateObject("Wscript.Shell")
lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _
    & "TimeZoneInformation\Bias")
If (UCase(TypeName(lngBiasKey)) = "LONG") Then
    lngBias = lngBiasKey
ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
    lngBias = 0
    For k = 0 To UBound(lngBiasKey)
        lngBias = lngBias + (lngBiasKey(k) * 256^k)
    Next
End If
' Convert time zone bias to hours.
' Modified September 19, 2012, to handle fractions of an hour properly.
lngBias = Round((lngBias/60) + .1)

' Determine DNS domain name.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")

' Use ADO to search Active Directory.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection

' Search entire domain.
strBase = "<LDAP://" & strDNSDomain & ">"

' Search for all user objects.
strFilter = "(&(objectCategory=person)(objectClass=user))"

' Comma delimited list of attribute values to retrieve.
strAttributes = "distinguishedName,logonHours"

' Construct the LDAP query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

' Run the query.
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
Set adoRecordset = adoCommand.Execute

arrstrDayOfWeek = Array("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat")

' Enumerate the resulting recordset.
Do Until adoRecordset.EOF
    ' Retrieve values.
    strDN = adoRecordset.Fields("distinguishedName").Value
    bytLogonHours = adoRecordset.Fields("logonHours").Value
    Wscript.Echo strDN
    If IsNull(bytLogonHours) Then
        Wscript.Echo "    All Hours"
    Else
        ' Populate a byte array.
        For k = 1 To LenB(bytLogonHours)
            arrbytLogonHours(k - 1) = AscB(MidB(bytLogonHours, k, 1))
        Next

        ' Populate a bit array, offset by the time zone bias.
        j = 0
        For Each bytLogonHour In arrbytLogonHours
            For k = 7 To 0 Step -1
                m = 8*j + k - lngBias
                If (m < 0) Then
                    m = m + 168
                End If
                If (bytLogonHour And 2^k) <> 0 Then
                    arrintLogonHoursBits(m) = 1
                Else
                    arrintLogonHoursBits(m) = 0
                End If
            Next
            j = j + 1
        Next

        ' Output the bit array, one day per line, 24 hours per day.
        intCounter = 0
        intLoopCounter = 0
        Wscript.Echo "    Day"
        Wscript.Echo "    of   ------- Hour of the Day -------"
        Wscript.Echo "    Week M-3 3-6 6-9 9-N N-3 3-6 6-9 9-M"
        For Each intLogonHour In arrintLogonHoursBits
            If (intCounter = 0) Then
                strLine = arrstrDayOfWeek(intLoopCounter) & "  "
                intLoopCounter = intLoopCounter + 1
            End If
            strLine = strLine & intLogonHour
            intCounter  = intCounter + 1
            If (intCounter = 3) Or (intCounter = 6) _
                    Or (intCounter = 9) Or (intCounter = 12) _
                    Or (intCounter = 15) Or (intCounter = 18) _
                    Or (intCounter = 21) Then
                strLine = strLine & " "
            End If
            If (intCounter = 24) Then
                Wscript.Echo "    " & strLine
                intCounter = 0
            End If
        Next

    End If
    adoRecordset.MoveNext
Loop

' Clean up.
adoRecordset.Close
adoConnection.Close