Серый форум — VBS: получение списка всех вложенных папок с разрешениями

Re: VBS: получение списка всех вложенных папок с разрешениями

null@example.com (inock) — Fri, 02 Nov 2012 11:38:39 +0000

Заработало!

Re: VBS: получение списка всех вложенных папок с разрешениями

null@example.com (Dmitrii) — Fri, 02 Nov 2012 10:49:56 +0000

inock пишет:

по подкаталогам вообще не идет...

Верно. Приношу извинения, совсем забыл о рекурсии.
Новый вариант кода функции:

Function Get_DACLInfo(strDir)
Dim objSecSettings, objSD, objFolder
Dim objEntry, strTemp, strRes, i, j, lngMask, lngTemp
Dim arrFlagValue, arrFlagName, arrGenericValue, arrGenericName
Dim arrSieveGE, arrSieveGW, arrSieveGR, arrTemp
Const SE_DACL_PROTECTED = 4096 'Флаг-признак отключенного режима наследования каталогом безопасности NTFS от "родителя"
'--- Значения универсальных масок
Const GENERIC_ALL = &H10000000
Const GENERIC_EXECUTE = &H20000000
Const GENERIC_WRITE = &H40000000
Const GENERIC_READ = &H80000000
'------
Const ACCESS_ALLOWED_ACE_TYPE = 0 'Флаг-признак записи типа "РАЗРЕШЕНИЕ"
Const ACCESS_DENIED_ACE_TYPE = 1  'Флаг-признак записи типа "ЗАПРЕТ"
Const INHERITED_ACE = 16 'Флаг-признак того, что текущая запись DACL унаследована от родительского каталога
Const FULL_ACCESS = 983551 'Значение маски полного разрешения или запрета
Const FLAG_SYNCHRONIZE = 1048576 'Значение флага синхронизации доступа к объекту файловой системы
                                 '(в версиях ОС "2000/XP", применим только для записей типа "РАЗРЕШЕНИЕ")

arrFlagValue = Array(32, 1, 128, 8, 2, 4, 256, 16, 64, 65536, 131072, 262144, 524288)
arrFlagName = Array("Траверс папок / Выполнение файлов", _
                    "Содержание папки / Чтение данных", _
                    "Чтение атрибутов", _
                    "Чтение дополнительных атрибутов", _
                    "Создание файлов / Запись данных", _
                    "Создание папок / Дозапись данных", _
                    "Запись атрибутов", _
                    "Запись дополнительных атрибутов", _
                    "Удаление подпапок и файлов", _
                    "Удаление", _
                    "Чтение разрешений", _
                    "Смена разрешений", _
                    "Смена владельца")
                    
arrGenericValue = Array(&H20000000, &H40000000, &H80000000)
arrGenericName = Array("Выполнение (универсальная маска)", "Запись (универсальная маска)", "Чтение (универсальная маска)")
'--- Вспомогательные массивы, предназначенные для детализации универсальных масок
arrSieveGE = Array(-1, 0, -1, 0, 0, 0, 0, 0, 0, 0, -1, 0, 0)
arrSieveGW = Array(0, 0, 0, 0, -1, -1, -1, -1, 0, 0, -1, 0, 0)
arrSieveGR = Array(0, -1, -1, -1, 0, 0, 0, 0, 0, 0, -1, 0, 0)
'------

