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
                            objDict.Item("tlp") = Mid(strTemp, 5)
                        Else
                            Call Err_Message(11, "tlp")
                            WScript.Quit 0
                        End If
                    End If
                Else
                    Call Err_Message(1, Null)
                    WScript.Quit 0
                End If
            End If
        Case Else
            For Each strTemp In WScript.Arguments
                arrTemp = Null
                strTemp = objRegExp.Replace(strTemp, "")
                If Len(strTemp) > 0 Then
                    If strTemp = "?" Then
                        Call Err_Message(2, strTemp)
                        WScript.Quit 0
                    Else
                        i = InStr(strTemp, ":")
                        If i > 0 Then
                            strKey = Left(strTemp, i - 1)
                            If strKey = "tlp" Or strKey = "tc" Then
                                arrTemp = Split(strTemp, strKey & ":", -1, vbTextCompare)
                                If Len(arrTemp(1)) = 0 Then
                                    Call Err_Message(11, strKey)
                                    WScript.Quit 0
                                End If
                            Else
                                Call Err_Message(10, strKey)
                                WScript.Quit 0
                            End If
                        Else
                            If strTemp <> "tlp" And strTemp <> "tc" Then
                                strKey = strTemp
                            Else
                                Call Err_Message(11, strTemp)
                                WScript.Quit 0
                            End If
                        End If
                        If objDict.Exists(strKey) Then
                            If Len(objDict.Item(strKey)) = 0 Then
                                If IsArray(arrTemp) Then
                                    objDict.Item(strKey) = arrTemp(1)
                                Else
                                    objDict.Item(strKey) = "+"
                                End If
                            Else
                                Call Err_Message(4, strKey)
                                WScript.Quit 0
                            End If
                        Else
                            Call Err_Message(3, strKey)
                            WScript.Quit 0
                        End If
                    End If
                Else
                    Call Err_Message(3, strTemp)
                    WScript.Quit 0
                End If
            Next
    End Select
    '------
    '--- Проверка корректности заданных значений ключей
    For Each strTemp In objDict.Keys
        Select Case LCase(strTemp)
            Case "tc": If Len(objDict.Item(strTemp)) > 0 Then strComputer = objDict.Item(strTemp)
            Case "tlp"
                If Len(objDict.Item(strTemp)) > 0 Then
                    strTargetPath = Trim(objDict.Item(strTemp))
                    If Len(strTargetPath) >= 3 Then
                        strTargetPath = Replace(strTargetPath, "/", "\")
                        objRegExp.Pattern = "\\{2,}"
                        strTargetPath = objRegExp.Replace(strTargetPath, "\\")
                        objRegExp.Pattern = "^""|""$"
                        strTargetPath = objRegExp.Replace(strTargetPath, "")
                        objRegExp.Pattern = "^[c-z]:\\$"
                        If objRegExp.Test(Left(strTargetPath, 3)) Then
                            If Len(strTargetPath) > 3 Then
                                objRegExp.Pattern = "[<>:""\*\?\|]"
                                If objRegExp.Test(Mid(strTargetPath, 4)) Then
                                    Call Err_Message(9, strTemp)
                                    WScript.Quit 0
                                End If
                                objRegExp.Pattern = "\\$"
                                strTargetPath = objRegExp.Replace(strTargetPath, "")
                            End If
                            If strComputer = "." Then
                                strTemp = strTargetPath
                            Else
                                strTemp = "\\" & strComputer & "\" & Left(strTargetPath, 1) & "$" & _
                                            Mid(strTargetPath, 3)
                            End If
                            If Not objFS.FolderExists(strTemp) Then
                                Call Err_Message(8, strTemp)
                                WScript.Quit 0
                            End If
                        Else
                            Call Err_Message(9, strTemp)
                            WScript.Quit 0
                        End If
                    Else
                        Call Err_Message(9, strTemp)
                        WScript.Quit 0
                    End If
                Else
                    Call Err_Message(5, "tlp")
                    WScript.Quit 0
                End If
            Case "r": If Len(objDict.Item(strTemp)) > 0 Then blnRecursive = True
            Case "nl": If Len(objDict.Item(strTemp)) > 0 Then blnCreateLog = False
            Case "s": If Len(objDict.Item(strTemp)) = 0 Then blnSilent = False
        End Select
    Next
    Set objRegExp = Nothing
Else
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0, "Выбор каталога", &h10 + &h200, &h11)
    If objFolder Is Nothing Then
        WScript.Quit 0
    Else
        strTargetPath = objFolder.Self.Path
        If MsgBox("Выполнять рекурсивный просмотр папок?", vbYesNo + vbQuestion, "Очистка DACL") = vbYes Then
            blnRecursive = True
        End If
    End If
    Set objShell = Nothing
End If
If blnIsConsole And strComputer <> "." Then
    blnAvailable = Available(strComputer)
    strTargetPath = "\\" & strComputer & "\" & Left(strTargetPath, 1) & "$" & Mid(strTargetPath, 3)
End If
If blnAvailable Then
    If blnCreateLog Then
        strLogFile = objFS.BuildPath(objFS.GetParentFolderName(WScript.ScriptFullName), "Clear_DACL.log")
        Set objFile = objFS.OpenTextFile(strLogFile, 2, True)
        'objFile.WriteLine Now & vbNewLine
    Else
        Set objFile = Nothing
    End If
    On Error Resume Next
    strTemp = objFS.GetDrive(objFS.GetDriveName(strTargetPath)).FileSystem
    If Err.Number <> 0 Then
        strTemp = vbNullString
        Err.Clear
    End If
    If UCase(strTemp) = "NTFS" Then
        Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
        If Err.Number = 0 Then
            Set objFolder = objFS.GetFolder(strTargetPath)
            If Err.Number = 0 Then
                Call Clear_DACL(objWMI, objFolder, objFile, blnRecursive, blnIsConsole, blnSilent)
                If Not blnSilent Then WScript.Echo "Обработка папки " & UCase(strTargetPath) & " завершена."
            Else
                blnHasError = True
                Call Err_Message(7, "Ошибка "  & Err.Number & " при подключении к папке " & UCase(strTargetPath) & _
                                vbNewLine & Err.Description)
                Err.Clear
            End If
        Else
            blnHasError = True
            Call Err_Message(7, "Ошибка " & Err.Number & " при подключении к WMI-пространству станции """ & _
                            UCase(strComputer) & """" & vbNewLine & Err.Description)
            Err.Clear
        End If
        Set objWMI = Nothing
    Else
        If Len(strTemp) > 0 Then
            If Not objFile Is Nothing Then
                objFile.WriteLine "Объекты файловой системы " & UCase(strTemp) & " не имеют DACL."
                objFile.Close
            End If
            If Not blnSilent Then WScript.Echo "Объекты файловой системы " & UCase(strTemp) & " не имеют DACL."
        Else
            blnHasError = True
            Call Err_Message(7, "Не удалось определить тип файловой системы тома папки " & UCase(strTargetPath))
        End If
    End If
    If Not objFile Is Nothing Then
        objFile.Close
        Set objFile = Nothing
    End If
    If blnCreateLog And Not blnIsConsole And Not blnHasError Then
        Set objWShell = CreateObject("WScript.Shell")
        objWShell.Run "notepad.exe " & strLogFile, 1
        Set objWShell = Nothing
    End If
Else
    Call Err_Message(6, strComputer & " не существует или недоступен.")
End If
Set objFS = Nothing
WScript.Quit 0

'======

Function Clear_DACL(objWMIServ, objDir, objLog, blnRec, blnCon, blnSil)
Dim objItem, objSecSettings, objSD, objACE, arrACE, strSID
Dim strPath, strTemp, blnHasInherited, blnHasError, blnIsFound, intRes, i
Const SE_DACL_PROTECTED = 4096 'Флаг-признак отключенного режима наследования управляемым каталогом безопасности NTFS от "родителя"
Const INHERITED_ACE = 16 'Флаг-признак того, что текущая запись DACL унаследована от "родителя"

On Error Resume Next
For Each objItem In objDir.SubFolders
    blnHasError = False: blnIsFound = False: strSID = vbNullString
    strPath = objItem.Path
    If Err.Number = 0 Then
        strTemp = strTemp & UCase(strPath) & vbNewLine
        i = InStr(strPath, "$")
        If i > 0 Then
            strPath = Replace(Mid(strPath, i - 1), "$", ":")
        End If
        Set objSecSettings = objWMIServ.Get("Win32_LogicalFileSecuritySetting.Path='" & strPath & "'")
        If Err.Number = 0 Then
            If objSecSettings.GetSecurityDescriptor(objSD) = 0 Then
                If Err.Number = 0 Then
                    intRes = 0
                    If Not IsNull(objSD.DACL) Then
                        For Each objACE In objSD.DACL
                            If IsNull(objACE.Trustee.Name) Then
                                blnIsFound = True
                                Exit For
                            End If
                        Next
                        If blnIsFound Then
                            If CBool(objSD.ControlFlags And SE_DACL_PROTECTED) Then
                                arrACE = objSD.DACL
                            Else
                                blnHasInherited = True
                                arrACE = Array()
                                i = -1
                                '--- Выборка из исходного DACL записей, не унаследованных от "родителя"
                                For Each objACE In objSD.DACL
                                    If CBool(objACE.AceFlags And INHERITED_ACE) Then
                                        If IsNull(objACE.Trustee.Name) Then
                                            blnHasError = True
                                            strTemp = strTemp & objACE.Trustee.SIDString & _
                                                        " -> запись унаследована от ""родителя""." & vbNewLine
                                        End If
                                    Else
                                        i = i + 1
                                        ReDim Preserve arrACE(i)
                                        Set arrACE(i) = objACE
                                    End If
                                Next
                                '------
                                '--- Отключение наследования настроек безопасности от "родителя"
                                objSD.ControlFlags = objSD.ControlFlags + SE_DACL_PROTECTED
                                intResult = objSecSettings.SetSecurityDescriptor(objSD)
                                '------
                            End If
                            If intRes = 0 Then
                                '--- Поиск в DACL записей, у свойства Trustee.Name которых отсутствует значение
                                For Each objACE In arrACE
                                    If IsNull(objACE.Trustee.Name) Then
                                        objACE.AccessMask = 0 'назначение нулевой маски для последующего автоудаления записи
                                        strSID = strSID & objACE.Trustee.SIDString & " -> запись удалена." & vbNewLine
                                    End If
                                Next
                                '------
                                Set objACE = Nothing
                                objSD.DACL = arrACE 'собственно изменение DACL
                                Erase arrACE
                                '--- Включение наследования настроек безопасности от "родителя",
                                'если первоначально оно было включено
                                If blnHasInherited Then
                                    objSD.ControlFlags = objSD.ControlFlags - SE_DACL_PROTECTED
                                End If
                                '------
                                '--- Итоговое сохраненение изменений, внесённых в дескриптор безопасности
                                intRes = objSecSettings.SetSecurityDescriptor(objSD)
                                Select Case intRes
                                    Case 0
                                        strTemp = strTemp & strSID
                                        If blnHasError Then
                                            strTemp = strTemp & "Частично успешное завершение." & vbNewLine
                                        Else
                                            strTemp = strTemp & "Полностью успешное завершение." & vbNewLine
                                        End If
                                    Case 2: strTemp = strTemp & "Доступ запрещён." & vbNewLine
                                    Case 5, 9, 1307: strTemp = strTemp & "Для выполнения операции недостаточно полномочий." & vbNewLine
                                    Case 21: strTemp = strTemp & "Заданы недопустимые значения параметров." & vbNewLine
                                    Case Else: strTemp = strTemp & "Неизвестная ошибка с кодом: " & intRes & vbNewLine
                                End Select
                                '------
                            Else
                                strTemp = strTemp & "Не удалось отключить наследование безопасности." & vbNewLine
                            End If
                        Else
                            strTemp = strTemp &  "Очистка DACL не требуется." & vbNewLine
                        End If
                    Else
                        strTemp = strTemp & "Список управления доступом пуст." & vbNewLine
                    End If
                Else
                    strTemp = strTemp & "Ошибка " & Err.Number & " при выполнении метода GetSecurityDescriptor." & _
                                vbNewLine & Err.Description & vbNewLine
                    Err.Clear
                End If
            Else
                strTemp = strTemp & "Не удалось прочитать дескриптор безопасности." & vbNewLine
            End If
        Else
            strTemp = strTemp & "Ошибка " & Err.Number & " обращения к классу Win32_LogicalFileSecuritySetting " & _
                        "при обработке папки " & UCase(strPath) & vbNewLine
            Err.Clear
        End If
    Else
        blnHasError = True
        strTemp = strTemp & "Ошибка " & Err.Number & " при попытке рекурсивного просмотра папки " & _
                    UCase(objDir.Path) & vbNewLine
        Err.Clear
    End If
    Set objSD = Nothing
    Set objSecSettings = Nothing
    If Not objLog Is Nothing Then objLog.WriteLine strTemp
    If blnCon And Not blnSil Then WScript.Echo strTemp
    strTemp = vbNullString
    If blnRec And Not blnHasError Then Call Clear_DACL(objWMIServ, objItem, objLog, blnRec, blnCon, blnSil)
Next
Set objItem = Nothing
On Error GoTo 0
End Function

'======

Function Available(strName)
Dim objWShell, objExec, objOutStream, strTemp

Set objWShell = CreateObject("WScript.Shell")
Set objExec = objWShell.Exec("ping -n 1 -w 130 " & strName)
Set objOutStream = objExec.StdOut
While Not objOutStream.AtEndOfStream
    strTemp = strTemp & Trim(objOutStream.ReadLine())
Wend
If InStr(1, strTemp, "TTL", vbTextCompare) > 0 Then
    Available = True
Else
    Available = False
End If
End Function

'======

Function Err_Message(intNumber, strComment)
Select Case intNumber
    Case 1: WScript.Echo "Недопустимый ключ или набор ключей."
    Case 2: WScript.Echo "Недопустимое сочетание ключа " & UCase(strComment) & " с другими ключами."
    Case 3: WScript.Echo "Недопустимый ключ " & UCase(strComment)
    Case 4: WScript.Echo "Дублирование ключа " & UCase(strComment)
    Case 5: WScript.Echo "Ключ " & UCase(strComment) & " является обязательным."
    Case 6: WScript.Echo "Компьютер " & UCase(strComment)
    Case 7: WScript.Echo strComment
    Case 8: WScript.Echo "Папка " & UCase(strComment) & " не найдена."
    Case 9: WScript.Echo "Недопустимое значение ключа " & UCase(strComment)
    Case 10: WScript.Echo "Ключ " & UCase(strComment) & " не требует указания значения."
    Case 11: WScript.Echo "Ключ " & UCase(strComment) & " требует указания значения."
    Case Else: WScript.Echo "Не классифицированная ошибка."
End Select
End Function

'======

Function View_Help()
WScript.Echo "Сценарий предназначен для очистки DACL подпапок заданной папки" & vbNewLine & _
             "от не олицетворённых DACL-записей, оставшихся после удаления учётных записей" & vbNewLine & _
             "пользователей или групп, которым ранее соответствовали эти DACL-записи." & vbNewLine & vbNewLine & _
             "Возможности сценария:" & vbNewLine & _
             "- обеспечение работы как в графическом, так и в консольном режимах;" & vbNewLine & _
             "- обеспечение работы с папками как локального, так и удалённого компьютера;" & vbNewLine & _
             "- поддержка рекурсивного просмотра подпапок (по умолчанию - отключена);" & vbNewLine & _
             "- ведение журнала работы (по умолчанию - включена);" & vbNewLine & _
             "- поддержка работы в ""молчаливом"" режиме (по умолчанию - отключена)." & vbNewLine & vbNewLine & _
             "При работе в ""молчаливом"" режиме не выводятся никакие сообщения сценария," & vbNewLine & _
             "кроме сообщений о ситуациях, приводящих к его аварийному завершению." & vbNewLine & _
             "Данный режим никак не влияет на процедуру ведения журнала." & vbNewLine & vbNewLine & _
             "При работе в графическом режиме функциональность сценария имеет ограничения:" & vbNewLine & _
             "- доступна обработка папок только на тех томах, которые подключены локально;" & vbNewLine & _
             "- невозможен просмотр встроенной справки;" & vbNewLine & _
             "- невозможно отключение процедуры ведения журнала;" & vbNewLine & _
             "- работа ведётся в ""молчаливом"" режиме, но после завершения работы выводится" & vbNewLine & _
             "  содержимое файла журнала." & vbNewLine & vbNewLine & _
             "Ключи командной строки:" & vbNewLine & _
             "?" & vbTab & vbTab & "- вывод справки; не совместим с другими ключами." & vbNewLine & _
             "tc:<компьютер>" & vbTab & "- (""Target Computer"") NetBIOS-имя компьютера, на локальном томе" & vbNewLine & _
                                        vbTab & vbTab & "  которого размещена папка; необязательный;" & vbNewLine & _
                                        vbTab & vbTab & "  по умолчанию предполагается текущий компьютер." & vbNewLine & _
             "tlp:<путь>" & vbTab & "- (""Target Local Path"") абсолютный локальный путь к папке;" & vbNewLine & _
                                    vbTab & vbTab & "  обязательный." & vbNewLine & _
             "r" & vbTab & vbTab & "- (""Recursive"") рекурсивный просмотр подпапок; необязательный;" & vbNewLine & _
                                   vbTab & vbTab & "  по умолчанию не выпоняется." & vbNewLine & _
             "nl" & vbTab & vbTab & "- (""No Log"") отключение ведения журнала; необязательный;" & vbNewLine & _
                                    vbTab & vbTab & "  по умолчанию журнал ведётся." & vbNewLine & _
             "s" & vbTab & vbTab & "- (""Silent"") ""молчаливый"" режим; необязательный;" & vbNewLine & _
                                   vbTab & vbTab & "  по умолчанию отключен." & vbNewLine & vbNewLine & _
            "Ключ может иметь перед собой один из префиксов: ""-"" или ""/"". Порядок следования ключей произвольный."
End Function

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 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 & _
            "в качестве значения маски укажите 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
                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
                                            blnHasACE = True 'запись с искомыми SID и областью действия найдена
                                        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

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