Dim objWMI, objCollection, objItem
Dim strSharePath, strShareServer, strShareName, strShareTarget
Dim objSecSettings, objSD, objACE, arrACE
Dim objDict, objUser, arrTemp, strList, strTemp, xRes
Const ACCESS_ALLOWED_ACE_TYPE = 0
Const ACCESS_DENIED_ACE_TYPE = 1
Const SE_DACL_PROTECTED = 4096
Const CREATE_FILE_WRITE_DATA = &H2
Const GENERIC_WRITE = &H40000000

strSharePath = "\\fileserver\Имя_ресурса"
arrTemp = Split(Replace(strSharePath, "\\", ""), "\", -1, vbTextCompare)
strShareServer = arrTemp(0)
strShareName = arrTemp(1)
Erase arrTemp
On Error Resume Next
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strShareServer & "\root\CIMV2")
If Err.Number = 0 Then
    Set objCollection = objWMI.ExecQuery("SELECT Path FROM Win32_Share WHERE Name='" & strShareName & "'")
    If objCollection.Count > 0 Then
        For Each objItem In objCollection
            'Wscript.Echo "Ресурс " & UCase(strSharePath) & " -> " & objItem.Path
            strShareTarget = objItem.Path
        Next
        Set objItem = Nothing
        Set objSecSettings = objWMI.Get("Win32_LogicalFileSecuritySetting.Path='" & strShareTarget & "'")
        If Err.Number = 0 Then
            If objSecSettings.GetSecurityDescriptor(objSD) = 0 Then
                If Not IsNull(objSD.DACL) Then
                    Set objDict = CreateObject("Scripting.Dictionary")
                    objDict.CompareMode = 1
                    For Each objACE In objSD.DACL
                        strTemp = objACE.Trustee.Domain & "/" & objACE.Trustee.Name
                        If Not objDict.Exists(strTemp) Then
                            If objACE.AceType = ACCESS_ALLOWED_ACE_TYPE Then
                                If CBool(objACE.AccessMask And CREATE_FILE_WRITE_DATA Or _
                                    objACE.AccessMask And GENERIC_WRITE) Then
                                    objDict.Add strTemp, True
                                Else
                                    objDict.Add strTemp, False
                                End If
                            End If
                        End If
                    Next
                    For Each strTemp In objDict.Keys
                        Set objUser = GetObject("WinNT://" & strTemp & ",user")
                        If Err.Number = 0 Then
                            If objDict.Item(strTemp) Then
                                strList = strList & strTemp & " -> пишет" & vbNewLine
                                'Настроить членство пользователя в группе AD
                            Else
                                strList = strList & strTemp & " -> читает" & vbNewLine
                                'Настроить членство пользователя в группе AD
                            End If
                        Else
                            Err.Clear
                            objDict.Remove (strTemp)
                        End If
                    Next
                    Set objUser = Nothing
                    WScript.Echo strList
                    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
                        arrACE = objSD.DACL
                        For Each objACE In arrACE
                            strTemp = objACE.Trustee.Domain & "/" & objACE.Trustee.Name
                            If objDict.Exists(strTemp) Then objACE.AccessMask = 0
                            'Убрать (или изменить) проверку условия в вышележащем операторе
                        Next
                        Set objACE = Nothing
                        'Сформировать новые ACE для групп и добавить их в DACL
                        xRes = objSecSettings.SetSecurityDescriptor(objSD)
                        Select Case xRes
                            Case 0: xRes = "Успешное завершение."
                            Case 2: xRes = "Доступ запрещён."
                            Case 5, 9: xRes = "Для выполнения операции недостаточно полномочий."
                            Case 21: xRes = "Заданы недопустимые значения параметров."
                            Case Else: xRes = "Неизвестная ошибка с кодом: " & xRes
                        End Select
                    Else
                        xRes = "Не удалось отключить наследование безопасности для каталога " & UCase(strShareTarget)
                    End If
                    Set objDict = Nothing
                    WScript.Echo xRes
                Else
                    WScript.Echo "Список управления доступом к каталогу " & UCase(strShareTarget) & " пуст."
                End If
            Else
                WScript.Echo "Не удалось прочитать дескриптор безопасности каталога " & UCase(strShareTarget)
            End If
            Set objSD = Nothing
        Else
            WScript.Echo "Ошибка " & CStr(Err.Number) & vbNewLine & Err.Description
            Err.Clear
        End If
        Set objSecSettings = Nothing
    Else
        WScript.Echo "Не найден ресурс " & UCase(strSharePath)
    End If
    Set objCollection = Nothing
Else
    WScript.Echo "Ошибка " & CStr(Err.Number) & vbNewLine & Err.Description
    Err.Clear
End If
Set objWMI = Nothing
WScript.Quit 0