USBMaster - Рулим флешками в офисе

'Сопоставление логических томов, назначенных съёмным накопителям,
'с физическими устройствами.
'Типы съёмных накопителей, на работу с которыми ориентирован сценарий:
'Flash-диски, Flash-карты, ZIP-диски.
'Сценарий может работать и в консольном, и в графическом режимах.
Dim objWMI, objLogicalDisks, objLD
Dim objPartitions, objPart, objDrives, objDrive, objFS
Dim strComputer, strTranslator, strList, strTemp, blnIsConsole
strComputer = ".": strList = vbNullString
Set objFS = CreateObject("Scripting.FileSystemObject")
strTranslator = objFS.GetBaseName(WScript.FullName)
Set objFS = Nothing
If StrComp(strTranslator, "cscript", vbTextCompare) = 0 Then
    blnIsConsole = True
Else
    blnIsConsole = False
End If
Set objWMI = GetObject("winmgmts:{impersonationLevel=Impersonate}!\\" & strComputer & "\root\cimv2")
Set objLogicalDisks = objWMI.ExecQuery("SELECT * FROM Win32_LogicalDisk WHERE DriveType=2")
For Each objLD In objLogicalDisks
    Set objPartitions = objWMI.ExecQuery("ASSOCIATORS OF {Win32_LogicalDisk.DeviceID=""" & _
                        objLD.DeviceID & _
                        """} WHERE AssocClass=Win32_LogicalDiskToPartition")
    For Each objPart In objPartitions
        Set objDrives = objWMI.ExecQuery("ASSOCIATORS OF {Win32_DiskPartition.DeviceID=""" & _
                        objPart.DeviceID & _
                        """} WHERE AssocClass=Win32_DiskDriveToDiskPartition")
        For Each objDrive In objDrives
            strTemp = objLD.DeviceID & " => " & objDrive.Caption & _
                        " (Диск " & objDrive.Index & ")"
            strList = strList & strTemp & vbNewLine
            If blnIsConsole Then WScript.Echo strTemp
        Next
        Set objDrive = Nothing
        Set objDrives = Nothing
    Next
    Set objPart = Nothing
    Set objPartitions = Nothing
Next
Set objLD = Nothing
Set objLogicalDisks = Nothing
Set objWMI = Nothing
If Len(strList) = 0 Then
    WScript.Echo "Накопителей указанного типа не обнаружено."
End If
If Not blnIsConsole Then WScript.Echo strList
WScript.Quit 0

'функция извлечения буквы диска, получает wmiDiskDrive.DeviceID, возвращает массив
Function USBGetLet(USBDevID)
    Dim dskLetters() 'массив букв дисков
    Set wmiServices  = GetObject("winmgmts:\\.\root\cimv2")
    Set wmiDiskPartitions = wmiServices.ExecQuery("ASSOCIATORS OF {Win32_DiskDrive.DeviceID='" _
            & USBDevID & "'} WHERE AssocClass = Win32_DiskDriveToDiskPartition")
    i = 0
    For Each wmiDiskPartition In wmiDiskPartitions 'идем по разделам
        'каждый раздел ассоциируем с логическим диском
        Set wmiLogicalDisks = wmiServices.ExecQuery _
                ("ASSOCIATORS OF {Win32_DiskPartition.DeviceID='" _
                & wmiDiskPartition.DeviceID & "'} WHERE AssocClass = Win32_LogicalDiskToPartition")
        For Each wmiLogicalDisk In wmiLogicalDisks
            ReDim Preserve dskLetters(i)
            dskLetters(i) = wmiLogicalDisk.DeviceID
        Next
    Next
    USBGetLet = dskLetters
    Set wmiLogicalDisks = Nothing
    Set wmiDiskPartitions = Nothing
    Set wmiServices = Nothing
End Function

Option Explicit

Dim objShell, strPath, strComputer
Dim objWMI, objSecSettings, objSD, objACE
Dim objSID, objTrustee, objNewACE, arrACE
Dim arrSIDs, arrDomains, arrNames, arrHasACE(), blnHasACE, strTemp, intTemp, i
Const ACCESS_ALLOWED_ACE_TYPE = 0 'Флаг-признак записи типа "РАЗРЕШЕНИЕ"
Const ACCESS_DENIED_ACE_TYPE  = 1 'Флаг-признак записи типа "ЗАПРЕТ"
Const FULL_ACCESS = 2032127 'Маска разрешения "Полный доступ"
Const SE_DACL_PROTECTED = 4096 'Флаг-признак наследования управляемым объектом безопасности NTFS от "родителя"

strComputer = "."
Set objShell = CreateObject("Shell.Application")
strPath = objShell.NameSpace(&h24).Self.Path & "\Inf\Usbstor.inf"
Set objShell = Nothing
arrSIDs = Array("S-1-5-32-544", "S-1-5-18")
arrDomains = Array("BUILTIN", "NT AUTHORITY")
arrNames = Array("Администраторы", "System")
ReDim arrHasACE(UBound(arrSIDs))

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 файла       
        '--- Отключение наследования настроек безопасности от "родителя"
        If Not CBool(objSD.ControlFlags And SE_DACL_PROTECTED) Then
            objSD.ControlFlags = objSD.ControlFlags + SE_DACL_PROTECTED
            intTemp = objSecSettings.SetSecurityDescriptor(objSD)
        End If
        '------
        If intTemp = 0 Then
            '--- Просмотр DACL для настройки типов и масок уже существующих записей
            For Each objACE In objSD.DACL
                strTemp = objACE.Trustee.SIDString
                blnHasACE = False
                For i = 0 To UBound(arrSIDs)
                    If StrComp(strTemp, arrSIDs(i), vbTextCompare) = 0 Then
                        arrHasACE(i) = True
                        blnHasACE = True
                        intTemp = intTemp + 1
                    End If
                Next
                If blnHasACE Then
                    'Назначение разрешения на полный доступ
                    objACE.AceType = ACCESS_ALLOWED_ACE_TYPE
                    objACE.AccessMask = FULL_ACCESS
                Else
                    'Назначение нулевой маски доступа для последующего автоматического удаления записи
                    objACE.AccessMask = 0
                End If
            Next
            '------
            '--- Проверка необходимости добавления в DACL дополнительных записей
            If intTemp <= UBound(arrHasACE) Then
                arrACE = objSD.DACL 'Подготовка к расширению DACL
                For i = 0 To UBound(arrHasACE)
                    If Not arrHasACE(i) Then
                        '--- Формирование нового экземпляра класса Win32_Ace
                        Set objSID = objWMI.Get("Win32_SID.SID='" & arrSIDs(i) & "'")
                        Set objTrustee = objWMI.Get("Win32_Trustee").Spawninstance_()
                        objTrustee.Domain = arrDomains(i)
                        objTrustee.Name = arrNames(i)
                        objTrustee.SID = objSID.BinaryRepresentation
                        objTrustee.SidLength = objSID.SidLength
                        objTrustee.SIDString = arrSIDs(i)
                        Set objSID = Nothing
                        Set objNewACE = objWMI.Get("Win32_Ace").Spawninstance_()
                        objNewACE.AceType  = ACCESS_ALLOWED_ACE_TYPE
                        objNewACE.AccessMask = FULL_ACCESS
                        objNewACE.Trustee = objTrustee
                        '------
                        Set objTrustee = Nothing
                        '--- Расширение DACL
                        ReDim Preserve arrACE(UBound(arrACE) + 1)
                        Set arrACE(UBound(arrACE)) = objNewACE
                        '------
                        Set objNewACE = Nothing
                    End If
                Next
                objSD.DACL = arrACE
                Erase arrACE
            End If
            '------
            intTemp = objSecSettings.SetSecurityDescriptor(objSD) 'Попытка сохранения внесённых в DACL изменений
            If intTemp = 0 Then
                WScript.Echo "Настройка безопасности для файла " & UCase(strPath) & " выполнена."
            Else
                WScript.Echo "Настройка безопасности для файла " & UCase(strPath) & " не выполнена." & vbNewLine & _
                            "Код ошибки: " & intTemp
            End If
        Else
            WScript.Echo "Не удалось отключить наследование безопасности для файла " & UCase(strPath)
        End If
    Else
        WScript.Echo "Список управления доступом к файлу " & UCase(strPath) & " пуст."
    End If
Else
    WScript.Echo "Не удалось прочитать дескриптор безопасности файла " & UCase(strPath)
End If
Set objSD = Nothing
Set objSecSettings = Nothing
Set objWMI = Nothing
WScript.Quit 0