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
К сожалению, скрипт сложноват для моего понимания, не могли бы вы подсказать, что в нем надо переписать чтобы:
