Тема: VBS & WMI: добавить запись в DACL каталога, сохранив наследование
В качестве развития темы VBS & WMI: безопасность NTFS для каталога, DACL (чтение, изменение) предлагаю для тестирования сценарий, с помощью которого можно добавлять произвольную запись в DACL заданного каталога, сохраняя при этом записи унаследованные от "родителя".
Option Explicit
Dim objWsNet, strDomain, strComputer, strAccount, blnIsDomain
Dim objShell, objFolder, strPath, xResult, intTemp
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 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(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(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 & _
"то предполагается разрешение.", "Настройка безопасности NTFS"))
If IsNumeric(intTemp) Then
intTemp = CInt(intTemp)
If Abs(intTemp) - 1 >= 0 And Abs(intTemp) - 1 <= 11 Then
lngACEMask = arrACEMasks(Abs(intTemp) - 1)
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
intTemp = Trim(InputBox("Область действия записи:" & vbNewLine & _
"1 - только текущая папка;" & vbNewLine & _
"2 - текущая папка и её файлы;" & vbNewLine & _
"3 - текущая папка и её подпапки;" & vbNewLine & _
"4 - текущая папка, её подпапки и файлы;" & vbNewLine & _
"5 - только файлы текущей папки;" & vbNewLine & _
"6 - только подпапки текущей папки;" & vbNewLine & _
"7 - подпапки и файлы текущей папки.", "Настройка безопасности NTFS"))
If IsNumeric(intTemp) Then
intTemp = CInt(intTemp)
If intTemp < 1 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 - 1)
xResult = ModifyEx_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 ModifyEx_DACL(strDom, strWS, strSAN, strDir, intType, intScope, lngMask)
Dim objWMI, objSecSettings, objSD, blnHasInherited, i
Dim xRes, arrACE, objCollection, objItem, strSID
Dim objSID, objTrustee, objNewACE
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 "учётки", назначенной для добавления в DACL
For Each objItem In objCollection
strSID = UCase(objItem.SID)
Next
Set objItem = Nothing
'------
'--- Добавление в 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 = intScope
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
'------
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
ModifyEx_DACL = xRes
End FunctionПримечания.
1. С помощью сценария можно добавлять запись в DACL и того каталога, у которого включено наследование от "родителя", и того - у которого отключено.
2. Сценарий не позволяет удалять записей.
3. Имеется возможность задавать область действия добавляемой записи.
4. Для работы сценария необходимо задать NetBIOS-имя учётной записи, для которой необходимо добавить запись в DACL.
Можно указать имя объекта либо доменного, либо локального (для текущего компьютера) уровня. Допустимо указание имён ряда встроенных локальных объектов: "System" (или "Система"), "Все", "Администратор(ы)", "Гост(ь)(и)" и т.п. Имена объектов можно задавать как в кавычках, так и без них.
5. Сценарий требует привилегий локального администратора.
6. Сценарий не проверяет ни рациональности, ни, тем более, осмысленности заданного действия.
7. Работа сценария проверена в 32-битных версиях: 2000 Pro. + SP4/XP Pro. + SP3/2003 Std. R2 + SP2/2008 Std. + SP2/7 Pro.
8. Сценарий ориентирован на использование в русифицированных ОС и работу в графическом режиме.