On Error Resume Next
Set objSecSettings = objWMI.Get("Win32_LogicalFileSecuritySetting.Path='" & strDir & "'")
If objSecSettings.GetSecurityDescriptor(objSD) = 0 Then
    If Err.Number = 0 Then
        If CBool(objSD.ControlFlags And SE_DACL_PROTECTED) Then
            If Err.Number = 0 Then
                If IsNull(objSD.DACL) Then
                    If Err.Number = 0 Then
                        WScript.Echo strDir & " -> DACL пуст"
                        objFile.WriteLine strDir & " -> DACL пуст"
                    Else
                        WScript.Echo strDir & " -> ошибка " & Err.Number & " чтения DACL" & vbNewLine & Err.Description
                        objFile.WriteLine strDir & " -> ошибка " & Err.Number & " чтения DACL" & vbNewLine & Err.Description
                        Err.Clear
                    End If
                Else
                    '--- Настройка правильного наименования одного из флагов маски доступа в зависимости от версии ОС
                    If intOSVersion < 60 Then arrFlagName(0) = "Обзор папок / Выполнение файлов"
                    '------
                    strRes = vbNullString
                    For Each objEntry In objSD.DACL
                        If StrComp(objEntry.Trustee.Domain, strDomain, vbtextCompare) = 0 Then
                            '--- Определение режима наследования записи и области её действия
                            If CBool(objEntry.AceFlags And INHERITED_ACE) Then
                                strTemp = " (унаследовано; "
                                lngTemp = objEntry.AceFlags - INHERITED_ACE
                            Else
                                strTemp = " (не унаследовано; "
                                lngTemp = objEntry.AceFlags
                                Select Case lngTemp
                                    Case 0: strTemp = strTemp & "действует на: только текущий каталог)"
                                    Case 1: strTemp = strTemp & "действует на: текущий каталог и его файлы)"
                                    Case 2: strTemp = strTemp & "действует на: текущий каталог и его подкаталоги)"
                                    Case 3: strTemp = strTemp & "действует на: текущий каталог, его подкаталоги и файлы)"
                                    Case 9: strTemp = strTemp & "действует на: только файлы текущего каталога)"
                                    Case 10: strTemp = strTemp & "действует на: только подкаталоги текущего каталога)"
                                    Case 11: strTemp = strTemp & "действует на: подкаталоги и файлы текущего каталога)"
                                    Case Else: strTemp = strTemp & "область действия не определена); "
                                End Select
                                strTemp = strTemp & vbNewLine & "---" & vbNewLine
                                '------
                                '--- Определение типа записи
                                If objEntry.AceType = ACCESS_ALLOWED_ACE_TYPE Then
                                    strTemp = strTemp & "РАЗРЕШЕНО:" & vbNewLine
                                ElseIf objEntry.AceType = ACCESS_DENIED_ACE_TYPE Then
                                    strTemp = strTemp & "ЗАПРЕЩЕНО:" & vbNewLine
                                End If
                                '------
                                '--- Определение значения маски "Полный доступ" в зависимости от версии ОС
                                If intOSVersion < 52 Then
                                    lngTemp = FULL_ACCESS + Abs(objEntry.AceType - 1) * FLAG_SYNCHRONIZE
                                    'Выражение FULL_ACCESS + Abs(objEntry.AceType - 1) * FLAG_SYNCHRONIZE
                                    'учитывает разницу между значениями маски "Полный доступ" у записей разных типов
                                    'в ОС версий "2000/XP"
                                Else
                                    lngTemp = FULL_ACCESS + FLAG_SYNCHRONIZE
                                End If
                                '------
                                lngMask = objEntry.AccessMask
                                Select Case Abs(lngMask)
                                    Case lngTemp: strTemp = strTemp & "Полный доступ" & vbNewLine
                                    Case GENERIC_ALL: strTemp = strTemp & "Полный доступ (универсальная маска)" & vbNewLine
                                    Case Else
                                        '--- Детальный анализ маски доступа текущей записи:
                                        'обработка универсальных масок (биты №№ 29 - 31)
                                        If Abs(lngMask) > lngTemp Then
                                            For i = 0 To UBound(arrGenericValue)
                                                If lngMask And arrGenericValue(i) Then
                                                    strTemp = strTemp & arrGenericName(i) & vbNewLine & vbTab & "{" & vbNewLine
                                                    Select Case arrGenericValue(i)
                                                        Case GENERIC_EXECUTE: arrTemp = arrSieveGE
                                                        Case GENERIC_WRITE: arrTemp = arrSieveGW
                                                        Case GENERIC_READ: arrTemp = arrSieveGR
                                                    End Select
                                                    For j = 0 To UBound(arrTemp)
                                                        If arrTemp(j) Then strTemp = strTemp & vbTab & arrFlagName(j) & vbNewLine
                                                    Next
                                                    strTemp = strTemp & vbTab & "}" & vbNewLine
                                                End If
                                            Next
                                        End If
                                        'обработка обычных масок (биты №№ 0 - 20)
                                        For i = 0 To UBound(arrFlagValue)
                                            If lngMask And arrFlagValue(i) Then
                                                strTemp = strTemp & arrFlagName(i) & vbNewLine
                                            End If
                                        Next
                                        '------
                                End Select
                                strTemp = UCase(objEntry.Trustee.Domain & "\" & objEntry.Trustee.Name) & strTemp & "===" & vbNewLine
                                strRes = strRes & strTemp
                            End If
                        End If
                    Next
                    Set objEntry = Nothing
                    If Len(strRes) > 0 Then
                        WScript.Echo strDir & " -> объект обработан"
                        objFile.WriteLine UCase(strDir) & vbNewLine & strRes
                    End If
                    For Each objFolder In objFS.GetFolder(strDir).SubFolders
                        If Err.Number = 0 Then
                            Call Get_DACLInfo(objFolder.Path)
                        Else
                            WScript.Echo objFolder.Path & " -> ошибка " & Err.Number & " обращения к объекту" & vbNewLine & Err.Description
                            objFile.WriteLine objFolder.Path & " -> ошибка " & Err.Number & " обращения к объекту" & vbNewLine & Err.Description
                            Err.Clear
                        End If
                    Next
                    Set objFolder = Nothing
                End If
            Else
                WScript.Echo objFolder.Path & " -> ошибка " & Err.Number & " определения режима наследования" & vbNewLine & Err.Description
                objFile.WriteLine objFolder.Path & " -> ошибка " & Err.Number & " определения режима наследования" & vbNewLine & Err.Description
                Err.Clear
            End If
        Else
            WScript.Echo strDir & " -> объект пропущен"
            For Each objFolder In objFS.GetFolder(strDir).SubFolders
                If Err.Number = 0 Then
                    Call Get_DACLInfo(objFolder.Path)
                Else
                    WScript.Echo objFolder.Path & " -> ошибка " & Err.Number & " обращения к объекту" & vbNewLine & Err.Description
                    objFile.WriteLine objFolder.Path & " -> ошибка " & Err.Number & " обращения к объекту" & vbNewLine & Err.Description
                    Err.Clear
                End If
            Next
            Set objFolder = Nothing
        End If
    Else
        WScript.Echo strDir & " -> ошибка " & Err.Number & " чтения дескриптора безопасности" & vbNewLine & Err.Description
        objFile.WriteLine strDir & " -> ошибка " & Err.Number & " чтения дескриптора безопасности" & vbNewLine & Err.Description
        Err.Clear
    End If
Else
    WScript.Echo strDir & " -> не удалось прочитать дескриптор безопасности"
    objFile.WriteLine strDir & " -> не удалось прочитать дескриптор безопасности"
End If
Set objSD = Nothing
Set objSecSettings = Nothing
On Error GoTo 0
End Function

Re: VBS: получение списка всех вложенных папок с разрешениями

null@example.com (inock) — Fri, 02 Nov 2012 09:59:04 +0000

Так оно по подкаталогам вообще не идет...

D:\Public\1>find "D:\Public" NTFS-ACCESS2.vbs

---------- NTFS-ACCESS2.VBS
strPath = "D:\Public" 'чфхё№ єърцшЄх Ёхры№э√щ яєЄ№'

D:\Public\1>cscript NTFS-ACCESS2.vbs
Сервер сценариев Windows (Microsoft R) версия 5.8
c Корпорация Майкрософт (Microsoft Corp.), 1996-2001. Все права защищены.

D:\Public -> объект пропущен


Готово.
Журнал работы удалён, потому что он пуст.

D:\Public\1>

Собственно, я выкрутился как смог: включил весь алгоритм определения прав внутрь конструкции If:

If InStr(strDir,"'") = 0 Then
'   wscript.echo strDir
   Set objSecSettings = objWMI.Get("Win32_LogicalFileSecuritySetting.Path='" & strDir & "'")

и далее по тексту (оно запиналось на файлах и каталогах, в именах которых присутствовал символ ')

А каталоги, в которых есть ненаследуемые права отфильровал через find "не унаследовано" FoldersDACL.log

Оно может и не изящно, но чего надо добился )

Re: VBS: получение списка всех вложенных папок с разрешениями

null@example.com (Dmitrii) — Fri, 02 Nov 2012 09:30:29 +0000

inock, попробуйте такой вариант:

Public objWMI, objFS, objFile, strDomain, intOSVersion
Dim objWsNet, objCollection, objItem, strPath, strLog
strPath = "X:\Folder" 'здесь укажите реальный путь
strLog = "FoldersDACL.log"
Set objWsNet = CreateObject("WScript.Network")
strDomain = objWsNet.UserDomain
Set objWsNet = Nothing
Set objFS = CreateObject("Scripting.FileSystemObject")
If objFS.FolderExists(strPath) Then
    Set objWMI = GetObject("winmgmts:\\.\root\cimv2")
    Set objCollection = objWMI.ExecQuery("SELECT Version FROM Win32_OperatingSystem")
    For Each objItem In objCollection
        intOSVersion = CInt(Replace(Left(objItem.Version, 3), ".", ""))
    Next
    Set objCollection = Nothing
        strLog = objFS.BuildPath(objFS.GetParentFolderName(WScript.ScriptFullName), strLog)
    Set objFile = objFS.CreateTextFile(strLog, True)
    Call Get_DACLInfo(strPath)
    objFile.Close
    Set objFile = Nothing
        If objFS.GetFile(strLog).Size = 0 Then
            On Error Resume Next
            objFS.DeleteFile strLog, True
            If Err.Number = 0 Then
                WScript.Echo vbNewLine & vbNewLine & "Готово." & vbNewLine & _
                            "Журнал работы удалён, потому что он пуст."
            Else
                Err.Clear
                WScript.Echo vbNewLine & vbNewLine & "Готово." & vbNewLine & _
                            "Журнал работы пуст, но удалить его не удалось."
            End If
        Else
            WScript.Echo vbNewLine & vbNewLine & "Готово." & vbNewLine & "Журнал работы: " & UCase(strLog)
        End If
    Set objWMI = Nothing
Else
    WScript.Echo "Не найден путь " & UCase(strPath)
End If
Set objFS = Nothing
WScript.Quit 0

'======

Function Get_DACLInfo(strDir)
Dim objSecSettings, objSD, objFolder
Dim objEntry, strTemp, strRes, i, j, lngMask, lngTemp
Dim arrFlagValue, arrFlagName, arrGenericValue, arrGenericName
Dim arrSieveGE, arrSieveGW, arrSieveGR, arrTemp
Const SE_DACL_PROTECTED = 4096 'Флаг-признак отключенного режима наследования каталогом безопасности NTFS от "родителя"
'--- Значения универсальных масок
Const GENERIC_ALL = &H10000000
Const GENERIC_EXECUTE = &H20000000
Const GENERIC_WRITE = &H40000000
Const GENERIC_READ = &H80000000
'------
Const ACCESS_ALLOWED_ACE_TYPE = 0 'Флаг-признак записи типа "РАЗРЕШЕНИЕ"
Const ACCESS_DENIED_ACE_TYPE = 1  'Флаг-признак записи типа "ЗАПРЕТ"
Const INHERITED_ACE = 16 'Флаг-признак того, что текущая запись DACL унаследована от родительского каталога
Const FULL_ACCESS = 983551 'Значение маски полного разрешения или запрета
Const FLAG_SYNCHRONIZE = 1048576 'Значение флага синхронизации доступа к объекту файловой системы
                                 '(в версиях ОС "2000/XP", применим только для записей типа "РАЗРЕШЕНИЕ")

arrFlagValue = Array(32, 1, 128, 8, 2, 4, 256, 16, 64, 65536, 131072, 262144, 524288)
arrFlagName = Array("Траверс папок / Выполнение файлов", _
                    "Содержание папки / Чтение данных", _
                    "Чтение атрибутов", _
                    "Чтение дополнительных атрибутов", _
                    "Создание файлов / Запись данных", _
                    "Создание папок / Дозапись данных", _
                    "Запись атрибутов", _
                    "Запись дополнительных атрибутов", _
                    "Удаление подпапок и файлов", _
                    "Удаление", _
                    "Чтение разрешений", _
                    "Смена разрешений", _
                    "Смена владельца")
                    
arrGenericValue = Array(&H20000000, &H40000000, &H80000000)
arrGenericName = Array("Выполнение (универсальная маска)", "Запись (универсальная маска)", "Чтение (универсальная маска)")
'--- Вспомогательные массивы, предназначенные для детализации универсальных масок
arrSieveGE = Array(-1, 0, -1, 0, 0, 0, 0, 0, 0, 0, -1, 0, 0)
arrSieveGW = Array(0, 0, 0, 0, -1, -1, -1, -1, 0, 0, -1, 0, 0)
arrSieveGR = Array(0, -1, -1, -1, 0, 0, 0, 0, 0, 0, -1, 0, 0)
'------

On Error Resume Next
Set objSecSettings = objWMI.Get("Win32_LogicalFileSecuritySetting.Path='" & strDir & "'")
If objSecSettings.GetSecurityDescriptor(objSD) = 0 Then
    If Err.Number = 0 Then
        If CBool(objSD.ControlFlags And SE_DACL_PROTECTED) Then
            If Err.Number = 0 Then
                If IsNull(objSD.DACL) Then
                    If Err.Number = 0 Then
                        WScript.Echo strDir & " -> DACL пуст"
                        objFile.WriteLine strDir & " -> DACL пуст"
                    Else
                        WScript.Echo strDir & " -> ошибка " & Err.Number & " чтения DACL" & vbNewLine & Err.Description
                        objFile.WriteLine strDir & " -> ошибка " & Err.Number & " чтения DACL" & vbNewLine & Err.Description
                        Err.Clear
                    End If
                Else
                    '--- Настройка правильного наименования одного из флагов маски доступа в зависимости от версии ОС
                    If intOSVersion < 60 Then arrFlagName(0) = "Обзор папок / Выполнение файлов"
                    '------
                    strRes = vbNullString
                    For Each objEntry In objSD.DACL
                        If StrComp(objEntry.Trustee.Domain, strDomain, vbtextCompare) = 0 Then
                            '--- Определение режима наследования записи и области её действия
                            If CBool(objEntry.AceFlags And INHERITED_ACE) Then
                                strTemp = " (унаследовано; "
                                lngTemp = objEntry.AceFlags - INHERITED_ACE
                            Else
                                strTemp = " (не унаследовано; "
                                lngTemp = objEntry.AceFlags
                                Select Case lngTemp
                                    Case 0: strTemp = strTemp & "действует на: только текущий каталог)"
                                    Case 1: strTemp = strTemp & "действует на: текущий каталог и его файлы)"
                                    Case 2: strTemp = strTemp & "действует на: текущий каталог и его подкаталоги)"
                                    Case 3: strTemp = strTemp & "действует на: текущий каталог, его подкаталоги и файлы)"
                                    Case 9: strTemp = strTemp & "действует на: только файлы текущего каталога)"
                                    Case 10: strTemp = strTemp & "действует на: только подкаталоги текущего каталога)"
                                    Case 11: strTemp = strTemp & "действует на: подкаталоги и файлы текущего каталога)"
                                    Case Else: strTemp = strTemp & "область действия не определена); "
                                End Select
                                strTemp = strTemp & vbNewLine & "---" & vbNewLine
                                '------
                                '--- Определение типа записи
                                If objEntry.AceType = ACCESS_ALLOWED_ACE_TYPE Then
                                    strTemp = strTemp & "РАЗРЕШЕНО:" & vbNewLine
                                ElseIf objEntry.AceType = ACCESS_DENIED_ACE_TYPE Then
                                    strTemp = strTemp & "ЗАПРЕЩЕНО:" & vbNewLine
                                End If
                                '------
                                '--- Определение значения маски "Полный доступ" в зависимости от версии ОС
                                If intOSVersion < 52 Then
                                    lngTemp = FULL_ACCESS + Abs(objEntry.AceType - 1) * FLAG_SYNCHRONIZE
                                    'Выражение FULL_ACCESS + Abs(objEntry.AceType - 1) * FLAG_SYNCHRONIZE
                                    'учитывает разницу между значениями маски "Полный доступ" у записей разных типов
                                    'в ОС версий "2000/XP"
                                Else
                                    lngTemp = FULL_ACCESS + FLAG_SYNCHRONIZE
                                End If
                                '------
                                lngMask = objEntry.AccessMask
                                Select Case Abs(lngMask)
                                    Case lngTemp: strTemp = strTemp & "Полный доступ" & vbNewLine
                                    Case GENERIC_ALL: strTemp = strTemp & "Полный доступ (универсальная маска)" & vbNewLine
                                    Case Else
                                        '--- Детальный анализ маски доступа текущей записи:
                                        'обработка универсальных масок (биты №№ 29 - 31)
                                        If Abs(lngMask) > lngTemp Then
                                            For i = 0 To UBound(arrGenericValue)
                                                If lngMask And arrGenericValue(i) Then
                                                    strTemp = strTemp & arrGenericName(i) & vbNewLine & vbTab & "{" & vbNewLine
                                                    Select Case arrGenericValue(i)
                                                        Case GENERIC_EXECUTE: arrTemp = arrSieveGE
                                                        Case GENERIC_WRITE: arrTemp = arrSieveGW
                                                        Case GENERIC_READ: arrTemp = arrSieveGR
                                                    End Select
                                                    For j = 0 To UBound(arrTemp)
                                                        If arrTemp(j) Then strTemp = strTemp & vbTab & arrFlagName(j) & vbNewLine
                                                    Next
                                                    strTemp = strTemp & vbTab & "}" & vbNewLine
                                                End If
                                            Next
                                        End If
                                        'обработка обычных масок (биты №№ 0 - 20)
                                        For i = 0 To UBound(arrFlagValue)
                                            If lngMask And arrFlagValue(i) Then
                                                strTemp = strTemp & arrFlagName(i) & vbNewLine
                                            End If
                                        Next
                                        '------
                                End Select
                                strTemp = UCase(objEntry.Trustee.Domain & "\" & objEntry.Trustee.Name) & strTemp & "===" & vbNewLine
                                strRes = strRes & strTemp
                            End If
                        End If
                    Next
                    Set objEntry = Nothing
                    If Len(strRes) > 0 Then
                        WScript.Echo strDir & " -> объект обработан"
                        objFile.WriteLine UCase(strDir) & vbNewLine & strRes
                    End If
                    For Each objFolder In objFS.GetFolder(strDir).SubFolders
                        If Err.Number = 0 Then
                            Call Get_DACLInfo(objFolder.Path)
                        Else
                            WScript.Echo objFolder.Path & " -> ошибка " & Err.Number & " обращения к объекту" & vbNewLine & Err.Description
                            objFile.WriteLine objFolder.Path & " -> ошибка " & Err.Number & " обращения к объекту" & vbNewLine & Err.Description
                            Err.Clear
                        End If
                    Next
                    Set objFolder = Nothing
                End If
            Else
                WScript.Echo objFolder.Path & " -> ошибка " & Err.Number & " определения режима наследования" & vbNewLine & Err.Description
                objFile.WriteLine objFolder.Path & " -> ошибка " & Err.Number & " определения режима наследования" & vbNewLine & Err.Description
                Err.Clear
            End If
        Else
            WScript.Echo strDir & " -> объект пропущен"
        End If
    Else
        WScript.Echo strDir & " -> ошибка " & Err.Number & " чтения дескриптора безопасности" & vbNewLine & Err.Description
        objFile.WriteLine strDir & " -> ошибка " & Err.Number & " чтения дескриптора безопасности" & vbNewLine & Err.Description
        Err.Clear
    End If
Else
    WScript.Echo strDir & " -> не удалось прочитать дескриптор безопасности"
    objFile.WriteLine strDir & " -> не удалось прочитать дескриптор безопасности"
End If
Set objSD = Nothing
Set objSecSettings = Nothing
On Error GoTo 0
End Function

Re: VBS: получение списка всех вложенных папок с разрешениями

null@example.com (inock) — Fri, 02 Nov 2012 05:07:40 +0000

Dmitrii пишет:

nostro, думаю, Вам подойдёт что-то такое (консольный вариант):

Мне бы такое точно подошло К сожалению, скрипт сложноват для моего понимания, не могли бы вы подсказать, что в нем надо переписать чтобы:

1. В лог писались только те каталоги, права на которые не наследуются от родителей. Если же права унаследованы, но просто ничего не пишем.
2. Обрабатывались ошибки так, чтобы скрипт не вылетал на полдороге, а продолжал обрабатывать остальные пути:

D:\Public\Common\Папка обмена\Алевтине\2012 - Григорий Лепс - Лучшее (FLAC)\CD 2
 -> объект обработан
D:\Public\Common\Папка обмена\Алевтине\2012 - Григорий Лепс - Лучшее (FLAC)\Cove
rs -> объект обработан
D:\NTFS-ACCESS.vbs(74, 1) SWbemServicesEx: Invalid object path

Спасибо

Re: VBS: получение списка всех вложенных папок с разрешениями

null@example.com (Dmitrii) — Tue, 23 Oct 2012 12:03:59 +0000

nostro, думаю, Вам подойдёт что-то такое (консольный вариант):

Public objWMI, objFS, objFile, strDomain, intOSVersion
Dim objWsNet, objCollection, objItem, strPath, strLog
strPath = "X:\Folder" 'здесь укажите реальный путь
strLog = "FoldersDACL.log"
Set objWsNet = CreateObject("WScript.Network")
strDomain = objWsNet.UserDomain
Set objWsNet = Nothing
Set objFS = CreateObject("Scripting.FileSystemObject")
If objFS.FolderExists(strPath) Then
    Set objWMI = GetObject("winmgmts:\\.\root\cimv2")
    Set objCollection = objWMI.ExecQuery("SELECT Version FROM Win32_OperatingSystem")
    For Each objItem In objCollection
        intOSVersion = CInt(Replace(Left(objItem.Version, 3), ".", ""))
    Next
    Set objCollection = Nothing
    Set objFile = objFS.CreateTextFile(objFS.BuildPath(objFS.GetParentFolderName(WScript.ScriptFullName), strLog), True)
    Call Get_DACLInfo(strPath)
    objFile.Close
    Set objFile = Nothing
    Set objWMI = Nothing
    WScript.Echo vbNewLine & vbNewLine & "Готово"
Else
    WScript.Echo "Не найден путь " & UCase(strPath)
End If
Set objFS = Nothing
WScript.Quit 0

'======

Function Get_DACLInfo(strDir)
Dim objSecSettings, objSD, objFolder
Dim objEntry, strTemp, strRes, i, j, lngMask, lngTemp
Dim arrFlagValue, arrFlagName, arrGenericValue, arrGenericName
Dim arrSieveGE, arrSieveGW, arrSieveGR, arrTemp
'--- Значения универсальных масок
Const GENERIC_ALL = &H10000000
Const GENERIC_EXECUTE = &H20000000
Const GENERIC_WRITE = &H40000000
Const GENERIC_READ = &H80000000
'------
Const ACCESS_ALLOWED_ACE_TYPE = 0 'Флаг-признак записи типа "РАЗРЕШЕНИЕ"
Const ACCESS_DENIED_ACE_TYPE  = 1 'Флаг-признак записи типа "ЗАПРЕТ"
Const INHERITED_ACE = 16 'Флаг-признак того, что текущая запись DACL унаследована от родительского каталога 
Const FULL_ACCESS = 983551 'Значение маски полного разрешения или запрета
Const FLAG_SYNCHRONIZE = 1048576 'Значение флага синхронизации доступа к объекту файловой системы
                                 '(в версиях ОС "2000/XP", применим только для записей типа "РАЗРЕШЕНИЕ")

arrFlagValue = Array(32, 1, 128, 8, 2, 4, 256, 16, 64, 65536, 131072, 262144, 524288)
arrFlagName = Array("Траверс папок / Выполнение файлов", _
                    "Содержание папки / Чтение данных", _
                    "Чтение атрибутов", _
                    "Чтение дополнительных атрибутов", _
                    "Создание файлов / Запись данных", _
                    "Создание папок / Дозапись данных", _
                    "Запись атрибутов", _
                    "Запись дополнительных атрибутов", _
                    "Удаление подпапок и файлов", _
                    "Удаление", _
                    "Чтение разрешений", _
                    "Смена разрешений", _
                    "Смена владельца")
                    
arrGenericValue = Array(&H20000000, &H40000000, &H80000000)
arrGenericName = Array("Выполнение (универсальная маска)", "Запись (универсальная маска)", "Чтение (универсальная маска)")
'--- Вспомогательные массивы, предназначенные для детализации универсальных масок
arrSieveGE = Array(-1, 0, -1, 0, 0, 0, 0, 0, 0, 0, -1, 0, 0)
arrSieveGW = Array(0, 0, 0, 0, -1, -1, -1, -1, 0, 0, -1, 0, 0)
arrSieveGR = Array(0, -1, -1, -1, 0, 0, 0, 0, 0, 0, -1, 0, 0)
'------

Set objSecSettings = objWMI.Get("Win32_LogicalFileSecuritySetting.Path='" & strDir & "'")
If objSecSettings.GetSecurityDescriptor(objSD) = 0 Then
    If IsNull(objSD.DACL) Then
        WScript.Echo strDir & " -> DACL пуст"
        objFile.WriteLine strDir & " -> DACL пуст"
    Else
        '--- Настройка правильного наименования одного из флагов маски доступа в зависимости от версии ОС
        If intOSVersion < 60 Then arrFlagName(0) = "Обзор папок / Выполнение файлов"
        '------
        strRes = vbNullString
        For Each objEntry In objSD.DACL
            If StrComp(objEntry.Trustee.Domain, strDomain, vbtextCompare) = 0 Then
                '--- Определение режима наследования записи и области её действия
                If CBool(objEntry.AceFlags And INHERITED_ACE) Then
                    strTemp = " (унаследовано; "
                    lngTemp = objEntry.AceFlags - INHERITED_ACE
                Else
                    strTemp = " (не унаследовано; "
                    lngTemp = objEntry.AceFlags
                End If
                Select Case lngTemp
                    Case 0: strTemp = strTemp & "действует на: только текущий каталог)"
                    Case 1: strTemp = strTemp & "действует на: текущий каталог и его файлы)"
                    Case 2: strTemp = strTemp & "действует на: текущий каталог и его подкаталоги)"
                    Case 3: strTemp = strTemp & "действует на: текущий каталог, его подкаталоги и файлы)"
                    Case 9: strTemp = strTemp & "действует на: только файлы текущего каталога)"
                    Case 10: strTemp = strTemp & "действует на: только подкаталоги текущего каталога)"
                    Case 11: strTemp = strTemp & "действует на: подкаталоги и файлы текущего каталога)"
                    Case Else: strTemp = strTemp & "область действия не определена); "
                End Select
                strTemp = strTemp & vbNewLine & "---" & vbNewLine
                '------
                '--- Определение типа записи
                If objEntry.AceType = ACCESS_ALLOWED_ACE_TYPE Then
                    strTemp = strTemp & "РАЗРЕШЕНО:" & vbNewLine
                ElseIf objEntry.AceType = ACCESS_DENIED_ACE_TYPE Then
                    strTemp = strTemp & "ЗАПРЕЩЕНО:" & vbNewLine
                End If
                '------
                '--- Определение значения маски "Полный доступ" в зависимости от версии ОС
                If intOSVersion < 52 Then
                    lngTemp = FULL_ACCESS + Abs(objEntry.AceType - 1) * FLAG_SYNCHRONIZE
                    'Выражение FULL_ACCESS + Abs(objEntry.AceType - 1) * FLAG_SYNCHRONIZE
                    'учитывает разницу между значениями маски "Полный доступ" у записей разных типов
                    'в ОС версий "2000/XP"
                Else
                    lngTemp = FULL_ACCESS + FLAG_SYNCHRONIZE
                End If
                '------
                lngMask = objEntry.AccessMask
                Select Case Abs(lngMask)
                    Case lngTemp: strTemp = strTemp & "Полный доступ" & vbNewLine
                    Case GENERIC_ALL: strTemp = strTemp & "Полный доступ (универсальная маска)" & vbNewLine
                    Case Else
                        '--- Детальный анализ маски доступа текущей записи:
                        'обработка универсальных масок (биты №№ 29 - 31)
                        If Abs(lngMask) > lngTemp Then
                            For i = 0 To UBound(arrGenericValue)
                                If lngMask And arrGenericValue(i) Then
                                    strTemp = strTemp & arrGenericName(i) & vbNewLine & vbTab & "{" & vbNewLine
                                    Select Case arrGenericValue(i)
                                        Case GENERIC_EXECUTE: arrTemp = arrSieveGE
                                        Case GENERIC_WRITE: arrTemp = arrSieveGW
                                        Case GENERIC_READ: arrTemp = arrSieveGR
                                    End Select
                                    For j = 0 To UBound(arrTemp)
                                        If arrTemp(j) Then strTemp = strTemp & vbTab & arrFlagName(j) & vbNewLine
                                    Next
                                    strTemp = strTemp & vbTab & "}" & vbNewLine
                                End If
                            Next
                        End If
                        'обработка обычных масок (биты №№ 0 - 20)
                        For i = 0 To UBound(arrFlagValue)
                            If lngMask And arrFlagValue(i) Then
                                strTemp = strTemp & arrFlagName(i) & vbNewLine
                            End If
                        Next
                        '------
                End Select
                strTemp = UCase(objEntry.Trustee.Domain & "\" & objEntry.Trustee.Name) & strTemp & "===" & vbNewLine
                strRes = strRes & strTemp
            End If
        Next
        Set objEntry = Nothing
        If Len(strRes) > 0 Then
            WScript.Echo strDir & " -> объект обработан"
            objFile.WriteLine UCase(strDir) & vbNewLine & strRes
        End If
        For Each objFolder In objFS.GetFolder(strDir).SubFolders
            Call Get_DACLInfo(objFolder.Path)
        Next
        Set objFolder = Nothing
    End If
Else
    WScript.Echo strDir & " -> не удалось прочитать дескриптор безопасности"
    objFile.WriteLine strDir & " -> не удалось прочитать дескриптор безопасности"
End If
Set objSD = Nothing
Set objSecSettings = Nothing
End Function

Re: VBS: получение списка всех вложенных папок с разрешениями

null@example.com (alexii) — Tue, 23 Oct 2012 12:00:54 +0000

Приведите пример с гипотетическим Continue.

Re: VBS: получение списка всех вложенных папок с разрешениями

null@example.com (nostro) — Tue, 23 Oct 2012 11:37:35 +0000

alexii пишет:

Скажите, в VBS есть что-то типа Continue при выполнении цикла, чтобы при определенном условии цикл ничего не делал, но переходил на следующую итерацию?
Нет. Просто используйте условие, чтобы пропускать должную часть кода.

Стесняюсь своей безграмотности, но как? Я просто не часто вынужден писать на VBS, так что многих простых и очевидных для других вещей не знаю...

Re: VBS: получение списка всех вложенных папок с разрешениями

null@example.com (alexii) — Tue, 23 Oct 2012 09:49:40 +0000

Скажите, в VBS есть что-то типа Continue при выполнении цикла, чтобы при определенном условии цикл ничего не делал, но переходил на следующую итерацию?

Нет. Просто используйте условие, чтобы пропускать должную часть кода.

Re: VBS: получение списка всех вложенных папок с разрешениями

null@example.com (nostro) — Tue, 23 Oct 2012 06:49:40 +0000

Спасибо! Вот, что получилось:

Option Explicit

Dim rootFolder, objFSO
Dim subFolder
Dim objShell, objFolder, strPath
Dim objWsNet, strDomain, strComputer, blnIsDomain, intOSVersion
Dim objWMI, objCollection, objItem, objSecSettings, objSD
Dim strAccount, strSID, strList
Dim intHasAccount 'Флаг-признак режима работы:
                  '-1 - не составлять список, т.к. указанная "учётка" не найдена;
                  '0  - составлять полный список;
                  '1  - составлять частичный список (только для указанной "учётки").
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Выбор каталога", &h10 + &h200, &h11)
If Not objFolder Is Nothing Then
    strPath = objFolder.Self.Path
    Set objWsNet = CreateObject("WScript.Network")
    strDomain = objWsNet.UserDomain
    strComputer = objWsNet.ComputerName
    Set objWsNet = Nothing
    If StrComp(strDomain, strComputer, vbTextCompare) <> 0 Then blnIsDomain = True
    Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    '--- Определение версии ОС
    Set objCollection = objWMI.ExecQuery("SELECT Version FROM Win32_OperatingSystem")
    For Each objItem In objCollection
        intOSVersion = CInt(Replace(Left(objItem.Version, 3), ".", ""))
    Next
    Set objItem = Nothing
    '------
    strAccount = Trim(InputBox("Имя пользователя или группы" & vbNewLine & _
                                "(при составлении полного списка -" & vbNewLine & _
                                "не указывать):", "Проверка настроек безопасности NTFS"))
    intHasAccount = 0
    If Len(strAccount) > 0 Then
        strAccount = Replace(strAccount, """", "")
        '--- Настройка правильного наименования "учётки" локальной ОС в зависимости от версии ОС
        If intOSVersion < 61 Then
            strAccount = Replace(strAccount, "Система", "System", 1, -1, vbTextCompare)
        Else
            strAccount = Replace(strAccount, "System", "Система", 1, -1, vbTextCompare)
        End If
        '------
        If StrComp(strAccount, "System", vbTextCompare) = 0 Or StrComp(strAccount, "Система", vbTextCompare) = 0 Or _
            StrComp(strAccount, "Все", vbTextCompare) = 0 Then
            strDomain = vbNullString
        Else
            If blnIsDomain Then
                If MsgBox("Задана доменная учётная запись?", vbYesNo + vbQuestion, "Проверка настроек безопасности NTFS") = vbNo Then
                    strDomain = strComputer
                End If
            Else
                strDomain = strComputer
            End If
        End If
        '--- Поиск заданной "учётки" на локальном компьютере или в Active Directory
        If Len(strDomain) > 0 Then
            Set objCollection = objWMI.ExecQuery("SELECT SID FROM Win32_Account WHERE Domain='" & strDomain & "' AND Name='" & strAccount & "'")
        Else
            Set objCollection = objWMI.ExecQuery("SELECT SID FROM Win32_Account WHERE Name='" & strAccount & "'")
        End If
        '------
        If objCollection.Count > 0 Then
            intHasAccount = 1
            '--- Определение SID заданной "учётки"
            For Each objItem In objCollection
                strSID = UCase(objItem.SID)
            Next
            '------
        Else
            intHasAccount = -1
        End If
    End If
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    ShowSubFolders objFSO.GetFolder(strPath)
    Sub ShowSubFolders(Folder)
         For Each Subfolder in Folder.SubFolders
          WScript.Echo Subfolder.Path
              If intHasAccount >=0 Then
                Set objSecSettings = objWMI.Get("Win32_LogicalFileSecuritySetting.Path='" & Subfolder.Path & "'")
                If objSecSettings.GetSecurityDescriptor(objSD) = 0 Then 'Чтение содержимого дескриптора безопасности каталога
                    strList = vbNullString
                    If Not IsNull(objSD.DACL) Then 'Проверка наличия хотя бы одной записи в DACL каталога
                        Call Get_DACLInfo(objSD.DACL, strList, intHasAccount, strSID, intOSVersion)
                        If Len(strList) > 0 Then
                            WScript.Echo strList 'Вывод на экран
                            Dim fso, tf
                              Set fso = CreateObject("Scripting.FileSystemObject")
                              Set tf = fso.OpenTextFile("d:\1.csv", 8)
                              tf.WriteLine(strList)
                            tf.Close
                        Else
                            WScript.Echo "В DACL не обнаружено ни одной записи для объекта " & UCase(strDomain & "\" & strAccount)
                        End If
                    Else
                        WScript.Echo "Список управления доступом к каталогу " & UCase(strPath) & " пуст."
                    End If
                Else
                    WScript.Echo "Не удалось прочитать дескриптор безопасности каталога " & UCase(strPath)
                End If
              Else
                WScript.Echo "Учётная запись объекта " & UCase(strDomain & "\" & strAccount) & " не найдена."
              End If
         ShowSubFolders Subfolder
         Next
    End Sub 
    Set objSecSettings = Nothing
    Set objCollection = Nothing
    Set objWMI = Nothing
Else
    WScript.Echo "Каталог не выбран."
End If
Set objFolder = Nothing
Set objShell = Nothing
WScript.Quit 0

'======

Function Get_DACLInfo(arrACE(), strRes, intMode, strAccSID, intVer)
Dim objEntry, strTemp, i, j, lngMask, lngTemp
Dim arrFlagValue, arrFlagName, arrGenericValue, arrGenericName
Dim arrSieveGE, arrSieveGW, arrSieveGR, arrTemp
Const PART_MODE = 1 'Флаг-признак составления частичного списка
'--- Значения универсальных масок
Const GENERIC_ALL = &H10000000
Const GENERIC_EXECUTE = &H20000000
Const GENERIC_WRITE = &H40000000
Const GENERIC_READ = &H80000000
'------
Const ACCESS_ALLOWED_ACE_TYPE = 0 'Флаг-признак записи типа "РАЗРЕШЕНИЕ"
Const ACCESS_DENIED_ACE_TYPE  = 1 'Флаг-признак записи типа "ЗАПРЕТ"
Const INHERITED_ACE = 16 'Флаг-признак того, что текущая запись DACL унаследована от родительского каталога 
Const FULL_ACCESS = 983551 'Значение маски полного разрешения или запрета
Const FLAG_SYNCHRONIZE = 1048576 'Значение флага синхронизации доступа к объекту файловой системы
                                 '(в версиях ОС "2000/XP", применим только для записей типа "РАЗРЕШЕНИЕ")

'arrFlagValue = Array(&H20, &H1, &H80, &H8, &H2, &H4, &H100, &H10, &H40, &H10000, &H20000, &H40000, &H80000)
arrFlagValue = Array(32, 1, 128, 8, 2, 4, 256, 16, 64, 65536, 131072, 262144, 524288)
arrFlagName = Array("Траверс папок / Выполнение файлов, ", _
                    "Содержание папки / Чтение данных, ", _
                    "Чтение атрибутов, ", _
                    "Чтение дополнительных атрибутов, ", _
                    "Создание файлов / Запись данных, ", _
                    "Создание папок / Дозапись данных, ", _
                    "Запись атрибутов, ", _
                    "Запись дополнительных атрибутов, ", _
                    "Удаление подпапок и файлов, ", _
                    "Удаление, ", _
                    "Чтение разрешений, ", _
                    "Смена разрешений, ", _
                    "Смена владельца, ")
                    
arrGenericValue = Array(&H20000000, &H40000000, &H80000000)
'arrGenericValue = Array(536870912, 1073741824, 2147483648)
arrGenericName = Array("Выполнение (универсальная маска)", "Запись (универсальная маска)", "Чтение (универсальная маска)")
'--- Вспомогательные массивы, предназначенные для детализации универсальных масок
arrSieveGE = Array(-1, 0, -1, 0, 0, 0, 0, 0, 0, 0, -1, 0, 0)
arrSieveGW = Array(0, 0, 0, 0, -1, -1, -1, -1, 0, 0, -1, 0, 0)
arrSieveGR = Array(0, -1, -1, -1, 0, 0, 0, 0, 0, 0, -1, 0, 0)
'------

'--- Настройка правильного наименования одного из флагов маски доступа в зависимости от версии ОС
If intVer < 60 Then
    arrFlagName(0) = "Обзор папок / Выполнение файлов"
End If
'------
For Each objEntry In arrACE
    '--- Определение режима наследования записи и области её действия
    If CBool(objEntry.AceFlags And INHERITED_ACE) Then
        strTemp = " (унаследовано, "
        lngTemp = objEntry.AceFlags - INHERITED_ACE
    Else
        strTemp = " (не унаследовано, "
        lngTemp = objEntry.AceFlags
    End If
    Select Case lngTemp
        Case 0: strTemp = strTemp & "действует на: только текущий каталог)"
        Case 1: strTemp = strTemp & "действует на: текущий каталог и его файлы)"
        Case 2: strTemp = strTemp & "действует на: текущий каталог и его подкаталоги)"
        Case 3: strTemp = strTemp & "действует на: текущий каталог, его подкаталоги и файлы)"
        Case 9: strTemp = strTemp & "действует на: только файлы текущего каталога)"
        Case 10: strTemp = strTemp & "действует на: только подкаталоги текущего каталога)"
        Case 11: strTemp = strTemp & "действует на: подкаталоги и файлы текущего каталога)"
        Case Else: strTemp = strTemp & "область действия не определена); "
    End Select
    strTemp = strTemp & " | "
    '--- Определение типа записи
    If objEntry.AceType = ACCESS_ALLOWED_ACE_TYPE Then
        strTemp = strTemp & "РАЗРЕШЕНО: "
    ElseIf objEntry.AceType = ACCESS_DENIED_ACE_TYPE Then
        strTemp = strTemp & "ЗАПРЕЩЕНО: "
    End If
    '--- Определение значения маски "Полный доступ" в зависимости от версии ОС
    If intVer < 52 Then
        lngTemp = FULL_ACCESS + Abs(objEntry.AceType - 1) * FLAG_SYNCHRONIZE
        'Выражение FULL_ACCESS + Abs(objEntry.AceType - 1) * FLAG_SYNCHRONIZE
        'учитывает разницу между значениями маски "Полный доступ" у записей разных типов
        'в ОС версий "2000/XP"
    Else
        lngTemp = FULL_ACCESS + FLAG_SYNCHRONIZE
    End If
    '------
    lngMask = objEntry.AccessMask
    Select Case Abs(lngMask)
        Case lngTemp: strTemp = strTemp & "Полный доступ"
        Case GENERIC_ALL: strTemp = strTemp & "Полный доступ (универсальная маска)"
        Case Else
            '--- Детальный анализ маски доступа текущей записи:
            'обработка универсальных масок (биты №№ 29 - 31)
            If Abs(lngMask) > lngTemp Then
                For i = 0 To UBound(arrGenericValue)
                    If lngMask And arrGenericValue(i) Then
                        strTemp = strTemp & arrGenericName(i) & " { "
                        Select Case arrGenericValue(i)
                            Case GENERIC_EXECUTE: arrTemp = arrSieveGE
                            Case GENERIC_WRITE: arrTemp = arrSieveGW
                            Case GENERIC_READ: arrTemp = arrSieveGR
                        End Select
                        For j = 0 To UBound(arrTemp)
                            If arrTemp(j) Then strTemp = strTemp & arrFlagName(j)
                        Next
                        strTemp = strTemp & " } "
                    End If
                Next
            End If
            'обработка обычных масок (биты №№ 0 - 20)
            For i = 0 To UBound(arrFlagValue)
                If lngMask And arrFlagValue(i) Then
                    strTemp = strTemp & arrFlagName(i)
                End If
            Next
            '------
    End Select
    strTemp = UCase(Subfolder.Path & " | " & objEntry.Trustee.Domain & "\" & objEntry.Trustee.Name & " | ") & strTemp & vbNewLine
    If intMode = PART_MODE Then
        If StrComp(UCase(objEntry.Trustee.SIDString), strAccSID, vbTextCompare) = 0 Then
            strRes = strRes & strTemp
        End If
    Else
        strRes = strRes & strTemp
    End If
Next
End Function

И это работает!
Теперь получил новое дополнение - надо, чтобы из выборки исключались встроенные учетки, вроде BUILTIN и NT AUTHORITY...
Из кода я понял, что за это отвечает параметр objEntry.Trustee.Domain, вопрос теперь в том, что я затупаю с организацией цикла... Скажите, в VBS есть что-то типа Continue при выполнении цикла, чтобы при определенном условии цикл ничего не делал, но переходил на следующую итерацию?

Re: VBS: получение списка всех вложенных папок с разрешениями

null@example.com (Flasher) — Mon, 22 Oct 2012 16:47:51 +0000

nostro пишет:

Самый актуальный вопрос - как сделать это не только для выбранной папки, но и для всех вложенных папок на всех уровнях вложенности...

Код, конечно, не слабый. Ковырять нет времени. Схема рекурсии примерно такая:

Set objShell = CreateObject("Shell.Application")
Set FSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objShell.BrowseForFolder(0, "Выбор каталога", 17, objShell.NameSpace(&H11))

ForFolder objFolder.Self.Path

Sub ForFolder(Fold)
  For Each Folder In FSO.GetFolder(Fold).SubFolders
    ForFolder Folder
  Next
  Folder = Fold
  MsgBox Folder ' или свой код с переменными данными
End Sub

Re: VBS: получение списка всех вложенных папок с разрешениями

null@example.com (nostro) — Mon, 22 Oct 2012 06:23:38 +0000

Flasher пишет:

nostro пишет:
Как получить список разрешений для одной папки я нашел
Тогда предлагаю выложить реализацию. Рекурсию сделать не проблема.

Реализация получения списка разрешений для одной папки взята из вот этого примера: http://forum.script-coding.com/viewtopic.php?id=5142
Что получилось:

Option Explicit

Dim objShell, objFolder, strPath
Dim objWsNet, strDomain, strComputer, blnIsDomain, intOSVersion
Dim objWMI, objCollection, objItem, objSecSettings, objSD
Dim strAccount, strSID, strList
Dim intHasAccount 'Флаг-признак режима работы:
                  '-1 - не составлять список, т.к. указанная "учётка" не найдена;
                  '0  - составлять полный список;
                  '1  - составлять частичный список (только для указанной "учётки").

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Выбор каталога", &h10 + &h200, &h11)
If Not objFolder Is Nothing Then
    strPath = objFolder.Self.Path
    Set objWsNet = CreateObject("WScript.Network")
    strDomain = objWsNet.UserDomain
    strComputer = objWsNet.ComputerName
    Set objWsNet = Nothing
    If StrComp(strDomain, strComputer, vbTextCompare) <> 0 Then blnIsDomain = True
    Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    '--- Определение версии ОС
    Set objCollection = objWMI.ExecQuery("SELECT Version FROM Win32_OperatingSystem")
    For Each objItem In objCollection
        intOSVersion = CInt(Replace(Left(objItem.Version, 3), ".", ""))
    Next
    Set objItem = Nothing
    '------
    strAccount = Trim(InputBox("Имя пользователя или группы" & vbNewLine & _
                                "(при составлении полного списка -" & vbNewLine & _
                                "не указывать):", "Проверка настроек безопасности NTFS"))
    intHasAccount = 0
    If Len(strAccount) > 0 Then
        strAccount = Replace(strAccount, """", "")
        '--- Настройка правильного наименования "учётки" локальной ОС в зависимости от версии ОС
        If intOSVersion < 61 Then
            strAccount = Replace(strAccount, "Система", "System", 1, -1, vbTextCompare)
        Else
            strAccount = Replace(strAccount, "System", "Система", 1, -1, vbTextCompare)
        End If
        '------
        If StrComp(strAccount, "System", vbTextCompare) = 0 Or StrComp(strAccount, "Система", vbTextCompare) = 0 Or _
            StrComp(strAccount, "Все", vbTextCompare) = 0 Then
            strDomain = vbNullString
        Else
            If blnIsDomain Then
                If MsgBox("Задана доменная учётная запись?", vbYesNo + vbQuestion, "Проверка настроек безопасности NTFS") = vbNo Then
                    strDomain = strComputer
                End If
            Else
                strDomain = strComputer
            End If
        End If
        '--- Поиск заданной "учётки" на локальном компьютере или в Active Directory
        If Len(strDomain) > 0 Then
            Set objCollection = objWMI.ExecQuery("SELECT SID FROM Win32_Account WHERE Domain='" & strDomain & "' AND Name='" & strAccount & "'")
        Else
            Set objCollection = objWMI.ExecQuery("SELECT SID FROM Win32_Account WHERE Name='" & strAccount & "'")
        End If
        '------
        If objCollection.Count > 0 Then
            intHasAccount = 1
            '--- Определение SID заданной "учётки"
            For Each objItem In objCollection
                strSID = UCase(objItem.SID)
            Next
            '------
        Else
            intHasAccount = -1
        End If
    End If
    If intHasAccount >=0 Then
        Set objSecSettings = objWMI.Get("Win32_LogicalFileSecuritySetting.Path='" & strPath & "'")
        If objSecSettings.GetSecurityDescriptor(objSD) = 0 Then 'Чтение содержимого дескриптора безопасности каталога
            strList = vbNullString
            If Not IsNull(objSD.DACL) Then 'Проверка наличия хотя бы одной записи в DACL каталога
                Call Get_DACLInfo(objSD.DACL, strList, intHasAccount, strSID, intOSVersion)
                If Len(strList) > 0 Then
                    WScript.Echo strList 'Вывод на экран
                Else
                    WScript.Echo "В DACL не обнаружено ни одной записи для объекта " & UCase(strDomain & "\" & strAccount)
                End If
            Else
                WScript.Echo "Список управления доступом к каталогу " & UCase(strPath) & " пуст."
            End If
        Else
            WScript.Echo "Не удалось прочитать дескриптор безопасности каталога " & UCase(strPath)
        End If
    Else
        WScript.Echo "Учётная запись объекта " & UCase(strDomain & "\" & strAccount) & " не найдена."
    End If
    Set objSecSettings = Nothing
    Set objCollection = Nothing
    Set objWMI = Nothing
Else
    WScript.Echo "Каталог не выбран."
End If
Set objFolder = Nothing
Set objShell = Nothing
WScript.Quit 0

'======

Function Get_DACLInfo(arrACE(), strRes, intMode, strAccSID, intVer)
Dim objEntry, strTemp, i, j, lngMask, lngTemp
Dim arrFlagValue, arrFlagName, arrGenericValue, arrGenericName
Dim arrSieveGE, arrSieveGW, arrSieveGR, arrTemp
Const PART_MODE = 1 'Флаг-признак составления частичного списка
'--- Значения универсальных масок
Const GENERIC_ALL = &H10000000
Const GENERIC_EXECUTE = &H20000000
Const GENERIC_WRITE = &H40000000
Const GENERIC_READ = &H80000000
'------
Const ACCESS_ALLOWED_ACE_TYPE = 0 'Флаг-признак записи типа "РАЗРЕШЕНИЕ"
Const ACCESS_DENIED_ACE_TYPE  = 1 'Флаг-признак записи типа "ЗАПРЕТ"
Const INHERITED_ACE = 16 'Флаг-признак того, что текущая запись DACL унаследована от родительского каталога 
Const FULL_ACCESS = 983551 'Значение маски полного разрешения или запрета
Const FLAG_SYNCHRONIZE = 1048576 'Значение флага синхронизации доступа к объекту файловой системы
                                 '(в версиях ОС "2000/XP", применим только для записей типа "РАЗРЕШЕНИЕ")

'arrFlagValue = Array(&H20, &H1, &H80, &H8, &H2, &H4, &H100, &H10, &H40, &H10000, &H20000, &H40000, &H80000)
arrFlagValue = Array(32, 1, 128, 8, 2, 4, 256, 16, 64, 65536, 131072, 262144, 524288)
arrFlagName = Array("Траверс папок / Выполнение файлов", _
                    "Содержание папки / Чтение данных", _
                    "Чтение атрибутов", _
                    "Чтение дополнительных атрибутов", _
                    "Создание файлов / Запись данных", _
                    "Создание папок / Дозапись данных", _
                    "Запись атрибутов", _
                    "Запись дополнительных атрибутов", _
                    "Удаление подпапок и файлов", _
                    "Удаление", _
                    "Чтение разрешений", _
                    "Смена разрешений", _
                    "Смена владельца")
                    
arrGenericValue = Array(&H20000000, &H40000000, &H80000000)
'arrGenericValue = Array(536870912, 1073741824, 2147483648)
arrGenericName = Array("Выполнение (универсальная маска)", "Запись (универсальная маска)", "Чтение (универсальная маска)")
'--- Вспомогательные массивы, предназначенные для детализации универсальных масок
arrSieveGE = Array(-1, 0, -1, 0, 0, 0, 0, 0, 0, 0, -1, 0, 0)
arrSieveGW = Array(0, 0, 0, 0, -1, -1, -1, -1, 0, 0, -1, 0, 0)
arrSieveGR = Array(0, -1, -1, -1, 0, 0, 0, 0, 0, 0, -1, 0, 0)
'------

'--- Настройка правильного наименования одного из флагов маски доступа в зависимости от версии ОС
If intVer < 60 Then
    arrFlagName(0) = "Обзор папок / Выполнение файлов"
End If
'------
For Each objEntry In arrACE
    '--- Определение режима наследования записи и области её действия
    If CBool(objEntry.AceFlags And INHERITED_ACE) Then
        strTemp = " (унаследовано; "
        lngTemp = objEntry.AceFlags - INHERITED_ACE
    Else
        strTemp = " (не унаследовано; "
        lngTemp = objEntry.AceFlags
    End If
    Select Case lngTemp
        Case 0: strTemp = strTemp & "действует на: только текущий каталог)"
        Case 1: strTemp = strTemp & "действует на: текущий каталог и его файлы)"
        Case 2: strTemp = strTemp & "действует на: текущий каталог и его подкаталоги)"
        Case 3: strTemp = strTemp & "действует на: текущий каталог, его подкаталоги и файлы)"
        Case 9: strTemp = strTemp & "действует на: только файлы текущего каталога)"
        Case 10: strTemp = strTemp & "действует на: только подкаталоги текущего каталога)"
        Case 11: strTemp = strTemp & "действует на: подкаталоги и файлы текущего каталога)"
        Case Else: strTemp = strTemp & "область действия не определена); "
    End Select
    strTemp = strTemp & " | "
    'strTemp = strTemp & vbNewLine & "---" & vbNewLine
    '------
    '--- Определение типа записи
    If objEntry.AceType = ACCESS_ALLOWED_ACE_TYPE Then
        strTemp = strTemp & "РАЗРЕШЕНО: "
    ElseIf objEntry.AceType = ACCESS_DENIED_ACE_TYPE Then
        strTemp = strTemp & "ЗАПРЕЩЕНО: "
    End If
    '------
    '--- Определение значения маски "Полный доступ" в зависимости от версии ОС
    If intVer < 52 Then
        lngTemp = FULL_ACCESS + Abs(objEntry.AceType - 1) * FLAG_SYNCHRONIZE
        'Выражение FULL_ACCESS + Abs(objEntry.AceType - 1) * FLAG_SYNCHRONIZE
        'учитывает разницу между значениями маски "Полный доступ" у записей разных типов
        'в ОС версий "2000/XP"
    Else
        lngTemp = FULL_ACCESS + FLAG_SYNCHRONIZE
    End If
    '------
    lngMask = objEntry.AccessMask
    Select Case Abs(lngMask)
        Case lngTemp: strTemp = strTemp & "Полный доступ" & vbNewLine
        Case GENERIC_ALL: strTemp = strTemp & "Полный доступ (универсальная маска)" & vbNewLine
        Case Else
            '--- Детальный анализ маски доступа текущей записи:
            'обработка универсальных масок (биты №№ 29 - 31)
            If Abs(lngMask) > lngTemp Then
                For i = 0 To UBound(arrGenericValue)
                    If lngMask And arrGenericValue(i) Then
                        strTemp = strTemp & arrGenericName(i) & vbNewLine & vbTab & "{" & vbNewLine
                        Select Case arrGenericValue(i)
                            Case GENERIC_EXECUTE: arrTemp = arrSieveGE
                            Case GENERIC_WRITE: arrTemp = arrSieveGW
                            Case GENERIC_READ: arrTemp = arrSieveGR
                        End Select
                        For j = 0 To UBound(arrTemp)
                            If arrTemp(j) Then strTemp = strTemp & vbTab & arrFlagName(j) & vbNewLine
                        Next
                        strTemp = strTemp & vbTab & "}" & vbNewLine
                    End If
                Next
            End If
            'обработка обычных масок (биты №№ 0 - 20)
            For i = 0 To UBound(arrFlagValue)
                If lngMask And arrFlagValue(i) Then
                    strTemp = strTemp & arrFlagName(i) & vbNewLine
                End If
            Next
            '------
    End Select
    strTemp = UCase(strPath & " | " & objEntry.Trustee.Domain & "\" & objEntry.Trustee.Name & " | ") & strTemp & vbNewLine
    If intMode = PART_MODE Then
        If StrComp(UCase(objEntry.Trustee.SIDString), strAccSID, vbTextCompare) = 0 Then
            strRes = strRes & strTemp
        End If
    Else
        strRes = strRes & strTemp
    End If
Next
End Function

Самый актуальный вопрос - как сделать это не только для выбранной папки, но и для всех вложенных папок на всех уровнях вложенности...

Re: VBS: получение списка всех вложенных папок с разрешениями

null@example.com (Flasher) — Sat, 20 Oct 2012 11:05:15 +0000

nostro пишет:

Как получить список разрешений для одной папки я нашел

Тогда предлагаю выложить реализацию. Рекурсию сделать не проблема.

Re: VBS: получение списка всех вложенных папок с разрешениями

null@example.com (smaharbA) — Fri, 19 Oct 2012 13:20:46 +0000

cacls папка\*

cmd /q /c "for /r "c:\" %x in (.) do cacls "%~x" 2>&1" > xxx

VBS: получение списка всех вложенных папок с разрешениями

null@example.com (nostro) — Fri, 19 Oct 2012 13:17:28 +0000

Начальством дана задача:
Получить разрешения из вкладки "Security" для корневой папки и всех подпапок (т.е. если корневая папка сам диск - то для всех папок на диске, и для папок, и для вложенных в них папок, и для папок, вложенных во вложенные папки) и записать все полученное добро в CSV-файл...
Как получить список разрешений для одной папки я нашел, а вот как получить список этого добра со ВСЕХ папок, да как это в файл запихнуть, да чтобы экселем открывалось... Буду премного благодарен за любую помощь.