Для каждой записи DACL сценарий позволяет определить:
- идентификатор учётной записи в формате "домен\имя";
- тип;
- режим наследования настроек от родительского каталога;
- маску доступа (в числовой форме, без детализации);
- область действия по отношению к дочерним объектам каталога.
Каталог выбирается с помощью метода BrowseForFolder объекта Shell.Application.
Сценарий ориентирован на работу в графическом режиме.
[code]Option Explicit
Dim objWsNet, strComputer
Dim objShell, objFolder, strPath
Dim objWMI, objSecSettings, objSD, objACE
Dim strList, strTemp, intTemp
Const ACCESS_ALLOWED_ACE_TYPE = 0 'Флаг-признак записи типа "РАЗРЕШЕНИЕ"
Const ACCESS_DENIED_ACE_TYPE = 1 'Флаг-признак записи типа "ЗАПРЕТ"
Const INHERITED_ACE = 16 'Флаг-признак того, что текущая запись DACL унаследована от родительского каталога
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")
strComputer = objWsNet.ComputerName
Set objWsNet = Nothing
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set objSecSettings = objWMI.Get("Win32_LogicalFileSecuritySetting.Path='" & strPath & "'")
If objSecSettings.GetSecurityDescriptor(objSD) = 0 Then 'Чтение содержимого дескриптора безопасности каталога
If Not IsNull(objSD.DACL) Then 'Проверка наличия хотя бы одной записи в DACL каталога
strList = vbNullString
'--- Просмотр DACL каталога
For Each objACE In objSD.DACL
'--- Определение режима наследования записи и области её действия
If CBool(objACE.AceFlags And INHERITED_ACE) Then
strTemp = " - унаследовано "
intTemp = objACE.AceFlags - INHERITED_ACE
Else
strTemp = " - не унаследовано "
intTemp = objACE.AceFlags
End If
Select Case intTemp
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
'------
'--- Определение типа записи
If objACE.AceType = ACCESS_ALLOWED_ACE_TYPE Then
strTemp = strTemp & "Разрешено с маской"
Else
strTemp = strTemp & "Запрещено с маской"
End If
'------
strTemp = strTemp & " -> " & CStr(objACE.AccessMask) & " (&h" & Hex(objACE.AccessMask) & ")"
strList = strList & objACE.Trustee.Domain & "\" & objACE.Trustee.Name & strTemp & vbNewLine & "------" & vbNewLine
Next
Set objACE = Nothing
'------
WScript.Echo strList
Else
WScript.Echo "Список управления доступом к каталогу " & UCase(strPath) & " пуст."
End If
Else
WScript.Echo "Не удалось прочитать дескриптор безопасности каталога " & UCase(strPath)
End If
Set objSD = Nothing
Set objSecSettings = Nothing
Set objWMI = Nothing
Else
WScript.Echo "Каталог не выбран."
End If
Set objFolder = Nothing
Set objShell = Nothing
WScript.Quit 0[/code]
Сценарий 2.
Получение подробного (полного или частичного) списка управления доступом NTFS (DACL) указанного каталога текущего компьютера.
Частичный список составляется в том случае, когда задано NetBIOS-имя пользователя (группы), в противном случае составляется полный список.
Можно указать имя объекта либо доменного, либо локального (для текущего компьютера) уровня. Допустимо указание имён ряда встроенных локальных объектов: "System" (или "Система"), "Все", "Администратор(ы)", "Гост(ь)(и)" и т.п. Имена объектов можно задавать как в кавычках, так и без них.
Для каждой записи DACL сценарий позволяет определить:
- идентификатор учётной записи в формате "домен\имя";
- тип;
- режим наследования настроек от родительского каталога;
- маску доступа (в текстовой форме, с детализацией);
- область действия по отношению к дочерним объектам каталога.
Сценарий требует привилегий локального администратора.
Каталог выбирается с помощью метода BrowseForFolder объекта Shell.Application.
Сценарий ориентирован на работу в графическом режиме.
[code]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 & 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 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(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[/code]
Сценарий 3.
Изменение списка управления доступом NTFS (DACL) указанного каталога текущего компьютера без сохранения настроек, унаследованных от "родителя".
Варианты изменения DACL:
- изменение типа существующей записи и (или) её маски доступа;
- добавление отсутствующей записи заданного типа и с заданной маской;
- удаление существующей записи.
Для работы сценария необходимо задать NetBIOS-имя учётной записи, для которой необходимо изменить соответствующую запись DACL.
Можно указать имя объекта либо доменного, либо локального (для текущего компьютера) уровня. Допустимо указание имён ряда встроенных локальных объектов: "System" (или "Система"), "Все", "Администратор(ы)", "Гост(ь)(и)" и т.п. Имена объектов можно задавать как в кавычках, так и без них.
Сценарий требует привилегий локального администратора.
Каталог выбирается с помощью метода BrowseForFolder объекта Shell.Application.
Сценарий ориентирован на работу в графическом режиме.
Внимание!
1. Ни рациональность, ни, тем более, осмысленность заданного действия сценарием не проверяется.
2. Выбор записей DACL для обработки ведётся только по SID соответствующего объекта. Таким образом, все записи для данного объекта (независимо от их типа и маски) будут преобразованы в полные дубликаты, после чего ОС (в процессе оптимизации DACL) оставит только один экземпляр, удалив все остальные (записи с разной областью действия останутся в списке).
3. Для упрощения кода данная версия сценария не обеспечивает возможности задания произвольной области действия записи при её добавлении в список. Автоматически задаётся область действия по умолчанию (текущий каталог, его подкаталоги и файлы).
4. В Win 2000 Pro с SP ниже 4 возможно ограничение функциональности при попытке удаления записи: запись в DACL может остаться, но не иметь ни одного установленного флага маски доступа.
[code]Option Explicit
Dim objWsNet, strDomain, strComputer, strAccount, blnIsDomain
Dim objShell, objFolder, strPath, xResult, intTemp
Dim objWMI, objCollection, objItem, intOSVersion
Dim arrACEMasks, intACEType, lngACEMask, blnAddACE
Const ACCESS_ALLOWED_ACE_TYPE = 0 'Флаг-признак записи типа "РАЗРЕШЕНИЕ"
Const ACCESS_DENIED_ACE_TYPE = 1 'Флаг-признак записи типа "ЗАПРЕТ"
Const REMOVE_ACE = 0 'Значение маски для удаления записи из DACL
'--- Набор типичных значений масок доступа
Const WRITE_ONLY = 278
Const READ_ONLY = 131209
Const READ_AND_EXECUTE = 131241
Const READ_WRITE = 131487
Const READ_WRITE_EXECUTE = 131519
Const MODIFY = 197055
Const MODIFY_AND_REMOVE_CHILDREN = 197119
Const CHANGE_DACL = 262144
Const ACCESS_WITHOUT_CHANGE_OWNER = 459263
Const CHANGE_OWNER = 524288
Const CHANGE_DACL_AND_OWNER = 786432
Const FULL_ACCESS = 983551
'---
Const FLAG_SYNCHRONIZE = 1048576 'Значение флага синхронизации доступа к объекту файловой системы
'(применим только для записей типа "РАЗРЕШЕНИЕ")
arrACEMasks = Array(REMOVE_ACE, WRITE_ONLY, READ_ONLY, READ_AND_EXECUTE, READ_WRITE, READ_WRITE_EXECUTE, MODIFY, _
MODIFY_AND_REMOVE_CHILDREN, CHANGE_DACL, ACCESS_WITHOUT_CHANGE_OWNER, CHANGE_OWNER, _
CHANGE_DACL_AND_OWNER, FULL_ACCESS)
strAccount = Trim(InputBox("Имя учётной записи:", "Настройка безопасности NTFS"))
If Len(strAccount) > 0 Then
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
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
Set objCollection = Nothing
Set objWMI = Nothing
'------
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(strDomain, strComputer, vbTextCompare) <> 0 Then blnIsDomain = True
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
intTemp = Trim(InputBox("Тип доступа и маска доступа в формате" & vbNewLine & _
"+ЧИСЛО (разрешить) или -ЧИСЛО (запретить)," & vbNewLine & _
"где ЧИСЛО:" & vbNewLine & _
"1 - запись;" & vbNewLine & _
"2 - только чтение;" & vbNewLine & _
"3 - чтение и выполнение;" & vbNewLine & _
"4 - чтение и запись (без выполнения);" & vbNewLine & _
"5 - чтение, запись, выполнение;" & vbNewLine & _
"6 - изменение (без удаления подпапок и файлов);" & vbNewLine & _
"7 - изменение (с удалением подпапок и файлов);" & vbNewLine & _
"8 - смена разрешений;" & vbNewLine & _
"9 - почти полный доступ (без смены владельца);" & vbNewLine & _
"10 - смена владельца;" & vbNewLine & _
"11 - смена разрешений и владельца;" & vbNewLine & _
"12 - полный доступ." & vbNewLine & vbNewLine & _
"Если знак типа доступа (+/-) отсутствует," & vbNewLine & _
"то предполагается разрешение." & vbNewLine & vbNewLine & _
"Для удаления записи из списка" & vbNewLine & _
"в качестве значения маски укажите 0", "Настройка безопасности NTFS"))
If IsNumeric(intTemp) Then
intTemp = CInt(intTemp)
If Abs(intTemp) >= 0 And Abs(intTemp) <= 12 Then
lngACEMask = arrACEMasks(Abs(intTemp))
If intTemp < 0 Then
intACEType = 1
If intOSVersion >= 52 And lngACEMask = FULL_ACCESS Then
lngACEMask = lngACEMask + FLAG_SYNCHRONIZE
'Эта проверка позволяет учесть разницу между значениями маски "Полный доступ"
'у записей разных типов в ОС версий "2000/XP"
End If
ElseIf intTemp > 0 Then
intACEType = 0
lngACEMask = lngACEMask + FLAG_SYNCHRONIZE
Else
intACEType = 0
End If
If intTemp <> 0 Then
If MsgBox("Добавлять запись в список, если она отсутствует?", vbYesNo + vbQuestion, _
"Настройка безопасности NTFS") = vbYes Then
blnAddACE = True
End If
End If
xResult = Modify_DACL(strDomain, strComputer, strAccount, strPath, intACEType, lngACEMask, blnAddACE)
Else
xResult = "Маска доступа задана неверно."
End If
Else
xResult = "Тип доступа или маска доступа не заданы или заданы неверно."
End If
Wscript.Echo xResult
Else
WScript.Echo "Каталог не выбран."
End If
Set objShell = Nothing
Set objFolder = Nothing
Else
WScript.Echo "Учётная запись не указана."
End If
WScript.Quit 0
'======
Function Modify_DACL(strDom, strWS, strSAN, strDir, intType, lngMask, blnAdd)
Dim objWMI, objSecSettings, objSD, objACE
Dim xRes, arrACE, objCollection, objItem, strSID
Dim objSID, objTrustee, objNewACE
Dim blnHasACE, i
Const SE_DACL_PROTECTED = 4096 'Флаг-признак отключенного режима наследования управляемым каталогом безопасности NTFS от родительского каталога
Const OBJECT_INHERIT_ACE = 1 'Флаг-признак области действия записи на текущий каталог и его файлы
Const CONTAINER_INHERIT_ACE = 2 'Флаг-признак области действия записи на текущий каталог и его подкаталоги
On Error Resume Next
xRes = 0: blnHasACE = False
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strWS & "\root\cimv2")
If Err.Number = 0 Then
Set objSecSettings = objWMI.Get("Win32_LogicalFileSecuritySetting.Path='" & strDir & "'")
If Err.Number = 0 Then
If objSecSettings.GetSecurityDescriptor(objSD) = 0 Then 'Чтение содержимого дескриптора безопасности управляемого каталога
If Not IsNull(objSD.DACL) Then 'Проверка наличия хотя бы одной записи в DACL управляемого каталога
'--- Отключение наследования настроек безопасности от "родителя"
If Not CBool(objSD.ControlFlags And SE_DACL_PROTECTED) Then
objSD.ControlFlags = objSD.ControlFlags + SE_DACL_PROTECTED
xRes = objSecSettings.SetSecurityDescriptor(objSD)
End If
'------
If xRes = 0 Then
'--- Поиск заданной "учётки" на локальном компьютере или в Active Directory
If Len(strDom) > 0 Then
Set objCollection = objWMI.ExecQuery("SELECT SID FROM Win32_Account WHERE Domain='" & strDom & "' AND Name='" & strSAN & "'")
Else
Set objCollection = objWMI.ExecQuery("SELECT SID FROM Win32_Account WHERE Name='" & strSAN & "'")
End If
'------
If objCollection.Count > 0 Then
'--- Определение SID заданной "учётки"
For Each objItem In objCollection
strSID = UCase(objItem.SID)
Next
Set objItem = Nothing
'------
'--- Поиск в DACL записи с известным SID
For Each objACE In objSD.DACL
If UCase(objACE.Trustee.SIDString) = strSID Then
blnHasACE = True 'флаг-признак того, что запись с искомым SID найдена
'--- Установка заданных значений типа и маски доступа для найденной записи
objACE.AceType = intType
objACE.AccessMask = lngMask
'-----
End If
Next
'------
If blnHasACE Then
'--- Применение изменений, внесённых в DACL, в том случае,
'когда хотя бы одна запись с искомым SID там найдена
xRes = objSecSettings.SetSecurityDescriptor(objSD)
Select Case xRes
Case "0": xRes = "Успешное завершение."
Case "2": xRes = "Не удалось настроить параметры существующей записи " & UCase(strDom & "\" & strSAN) & vbNewLine & "Доступ запрещён."
Case "5", "9": xRes = "Не удалось настроить параметры существующей записи " & UCase(strDom & "\" & strSAN) & vbNewLine & "Для выполнения операции недостаточно полномочий."
Case "21": xRes = "Не удалось настроить параметры существующей записи " & UCase(strDom & "\" & strSAN) & vbNewLine & "Заданы недопустимые значения параметров."
Case Else: xRes = "Не удалось настроить параметры существующей записи " & UCase(strDom & "\" & strSAN) & vbNewLine & "Неизвестная ошибка с кодом: " & xRes
End Select
Else
If blnAdd Then
'--- Добавление в DACL записи с известным SID, если она там не найдена
arrACE = objSD.DACL
Set objSID = objWMI.Get("Win32_SID.SID='" & strSID & "'")
Set objTrustee = objWMI.Get("Win32_Trustee").Spawninstance_
objTrustee.Domain = strDom
objTrustee.Name = strSAN
objTrustee.SID = objSID.BinaryRepresentation
objTrustee.SidLength = objSID.SidLength
objTrustee.SIDString = strSID
Set objSID = Nothing
Set objNewACE = objWMI.Get("Win32_Ace").Spawninstance_
objNewACE.AceType = intType
objNewACE.AceFlags = OBJECT_INHERIT_ACE + CONTAINER_INHERIT_ACE
objNewACE.AccessMask = lngMask
objNewACE.Trustee = objTrustee
Set objTrustee = Nothing
i = UBound(arrACE) + 1
ReDim Preserve arrACE(i)
Set arrACE(i) = objNewACE
objSD.DACL = arrACE
Set objNewACE = Nothing
Erase arrACE
xRes = objSecSettings.SetSecurityDescriptor(objSD)
Select Case xRes
Case "0": xRes = "Успешное завершение."
Case "2": xRes = "Не удалось добавить запись " & UCase(strDom & "\" & strSAN) & vbNewLine & "Доступ запрещён."
Case "5", "9": xRes = "Не удалось добавить запись " & UCase(strDom & "\" & strSAN) & vbNewLine & "Для выполнения операции недостаточно полномочий."
Case "21": xRes = "Не удалось добавить запись " & UCase(strDom & "\" & strSAN) & vbNewLine & "Заданы недопустимые значения параметров."
Case Else: xRes = "Не удалось добавить запись " & UCase(strDom & "\" & strSAN) & vbNewLine & "Неизвестная ошибка с кодом: " & xRes
End Select
'------
Else
xRes = "Запись " & UCase(strDom & "\" & strSAN) & " в DACL объекта " & UCase(strDir) & " отсутствует."
End If
End If
Else
xRes = "Не найдена учётная запись объекта " & UCase(strDom & "\" & strSAN)
End If
Set objCollection = Nothing
Else
xRes = "Не удалось отключить наследование безопасности для каталога " & UCase(strDir)
End If
Else
xRes = "Список управления доступом к каталогу " & UCase(strDir) & " пуст."
End If
Else
xRes = "Не удалось прочитать дескриптор безопасности каталога " & UCase(strDir)
End If
Set objSD = Nothing
Set objSecSettings = Nothing
Else
xRes = "Ошибка " & CStr(Err.Number) & vbNewLine & Err.Description
Err.Clear
End If
Else
xRes = "Ошибка " & CStr(Err.Number) & vbNewLine & Err.Description
Err.Clear
End If
Set objWMI = Nothing
On Error GoTo 0
Modify_DACL = xRes
End Function[/code]
Сценарий 4.
Изменение списка управления доступом NTFS (DACL) указанного каталога текущего компьютера с сохранением настроек, унаследованных от "родителя".
Варианты изменения DACL (все варианты возможны только для не унаследованных записей):
- изменение маски доступа существующей записи с учётом области её действия;
- добавление отсутствующей записи с заданными типом, областью действия и маской;
- удаление существующей записи с учётом её типа и области действия.
С помощью сценария можно изменять DACL и того каталога, у которого включено наследование от "родителя", и того - у которого отключено.
Для работы сценария необходимо задать NetBIOS-имя учётной записи, для которой необходимо изменить соответствующую запись DACL.
Можно указать имя объекта либо доменного, либо локального (для текущего компьютера) уровня. Допустимо указание имён ряда встроенных локальных объектов: "System" (или "Система"), "Все", "Администратор(ы)", "Гост(ь)(и)" и т.п. Имена объектов можно задавать как в кавычках, так и без них.
Сценарий требует привилегий локального администратора.
Каталог выбирается с помощью метода BrowseForFolder объекта Shell.Application.
Сценарий ориентирован на работу в графическом режиме.
Внимание!
1. Ни рациональность, ни, тем более, осмысленность заданного действия сценарием не проверяется.
2. В Win 2000 Pro с SP ниже 4 возможно ограничение функциональности при попытке удаления записи: запись в DACL может остаться, но не иметь ни одного установленного флага маски доступа.
[code]Option Explicit
Dim objWsNet, strDomain, strComputer, strAccount, blnIsDomain
Dim objShell, objFolder, strPath, xResult, intTemp, strTemp
Dim objWMI, objCollection, objItem, intOSVersion
Dim arrACEMasks, arrACEScopes, intACEType, intACEScope, lngACEMask
Const ACCESS_ALLOWED_ACE_TYPE = 0 'Флаг-признак записи типа "РАЗРЕШЕНИЕ"
Const ACCESS_DENIED_ACE_TYPE = 1 'Флаг-признак записи типа "ЗАПРЕТ"
Const OBJECT_INHERIT_ACE = 1 'Флаг-признак области действия записи на текущий каталог и его файлы
Const CONTAINER_INHERIT_ACE = 2 'Флаг-признак области действия записи на текущий каталог и его подкаталоги
Const REMOVE_ACE = 0 'Значение маски для удаления записи из DACL
'--- Допустимые значения для указания областей действия записи
Const ANY_SCOPE = -1 'Любая область действия записи
Const FOLDER_ONLY = 0 'Только текущая папка
Const FOLDER_AND_FILES = 1 'Текущая папка и её файлы
Const FOLDER_AND_SUBFOLDERS = 2 'Текущая папка и её подпапки
Const FOLDER_SUBFOLDERS_FILES = 3 'Текущая папка её подпапки и файлы
Const FILES_ONLY = 9 'Только файлы текущей папки
Const SUBFOLDERS_ONLY = 10 'Только подпапки текущей папки
Const SUBFOLDERS_AND_FILES = 11 'Подпапки и файлы текущей папки
'--- Набор типичных значений масок доступа
Const WRITE_ONLY = 278
Const READ_ONLY = 131209
Const READ_AND_EXECUTE = 131241
Const READ_WRITE = 131487
Const READ_WRITE_EXECUTE = 131519
Const MODIFY = 197055
Const MODIFY_AND_REMOVE_CHILDREN = 197119
Const CHANGE_DACL = 262144
Const ACCESS_WITHOUT_CHANGE_OWNER = 459263
Const CHANGE_OWNER = 524288
Const CHANGE_DACL_AND_OWNER = 786432
Const FULL_ACCESS = 983551
'---
Const FLAG_SYNCHRONIZE = 1048576 'Значение флага синхронизации доступа к объекту файловой системы
'(применим только для записей типа "РАЗРЕШЕНИЕ")
arrACEMasks = Array(REMOVE_ACE, WRITE_ONLY, READ_ONLY, READ_AND_EXECUTE, READ_WRITE, READ_WRITE_EXECUTE, MODIFY, _
MODIFY_AND_REMOVE_CHILDREN, CHANGE_DACL, ACCESS_WITHOUT_CHANGE_OWNER, CHANGE_OWNER, _
CHANGE_DACL_AND_OWNER, FULL_ACCESS)
arrACEScopes = Array(ANY_SCOPE, FOLDER_ONLY, FOLDER_AND_FILES, FOLDER_AND_SUBFOLDERS, FOLDER_SUBFOLDERS_FILES, _
FILES_ONLY, SUBFOLDERS_ONLY, SUBFOLDERS_AND_FILES)
strAccount = InputBox("Имя учётной записи:", "Настройка безопасности NTFS")
If Len(strAccount) > 0 Then
If StrComp(strAccount, "Система", vbTextCompare) = 0 Then strAccount = "System"
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
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
Set objCollection = Nothing
Set objWMI = Nothing
'------
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(strDomain, strComputer, vbTextCompare) <> 0 Then blnIsDomain = True
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
intTemp = Trim(InputBox("Тип доступа и маска доступа в формате" & vbNewLine & _
"+ЧИСЛО (разрешить) или -ЧИСЛО (запретить)," & vbNewLine & _
"где ЧИСЛО:" & vbNewLine & _
"1 - запись;" & vbNewLine & _
"2 - только чтение;" & vbNewLine & _
"3 - чтение и выполнение;" & vbNewLine & _
"4 - чтение и запись (без выполнения);" & vbNewLine & _
"5 - чтение, запись, выполнение;" & vbNewLine & _
"6 - изменение (без удаления подпапок и файлов);" & vbNewLine & _
"7 - изменение (с удалением подпапок и файлов);" & vbNewLine & _
"8 - смена разрешений;" & vbNewLine & _
"9 - почти полный доступ (без смены владельца);" & vbNewLine & _
"10 - смена владельца;" & vbNewLine & _
"11 - смена разрешений и владельца;" & vbNewLine & _
"12 - полный доступ." & vbNewLine & vbNewLine & _
"Если знак типа доступа (+/-) отсутствует," & vbNewLine & _
"то предполагается разрешение." & vbNewLine & vbNewLine & _
"Для удаления записи из списка" & vbNewLine & _
"в качестве значения маски укажите:" & vbNewLine & _
"+0 - для записи типа ""РАЗРЕШЕНИЕ"";" & vbNewLine & _
"-0 - для записи типа ""ЗАПРЕТ"";" & vbNewLine & _
"0 - для записи любого типа.", "Настройка безопасности NTFS"))
If IsNumeric(intTemp) Then
strTemp = Left(intTemp, 1)
intTemp = CInt(intTemp)
If Abs(intTemp) >= 0 And Abs(intTemp) <= 12 Then
lngACEMask = arrACEMasks(Abs(intTemp))
If intTemp < 0 Then
intACEType = 1
If intOSVersion >= 52 And lngACEMask = FULL_ACCESS Then
lngACEMask = lngACEMask + FLAG_SYNCHRONIZE
'Эта проверка позволяет учесть разницу между значениями маски "Полный доступ"
'у записей разных типов в ОС версий "2000/XP"
End If
ElseIf intTemp > 0 Then
intACEType = 0
lngACEMask = lngACEMask + FLAG_SYNCHRONIZE
Else
Select Case strTemp
Case "-": intACEType = 1
Case "+": intACEType = 0
Case Else: intACEType = -1
End Select
End If
intTemp = Trim(InputBox("Область действия записи:" & vbNewLine & _
"1 - только текущая папка;" & vbNewLine & _
"2 - текущая папка и её файлы;" & vbNewLine & _
"3 - текущая папка и её подпапки;" & vbNewLine & _
"4 - текущая папка, её подпапки и файлы;" & vbNewLine & _
"5 - только файлы текущей папки;" & vbNewLine & _
"6 - только подпапки текущей папки;" & vbNewLine & _
"7 - подпапки и файлы текущей папки." & vbNewLine & vbNewLine & _
"Для обработки записи с любой" & vbNewLine & _
"областью действия задайте значение 0", "Настройка безопасности NTFS"))
If IsNumeric(intTemp) Then
intTemp = CInt(intTemp)
If intTemp < 0 Or intTemp > 7 Then
intTemp = 4
MsgBox "Область действия задана неверно." & vbNewLine & _
"Будет использована стандартная область:" & vbNewLine & _
"ТЕКУЩАЯ ПАПКА, ЕЁ ПОДПАПКИ И ФАЙЛЫ.", _
vbExclamation, "Настройка безопасности NTFS"
End If
Else
intTemp = 4
MsgBox "Область действия не задана или задана неверно." & vbNewLine & _
"Будет использована стандартная область:" & vbNewLine & _
"ТЕКУЩАЯ ПАПКА, ЕЁ ПОДПАПКИ И ФАЙЛЫ.", _
vbExclamation, "Настройка безопасности NTFS"
End If
intACEScope = arrACEScopes(intTemp)
xResult = ModifyEx2_DACL(strDomain, strComputer, strAccount, strPath, intACEType, intACEScope, lngACEMask)
Else
xResult = "Маска доступа задана неверно."
End If
Else
xResult = "Тип доступа или маска доступа не заданы или заданы неверно."
End If
Wscript.Echo xResult
Else
WScript.Echo "Каталог не выбран."
End If
Set objShell = Nothing
Set objFolder = Nothing
Else
WScript.Echo "Учётная запись не указана."
End If
WScript.Quit 0
'======
Function ModifyEx2_DACL(strDom, strWS, strSAN, strDir, intType, intScope, lngMask)
Dim objWMI, objSecSettings, objSD, blnHasInherited, blnHasACE, i
Dim xRes, arrACE, objCollection, objItem, strSID
Dim objSID, objTrustee, objACE
Const SE_DACL_PROTECTED = 4096 'Флаг-признак отключенного режима наследования управляемым каталогом безопасности NTFS от "родителя"
Const INHERITED_ACE = 16 'Флаг-признак того, что текущая запись DACL унаследована от "родителя"
On Error Resume Next
xRes = 0
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strWS & "\root\cimv2")
If Err.Number = 0 Then
Set objSecSettings = objWMI.Get("Win32_LogicalFileSecuritySetting.Path='" & strDir & "'")
If Err.Number = 0 Then
If objSecSettings.GetSecurityDescriptor(objSD) = 0 Then
If Not IsNull(objSD.DACL) Then
'--- Поиск заданной "учётки" на локальном компьютере или в Active Directory
If Len(strDom) > 0 Then
Set objCollection = objWMI.ExecQuery("SELECT SID FROM Win32_Account WHERE Domain='" & strDom & "' AND Name='" & strSAN & "'")
Else
Set objCollection = objWMI.ExecQuery("SELECT SID FROM Win32_Account WHERE Name='" & strSAN & "'")
End If
'------
If objCollection.Count > 0 Then
If Not CBool(objSD.ControlFlags And SE_DACL_PROTECTED) Then blnHasInherited = True
If blnHasInherited Then
arrACE = Array()
'--- Выборка из исходного DACL записей, не унаследованных от "родителя"
i = -1
For Each objItem In objSD.DACL
If Not CBool(objItem.AceFlags And INHERITED_ACE) Then
i = i + 1
ReDim Preserve arrACE(i)
Set arrACE(i) = objItem
End If
Next
Set objItem = Nothing
'------
'--- Отключение наследования настроек безопасности от "родителя"
objSD.ControlFlags = objSD.ControlFlags + SE_DACL_PROTECTED
xRes = objSecSettings.SetSecurityDescriptor(objSD)
'------
Else
arrACE = objSD.DACL
End If
If xRes = 0 Then
'--- Определение SID "учётки", назначенной для обработки
For Each objItem In objCollection
strSID = UCase(objItem.SID)
Next
Set objItem = Nothing
'------
If lngMask > 0 Then
'--- Подготовка к добавлению в DACL новой записи
Set objSID = objWMI.Get("Win32_SID.SID='" & strSID & "'")
Set objTrustee = objWMI.Get("Win32_Trustee").Spawninstance_()
objTrustee.Domain = strDom
objTrustee.Name = strSAN
objTrustee.SID = objSID.BinaryRepresentation
objTrustee.SidLength = objSID.SidLength
objTrustee.SIDString = strSID
Set objSID = Nothing
Set objACE = objWMI.Get("Win32_Ace").Spawninstance_()
objACE.AceType = intType
objACE.AceFlags = intScope
objACE.AccessMask = lngMask
objACE.Trustee = objTrustee
Set objTrustee = Nothing
i = UBound(arrACE) + 1
ReDim Preserve arrACE(i)
Set arrACE(i) = objACE
objSD.DACL = arrACE
'------
Else
'--- Подготовка к удалению из DACL указанной записи
For Each objACE In arrACE
blnHasACE = False
'--- Поиск указанной записи по SID, области действия и типу
If UCase(objACE.Trustee.SIDString) = strSID Then
If intScope >= 0 Then
If objACE.AceFlags = intScope Then
If intType < 0 Or objACE.AceType = intType Then
blnHasACE = True 'запись заданного типа с искомыми SID и областью действия найдена
End If
End If
Else
blnHasACE = True 'запись с искомым SID найдена (область действия - любая)
End If
If blnHasACE Then
objACE.AccessMask = 0
End If
End If
'------
Next
'------
End If
objSD.DACL = arrACE 'Собственно изменение DACL
Set objACE = Nothing
Erase arrACE
If blnHasInherited Then
'--- Включение наследования настроек безопасности от "родителя",
'если первоначально оно было включено
objSD.ControlFlags = objSD.ControlFlags - SE_DACL_PROTECTED
'------
End If
'--- Итоговое сохраненение изменений, внесённых в дескриптор безопасности
xRes = objSecSettings.SetSecurityDescriptor(objSD)
Select Case xRes
Case 0: xRes = "Успешное завершение."
Case 2: xRes = "Не удалось сохранить изменения DACL." & vbNewLine & "Доступ запрещён."
Case 5, 9: xRes = "Не удалось сохранить изменения DACL." & vbNewLine & "Для выполнения операции недостаточно полномочий."
Case 21: xRes = "Не удалось сохранить изменения DACL." & vbNewLine & "Заданы недопустимые значения параметров."
Case Else: xRes = "Не удалось сохранить изменения DACL." & vbNewLine & "Неизвестная ошибка."
End Select
'------
Else
xRes = "Не удалось отключить наследование безопасности для папки " & UCase(strDir)
End If
Else
xRes = "Не найдена учётная запись объекта " & UCase(strDom & "\" & strSAN)
End If
Set objCollection = Nothing
Else
xRes = "Список управления доступом (ACL) к заданному объекту пуст."
End If
Else
xRes = "Не удалось прочитать дескриптор безопасности объекта."
End If
Set objSD = Nothing
Set objSecSettings = Nothing
Else
xRes = "Ошибка " & CStr(Err.Number) & vbNewLine & Err.Description
Err.Clear
End If
Else
xRes = "Ошибка " & CStr(Err.Number) & vbNewLine & Err.Description
Err.Clear
End If
Set objWMI = Nothing
On Error GoTo 0
ModifyEx2_DACL = xRes
End Function[/code]
Сценарий 5.
Очистка DACL указанного дерева папок от записей с не олицетворёнными SID.
Сценарий способен работать и в графическом, и в консольном режимах.
Подробное описание функциональности сценария и особенностей его работы - во встроенной справке (см. функцию View_Help()).
[code]Option Explicit
Dim objFS, objShell, objFolder, objFile, objWShell, objWMI
Dim strTranslator, strLogFile, strComputer, strTargetPath
Dim objDict, objRegExp, arrTemp, intNumArgs, strKey, strTemp, i
Dim blnIsConsole, blnRecursive, blnCreateLog, blnSilent, blnAvailable, blnHasError
strComputer = "."
blnCreateLog = True: blnSilent = True: blnAvailable = True
Set objFS = CreateObject("Scripting.FileSystemObject")
strTranslator = objFS.GetBaseName(WScript.FullName)
If StrComp(strTranslator, "cscript", vbTextCompare) = 0 Then blnIsConsole = True
If blnIsConsole Then
arrTemp = Array("tc", "tlp", "r", "nl", "s")
Set objDict = CreateObject("Scripting.Dictionary")
objDict.CompareMode = 1
For i = 0 To UBound(arrTemp)
objDict.Add arrTemp(i), vbNullString
Next
'--- Проверка корректности набора заданных ключей, определение значений ключей
Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.Global = True
objRegExp.IgnoreCase = True
objRegExp.Pattern = "^[-/]"
intNumArgs = WScript.Arguments.Count
Select Case intNumArgs
Case 0: Call View_Help: WScript.Quit 0
Case 1
strTemp = objRegExp.Replace(WScript.Arguments.Item(0), "")
If strTemp = "?" Then
Call View_Help: WScript.Quit 0
Else
If Len(strTemp) > 1 Then
If LCase(Left(strTemp, 4)) <> "tlp:" Then
Call Err_Message(1, strTemp)
WScript.Quit 0
Else
If Len(strTemp) > 4 Then