NTFS, WMI, VbScript & listing explicit rights

This script uses WMI to enumerate each access control entry in an NTFS access control list, looking for explicit entries, that is, entries that are not inherited.

If SECURITY_PRINCIPAL is blank the script will return all explicit rights beneath granted from base path down. The script attempts to provide a summary for common rights.

Option Explicit

' Looks for a Trustee containing the SECURITY_PRINCIPAL string on
' the file system. Recurses from BASE_PATH down (file and folders).

' Set these values for the search.

Const BASE_PATH = "C:"
Const SECURITY_PRINCIPAL = "Chris"

Sub FSRecurse(strPath)
    ' Simple FS recursion

    Dim objFolder, objFile, objSubFolder

    Set objFolder = objFileSystem.GetFolder(strPath)

    For Each objFile in objFolder.Files
        CheckDescriptor objFile.Path
    Next
    For Each objSubFolder in objFolder.SubFolders
        CheckDescriptor objSubFolder.Path

        FSRecurse objSubFolder.Path
    Next

    Set objFolder = Nothing
End Sub

Sub CheckDescriptor(strPath)
    ' Look for the Trustee in the Security Descriptor and filter out
    ' inherited ACEs

    Const ACE_FLAG_INHERITED = &H10 ' 16

    Dim objSecuritySettings, objSecurityDescriptor, objACE, objTrustee

    Set objSecuritySettings = objWMIService.Get("Win32_LogicalFileSecuritySetting.Path='" & strPath & "'")
    objSecuritySettings.GetSecurityDescriptor objSecurityDescriptor

    For Each objACE in objSecurityDescriptor.dACL
        If InStr(1, objACE.Trustee.Name, SECURITY_PRINCIPAL, VbTextCompare) > 0 Then

            ' ACEFlags is binary. Must perform binary comparison.
            If objACE.ACEFlags And ACE_FLAG_INHERITED Then
                ' Problems with negation of the above.
                ' This is just easier.
            Else
                EnumAccess strPath, objACE
            End If
        End If
    Next
End Sub

Sub EnumAccess(strPath, objACE)
    ' Most access mask values have matching Folder versions. These are not
    ' numerically different, they only differ when interpreted.

    ' ACE Type

    Const ACCESS_ALLOWED_ACE_TYPE = &H0
    Const ACCESS_DENIED_ACE_TYPE  = &H1

    ' Base Access Mask values

    Const FILE_READ_DATA = &H1
    Const FILE_WRITE_DATA = &H2
    Const FILE_APPEND_DATA = &H4
    Const FILE_READ_EA = &H8
    Const FILE_WRITE_EA = &H10
    Const FILE_EXECUTE = &H20
    Const FILE_DELETE_CHILD = &H40
    Const FILE_READ_ATTRIBUTES = &H80
    Const FILE_WRITE_ATTRIBUTES = &H100
    Const FOLDER_DELETE = &H10000
    Const READ_CONTROL = &H20000
    Const WRITE_DAC = &H40000
    Const WRITE_OWNER = &H80000
    Const SYNCHRONIZE = &H100000

    ' Constructed Access Masks

    Dim FULL_CONTROL
    FULL_CONTROL = FILE_READ_DATA + FILE_WRITE_DATA + FILE_APPEND_DATA + _
    FILE_READ_EA + FILE_WRITE_EA + FILE_EXECUTE + FILE_DELETE_CHILD + _
    FILE_READ_ATTRIBUTES + FILE_WRITE_ATTRIBUTES + FOLDER_DELETE + _
    READ_CONTROL + WRITE_DAC + WRITE_OWNER + SYNCHRONIZE

    Dim READ_ONLY
    READ_ONLY = FILE_READ_DATA + FILE_READ_EA + FILE_EXECUTE + _
    FILE_READ_ATTRIBUTES + READ_CONTROL + SYNCHRONIZE

    Dim MODIFY
    MODIFY = FILE_READ_DATA + FILE_WRITE_DATA + FILE_APPEND_DATA + _
    FILE_READ_EA + FILE_WRITE_EA + FILE_EXECUTE + _
    FILE_READ_ATTRIBUTES + _
    FILE_WRITE_ATTRIBUTES + FOLDER_DELETE + READ_CONTROL + SYNCHRONIZE


    Dim strRights
    Dim intAccessMask

    WScript.Echo "Path: " & strPath
    WScript.Echo "Username: " & objACE.Trustee.Name
    WScript.Echo "Domain: " & objACE.Trustee.Domain
    WScript.Echo "ACE Flags (Decimal): " & objACE.ACEFlags

    ' ACE Type

    If objACE.ACEType = ACCESS_ALLOWED_ACE_TYPE Then
        WScript.Echo "ACE Type: Allow"
    Else
        WScript.Echo "ACE Type: Deny"
    End If

    ' Attempt to generate a basic summary of access rights

    strRights = ""
    intAccessMask = objACE.AccessMask

    If intAccessMask = FULL_CONTROL Then
        strRights = " (FullControl)"
    ElseIf intAccessMask = MODIFY Then
        strRights = " (Modify)"
    ElseIf intAccessMask = READ_ONLY Then
        strRights = " (ReadOnly)"
    End If

    ' Echo the decimal mask with any summarised rights

    WScript.Echo "Access Mask (Decimal): " & intAccessMask & strRights

    WScript.Echo
End Sub

'
' Main code block
'

Dim objFileSystem, objWMIService

Set objFileSystem = CreateObject("Scripting.FileSystemObject")
' WMI Connection to the local machine
Set objWMIService = GetObject("winmgmts:\\")

FSRecurse BASE_PATH

Set objWMIService = Nothing
Set objFileSystem = Nothing