Pacific microelectronics: заказ печатных плат.

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

Автор: Анатолий Демидович

В этой статье я расскажу Вам, как стать властелином USB-устройств хранения информации (далее — флешек) используя: Windows Script Host, Windows Management Instrumentation и VBScript, – на мой взгляд, довольно несложные вещи, которые по умолчанию имеют место быть в операционных системах Windows начиная с XP.

«Нужное не сложно, сложное не нужно», – учил один персонаж,

реальное существование, которого не вызывает сомнений…

Легенда приблизительно такая. В организации существует список сертифицированных, разрешенных к использованию, флешек. Кроме того, есть специалист по информационной безопасности, отвечающий за использование исключительно «правильных» флешек. Периодически приезжают серьезные товарищи из организации, наименование которой здесь даже страшно упоминать, и проверяют, каким образом местный специалист выполняет свою работу. Ниже я попробую помочь подобным специалистам в части организации оборота флешек.

Обозначим задачи:

  1. управлять автозапуском и использованием флешек;
  2. извлекать информацию о текущих и установленных в системе флешках;
  3. удалять информацию об установленных в системе флешках.

Решение перечисленных задач реализуем следующим образом:

  1. Напишем скрипты для решения каждой отдельной задачи
  2. Создадим VBA приложение
  3. Создадим HTA приложение

Ready — Steady – Go. 

Управление автозапуском

Благодаря включенному автозапуску в компьютер нередко попадают вирусы, поэтому не мешало бы уметь его отключать. Существуют разные способы запрета автозапуска флешек. Всем известный антивирус Касперского предлагает запретить автозапуск через «окно поиска уязвимостей». Полагаю, разработчики Каспера не зря едят свой хлеб, поэтому будем считать их способ наиболее «правильным». Сделаем снимок реестра программой типа Regshot. При помощи Каспера запретим «автозапуск со съемных дисков». Сделаем еще один снимок реестра и сравним его с первым. Появился параметр NoDriveTypeAutoRun типа «REG_DWORD» со значением 4 раздела реестра «HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\policies\Explorer«.

Откроем блокнот.  Я использую Notepad++. Напишем нехитрый скрипт:

On Error Resume Next 'пропустим ошибки ошибки
Dim keyNoAutoRunVal 'значение ключа
Dim wshShell 'оболочка
Dim a, b, c, d 'тексты сообщений
Dim mesaga 'само сообщение
'ключ для проверки
Const keyNoAutoRun = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\policies\Explorer\NoDriveTypeAutoRun"
a = "__________________________________________" & vbCrLf & vbCrLf & "Включить?" & vbCrLf & _
"__________________________________________"
b = "__________________________________________" & vbCrLf & vbCrLf & "Отключить?" & vbCrLf & _
"__________________________________________"
c = "Автозапуск USB-устройств включен"
d = "Автозапуск USB-устройств отключен"
Set wshShell = CreateObject("WScript.Shell")'получаем оболочку
keyNoAutoRunVal = wshShell.RegRead (keyNoAutoRun)'читаем ключ
If Err = 0 And keyNoAutoRunVal = 4 Then 'если ошибки нет - ключ существует и значение равно 4 - автозапуск запрещен
  mesaga = MsgBox (a, vbYesNo + vbInformation, d) 'выкатываем сообщение
  If mesaga = vbYes Then wshShell.RegDelete keyNoAutoRun 'удаляем ключ
Else 'если ключа не существует - ошибка - автозапуск разрешен
  mesaga = MsgBox (b, vbYesNo + vbInformation, c) 'выкатываем сообщение
  If mesaga = vbYes Then wshShell.RegWrite keyNoAutoRun, 4, "REG_DWORD" 'пишем ключ
End If

Сохраним в формате VBS. Запускаем… I’ve got the power. 

Управление использованием

Предотвращение использования флешек подробно описано в статье на сайте мелкомягких. Для запрета установки флешек нам предлагают присвоить пользователю, группе или локальной учетной записи SYSTEM разрешение запретить для следующих файлов: ”%SystemRoot%\Inf\Usbstor.pnf и %SystemRoot%\Inf\Usbstor.inf«. Скриптом это сделать проблематично, поэтому сделаем проще: переименуем эти файлы в Usbstor.pnf.bak и Usbstor.inf.bak, соответственно. Можно, конечно, переместить эти файлы в какое-нибудь «секретное» место, или рандомизировать новые наименования (при этом придется вести список переименованных файлов для каждого компьютера), однако мы оставим такие методы для параноиков. Для запрета использования уже установленных флешек в этой же статье нам предлагают установить значение 4 типа «REG_DWORD» параметра Start раздела реестра «HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\USBSTOR«. В этом случае ничего изобретать не надо. Для начала напишем функцию проверки существования ключа реестра:

Function KeyExists(key) 'функция проверки существования ключа реестра
Dim wshShell
Dim key2
On Error Resume Next'пропускаем ошибки
Set wshShell = CreateObject("WScript.Shell")
key2 = wshShell.RegRead(key) 'читаем ключ
If Err.Number <> 0 Then 'если ошибка - ключа нет
  KeyExists = False
Else 'значит есть
  KeyExists = True
End If
On Error GoTo 0'возвращаем ошибки в исходное положение
End Function

Скомбинируем возможные значения ключа реестра и имена наших файлов:

  • комбинация №1: Ключ <> 4 (использование установленных разрешено), файлы: Usbstor.pnf и Usbstor.inf (установка разрешена);
  • комбинация №2: Ключ <> 4 (использование установленных разрешено), файлы: Usbstor.pnf.bak и Usbstor.inf.bak (установка запрещена);
  • комбинация №3: Ключ = 4 (использование установленных запрещено), файлы: Usbstor.pnf.bak и Usbstor.inf.bak (установка запрещена).

Напишем функцию проверки состояния использования флешек:

Function USBUseState()'функция проверки состояния использования флешек
On Error Resume Next
Dim fso, sfolder'файловая система и специальные папки
Dim fUSBInf, fUsbPnf'файлы usbstor.inf и usbstor.PNF используются при установке новых USB-устройств
Dim fUSBInfBak, fUsbPnfBak'переименованные файлы - usbstor.inf.bak и usbstor.PNF.bak
Dim keyVal'значение ключа
'ключ реестра для уже установленных USB-устройств
Const keyUsbstor = "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\USBSTOR\Start"
'сообщение об отсутствии файлов
Const msgFile = "Файлы, необходимые для правильной работы USB-устройств отсутствуют"
'сообщение об отсутствии ключа
Const msgKey = "Ключ реестра, необходимый для правильной работы USB-устройств отсутствует"
Set fso = CreateObject("Scripting.FileSystemObject")'файловая система
sfolder = fso.GetSpecialFolder(0)'получаем путь к папке Windows
fUSBInf = sfolder & "\inf\usbstor.inf"'полное наименование файла usbstor.inf
fUsbPnf = sfolder & "\inf\usbstor.PNF"'полное наименование файла usbstor.PNF
fUSBInfBak = fUSBInf & ".bak"'наименование переименованного файла usbstor.inf
fUsbPnfBak = fUSBPnf & ".bak"'наименование переименованного файла usbstor.inf
If KeyExists(keyUsbstor) Then'если ключ существует
  keyVal = wshShell.RegRead (keyUsbstor)'читаем ключ  
  If keyVal <> 4 Then'2 - автоматически запускается, 3 - вручную (по умолчанию), 4 - не запускается
    If fso.FileExists (fUSBInf) And fso.FileExists (fUSBPnf) Then'если файлы существуют
      USBUseState = 1'комбинация №1 - все разрешено
    ElseIf fso.FileExists (fUSBInfBak) And fso.FileExists (fUsbPnfBak) Then'если файлы переименованы
      USBUseState = 2'комбинация №2 - запрещена установка
    Else'если нет ни тех, ни других файлов      
      USBUseState = msgFile'сообщаем в вызвавшую программу об ошибке
      Exit Function'выходим из функции    
    End If
  Else'значение ключа = 4  
    USBUseState = 3'комбинация №3 - все запрещено
  End If 
Else'если ключа нет  
  USBUseState = msgKey'сообщаем об ошибке
End If
End Function

Хочу обратить внимание на то, что в каждой отдельной функции или процедуре скриптов мы будем использовать локальные переменные. На первый взгляд это может показаться избыточным, однако в дальнейшем это поможет нам просто копировать код из скриптов в приложения. Далее напишем основной код скрипта:

On Error Resume Next
Dim stateVal'значение состояния использования флешек
Dim stateValMsg'сообщение о состоянии
Dim mesaga'сообщение
Dim msgText'текст сообщения
Const msgErr = "Ошибка"'заголовок сообщения об ошибке
Const msgBan1 = "Использование USB-устройств разрешено"'заголовки сообщений о состоянии
Const msgBan2 = "Запрещена установка USB-устройств"
Const msgBan3 = "Использование USB-устройств запрещено"
msgText = "Выберите нужное состояние:" & vbCrLf & _
    "________________________________________" & _
    vbCrLf & vbCrLf & _
    "ПРЕРВАТЬ - запретить использование" & vbCrLf & _
    "ПОВТОР - запретить установку" & vbCrLf & _
    "ПРОПУСТИТЬ - разрешить использование" & vbCrLf & _
    "________________________________________"

stateVal = USBUseState'получаем значение состояния
If IsNumeric(stateVal) Then 'если число - ошибки нет
  If stateVal = 1 Then 
    stateValMsg = msgBan1
  ElseIf stateVal = 2 Then
    stateValMsg = msgBan2
  ElseIf stateVal = 3 Then
    stateValMsg = msgBan3  
  End If
  'выкатываем сообщение используем максимум возможных кнопок окна MsgBox - 3 :)
  mesaga = MsgBox (msgText,vbAbortRetryIgnore + vbQuestion,stateValMsg)
  'ошибок 100% нет, поэтому смело работаем с значением ключа реестра и файлами
  If  mesaga = vbAbort Then'если запрещаем использование и выкатываем сообщение
    USBUseBan(3)
    MsgBox msgBan3, vbInformation
  ElseIf mesaga = vbRetry Then'если запрещаем установку
    USBUseBan(2)    
    MsgBox msgBan2, vbInformation
  ElseIf mesaga = vbIgnore Then'если разрешаем использование
    USBUseBan(1)  
    MsgBox msgBan1, vbInformation  
  End If
Else 'если не число - строка - ошибка
  MsgBox stateVal, vbCritical, msgErr'полученное из функции сообщение об ошибке  
End If
'процедура запрета-разрешения использования флешек в зависимости от полученного аргумента:
Sub USBUseBan(ArgVal)'ArgVal - желаемое состояние
On Error Resume Next'пропустим ошибки, чтобы не париться в очередной раз с проверкой существования файлов
Dim wshShell
Dim fso, sfolder'файловая система и специальные папки
Dim fUSBInf, fUsbPnf'файлы usbstor.inf и usbstor.PNF используются при установке новых USB-устройств
Dim fUSBInfBak, fUsbPnfBak'переименованные файлы - usbstor.inf.bak и usbstor.PNF.bak
Dim keyVal'значение ключа
'ключ реестра для уже установленных USB-устройств
Const keyUsbstor = "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\USBSTOR\Start"
Set wshShell = CreateObject("WScript.Shell") 
Set fso = CreateObject("Scripting.FileSystemObject")'файловая система
sfolder = fso.GetSpecialFolder(0)'получаем путь к папке Windows
fUSBInf = sfolder & "\inf\usbstor.inf"'полное наименование файла usbstor.inf
fUsbPnf = sfolder & "\inf\usbstor.PNF"'полное наименование файла usbstor.PNF
fUSBInfBak = fUSBInf & ".bak"'наименование переименованного файла usbstor.inf
fUsbPnfBak = fUSBPnf & ".bak"'наименование переименованного файла usbstor.inf
If ArgVal <> 1 Then'если запрещаем либо установку, либо использование
  fso.MoveFile fUSBInf, fUSBInfBak  'переименуем файлы, если ошибка - файлы уже переименованы - едем дальше
  fso.MoveFile fUsbPnf, fUsbPnfBak
  If ArgVal = 3 Then 
    wshShell.RegWrite keyUsbstor, 4, "REG_DWORD"'если запрещаем использование - комбинация №3
  Else: wshShell.RegWrite keyUsbstor, 3, "REG_DWORD"'в противном случае - комбинация №2 - пишем значение по умолчанию
  End If
Else'если все разрешаем - комбинация №1
  wshShell.RegWrite keyUsbstor, 3, "REG_DWORD"'пишем значение по умолчанию
  fso.MoveFile fUSBInfBak, fUSBInf  'переименуем файлы обратно, если ошибка - файлы уже переименованы - едем дальше
  fso.MoveFile fUsbPnfBak, fUsbPnf
End If
End Sub

Собираем все в кучу (ниже добавляем наши функции) и сохраняем в файле с расширением VBS. Запускаем…Things get better.

Управление информацией

Для того чтобы эффективно рулить флешками в организации, нам необходимо:

вести список разрешенных к использованию флешек;

извлекать информацию о текущих флешках;

сравнивать полученную информацию со списком и добавлять ее в список при необходимости;

извлекать информацию из реестра об установленных в системе флешках;

сравнивать полученную информацию со списком;

удалять из реестра информацию об установленных флешках.

В сети интернет я нашел программу USBDeview, которая частично решает поставленные задачи. Недостатки:

избыточность информации – нас интересуют только флешки, серийные номера, наименования, объем, VendorID и ProductID (на случай перепрошивки не помешает) – отсюда неудобство использования (попробуйте с ее помощью решить поставленные задачи, если количество флешек переваливает за несколько сотен);

на мой взгляд самый основной недостаток: программа «пляшет» от одного раздела реестра — «HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Enum\USB«, таким образом не всегда получает необходимую информацию о флешках, и, что крайне важно, удаляет информацию только из этого раздела;

прочие недостатки для себя найдете сами.

Для извлечения информации как нельзя лучше подойдет технология Windows Management Instrumentation.

Извлечение информации о текущих флешках

Используем классы WMI:

Win32_DiskDrive для работы с физическими накопителями [1];

Win32_USBHub для работы с USB [2];

StdRegProv для работы с реестром [3];

Итак, откроем блокнот и напишем функцию извлечения информация о текущих флешках: 

'функция извлечения информация о текущих флешках, возвращает двухмерный массив  
'1-я размерность: серийный номер, наименование, объем, VID и PID
'2-я размерность: счетчик
Function USBGetCur()
On Error Resume Next
Dim wmiDiskDrive, wmiDiskDrives 'диски
Dim wmiUSBHub, wmiUSBHubs 'USB
Dim PnPID, PnPID2 'идентификатор флешки
Dim USBSNumb 'серийный номер
Dim arrUSBInfo() 'массив для информации о каждой флешке    
Dim i'счетчик
'переменные для 2-го способа извлечения VID-PID
Dim strComputer 'местный компьютер
Dim strValueName 'название параметра
Dim strKeyPath 'раздел с информацией об USB
Dim objReg 'реестр
Dim subkey, arrSubKeys, arrSubKeys1 'подключ и массивы подразделов
Dim ParIdPre' переменная для параметра ParentIdPrefix
Const HKLM = &H80000002    
Set wmiDiskDrives = GetObject("winmgmts:").InstancesOf("Win32_DiskDrive")'получаем диски
Set wmiUSBHubs = GetObject("winmgmts:").InstancesOf("Win32_USBHub")'получаем USB
'значения для 2-го способа извлечения VID-PID
strComputer = "."'местный компьютер
strValueName = "ParentIdPrefix"'название параметра
strKeyPath = "SYSTEM\CurrentControlSet\Enum\USB"'раздел с информацией об USB
Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")'получаем провайдера реестра    
i = 0
For Each wmiDiskDrive In wmiDiskDrives'побежали по дискам
  If wmiDiskDrive.InterfaceType = "USB" Then'если диск USB        
    ReDim Preserve arrUSBInfo(4, i)'перебили размерность массива        
    arrUSBInfo(1,i) = wmiDiskDrive.Model'модель диска
    arrUSBInfo(2,i) = wmiDiskDrive.Size'объем диска        
    PnPID = wmiDiskDrive.PnPDeviceID'идентификатор флешки из реестра    
    'вытаскиваем серийный номер флешки
    USBSNumb = Mid(PnPID, InStrRev(PnPID, "\") + 1)'выбираем из строки-идентификатора серийник
    arrUSBInfo(0,i) = Left(USBSNumb, Len(USBSNumb)-2)'удаляем последние 2 символа - типа &0 или &1
    For Each wmiUSBHub In wmiUSBHubs'побежали по USB
      PnPID2 = wmiUSBHub.PNPDeviceID
      'вытаскиваем серийник и сравниваем с серийником из Win32_DiskDrive
      If Right(PnPID2,Len(PnPID2)-Instr(5,PnPID2,"\")) = arrUSBInfo(0,i) Then      
        arrUSBInfo(3,i) = Mid(PnPID2,9,4)'вытаскиваем VID
        arrUSBInfo(4,i) = Mid(PnPID2,18,4)'вытаскиваем PID
        Exit For
      End If
    Next
    If IsEmpty(arrUSBInfo(3,i)) Then'если не прокатило получить VID, тогда попробуем 2-й способ - через реестр          
      objReg.EnumKey HKLM, strKeyPath, arrSubKeys'получаем подразделы
      If IsArray(arrSubKeys) Then'на всякий случай - если массив
        For Each subkey In arrSubKeys'для каждого подраздела
          If Left(subkey,3) = "Vid" Then'если название раздела начинается с Vid - пропускаем ROOT_HUB и пр.      
            objReg.EnumKey HKLM, strKeyPath & "\" & subkey, arrSubKeys1'получаем подразделы подразделов
            If IsArray(arrSubKeys1) Then'снова если массив
              For Each subsubkey In arrSubKeys1'для каждого подраздела подразделов
                'получаем значение параметра ParentIdPrefix
                objReg.GetStringValue HKLM, strKeyPath & "\" & subkey & "\" & subsubkey, strValueName, ParIdPre
                'поднимем в верхний регистр ParentIdPrefix и сравним с серийным номером
                If UCase(ParIdPre) = USBSNumb Then
                  arrUSBInfo(3,i) = Mid(subkey,5,4)'вытаскиваем из строки VID и PID
                  arrUSBInfo(4,i) = Mid(subkey,14,4)
                End If
              Next
            End If
          End If
        Next
      End If
    End If        
    i = i + 1
  End If
Next    
If i <>0 Then 
  USBGetCur = arrUSBInfo'если есть флешки
Else
  USBGetCur = i
End If
End Function

Далее, создадим еще один текстовый файл и запишем в него следующую строку:

Серийный номер;Наименование;Объем;Владелец

Назовем его USBBase.csv и сохраним. Это будет наша база данных для хранения информации о разрешенных флешках. Использование формата CSV обусловлено тем, что пользователю довольно легко вносить изменения в базу вручную. При условии, что на компьютере установлен MS Excel, пользоваться такой базой несложно. Следующим шагом напишем функцию чтения информации из нашего файла: 

'функция чтения файла базы, возвращает двухмерный массив
'1-я размерность: серийный номер, наименование, объем, владелец
'2-я размерность: счетчик
Function ReadCSV()
On Error Resume Next
Dim wshShell 'оболочка
Dim fso 'файловая система
Dim baseFilePath 'полное имя файла базы
'Dim baseFileName 'имя файла базы
Dim baseFile 'сам файл
Dim dataArray() 'массив для строк из csv-файла
Dim splitArray 'массив разбитых прочитанных строк
Dim dataArray1() 'двухмерный массив для разбитых строк
Dim i, j 'счетчики
Const baseFileName = "USBBase.csv" 'имя файла базы
Set wshShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject") 
'получаем полный путь к файлу базы: текущий каталог скрипта + имя файла базы
baseFilePath = wshShell.CurrentDirectory & "\" & baseFileName     
If fso.FileExists(baseFilePath) Then 'если файл базы существует    
  Set baseFile = fso.OpenTextFile(baseFilePath) 'открываем файл      
  i = 0
  Do Until baseFile.AtEndOfStream'читаем
    ReDim Preserve dataArray(i)'перебили размерность массива
    dataArray(i) = baseFile.ReadLine 'читаем строку и закидываем в массив
    splitArray = Split(dataArray(i), ";") 'разбиваем и закидываем во второй массив
    ReDim Preserve dataArray1(3, i)'перебили размерность 3-го массива        
    For j = 0 To 3
      dataArray1(j, i) = splitArray(j)'закидываем полученное в 3-й массив - вот так вот весело :)
    Next        
    i = i + 1
  Loop
  baseFile.Close
  ReadCSV = dataArray1
End If
End Function

Затем напишем основной код скрипта:

On Error Resume Next
Dim USBCur 'текущие флешки
Dim CSVRead 'прочитанные из списка флешки
Dim mesaga, vlad 'сообщения
Dim wshShell 'оболочка
Dim fso 'файловая система
Dim baseFilePath 'полное имя файла базы
Const baseFileName = "USBBase.csv" 'имя файла базы
USBCur = USBGetCur()'получаем текущие
CSVRead = ReadCSV()'получаем список
Set fso = CreateObject("Scripting.FileSystemObject")
Set wshShell = CreateObject("WScript.Shell")
'получаем полный путь к файлу базы: текущий каталог скрипта + имя файла базы
baseFilePath = wshShell.CurrentDirectory & "\" & baseFileName
If fso.FileExists(baseFilePath) Then 'если файл существует
  ' сравним серийные номера - побежали по текущим
  If IsArray(USBCur) Then'если есть хоть одна флешка - массив, если нет - число 0
    y = 0 'счетчик - на случай если в списке одинаковые серийники
    For i = LBound(USBCur, 2) To UBound(USBCur, 2)'идем по размерности №2
      'побежали по списку
      For j = 1 To UBound(CSVRead, 2)'идем по размерности №2 - первую строку не читаем - заголовки столбцов
        'если флешка обнаружена в списке
        If USBCur(0,i) = CSVRead(0,j) Then 
          MsgBox "________________________________________" & vbCrLf & _
          vbCrLf & "Владелец: " & CSVRead(3,j) & vbCrLf & "________________________________________", _
          vbOKOnly + vbInformation, "USB-устройство обнаружено в списке"
          y = y + 1
          Exit For
        End If      
      Next
      If y = 0 Then 'если в списке нет такой флешки
        mesaga = MsgBox ("__________________________________________" & vbCrLf & vbCrLf & _
            "Серийный номер: " & USBCur(0,i) & vbCrLf & "Наименование: " & USBCur(1,i) & vbCrLf & _
            "Объем: " & USBCur(2,i) & vbCrLf & "__________________________________________" & vbCrLf & _
            "Добавить в список?", vbYesNo + vbInformation, "USB-устройство отсутствует в списке")
        If mesaga = vbYes Then
          vlad = InputBox("Пожалуйста, введите имя владельца")
          Set baseFile = fso.OpenTextFile(baseFilePath,8) 'открываем файл  для добавления
          baseFile.WriteLine USBCur(0,i) & ";" & USBCur(1,i) & ";" & USBCur(2,i) & ";" & vlad
          baseFile.Close
        End If
      End If
      'если в списке несколько одинаковых серийных номеров
      If y > 1 Then MsgBox "Серийный номер USB-устройства в списке повторяется", vbCritical, "В списке обнаружена ошибка"    
    Next
  Else: MsgBox "Вставьте USB-устройство в USB-порт", vbExclamation, "USB-устройств не обнаружено"
  End If
Else: MsgBox "Файл USBBase.csv отсутствует", vbCritical, "Ошибка" 'если файл отсутствует
End If

Собираем, сохраняем, запускаем… Voila.

Извлечение информации об установленных флешках

Информацию об установленных флешках будем сохранять в файл. Открываем блокнот, пишем процедуру извлечения информации из реестра:

'процедура получения информации о всех флешках и сохранения в файл
'с расширением в зависимости от полученного параметра: 0 - .htm, 1 - .csv
Sub InfToFile(zn) 
On Error Resume Next
Dim subkey, subsubkey 'ключ, подключ
Dim arrSubKeys(), arrSubKeys1()  'массивы подключей  
Dim objReg 'реестр 
Dim wshShell 'оболочка 
Dim strComputer 'компьютер     
Dim compName 'имя компьютера
Dim repFile 'файл отчета
Dim repFileName'имя файла отчета
Dim USBMas() 'массив для полученных значений
Const HKLM = &H80000002
Const strValueName = "FriendlyName" 'название параметра имени флешки  
Const strKeyPath = "SYSTEM\CurrentControlSet\Enum\USBSTOR" 'раздел с информацией об USB    
strComputer = "." 'местный компьютер        
Set wshShell = CreateObject("WScript.Shell")
compName = wshShell.ExpandEnvironmentStrings("%COMPUTERNAME%") 'получаем имя компьютера
Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv") 'получаем провайдера реестра
objReg.EnumKey HKLM, strKeyPath, arrSubKeys 'получаем подразделы
i = 0 'счетчик
If IsArray(arrSubKeys) Then'если массив - есть хоть один ключ
  For Each subkey In arrSubKeys 'для каждого подраздела            
    objReg.EnumKey HKLM, strKeyPath & "\" & subkey, arrSubKeys1 'получаем подразделы подразделов
    If IsArray(arrSubKeys1) Then'снова если массив
      For Each subsubkey In arrSubKeys1 'для каждого подраздела подразделов              
        ReDim Preserve USBMas(1, i)
        USBMas(0, i) = UCase(Left(subsubkey, Len(subsubkey) - 2)) 'получаем название минус последние 2 символа - серийный номер флешки
        objReg.GetStringValue HKLM, strKeyPath & "\" & subkey & "\" & subsubkey, strValueName, USBMas(1, i) 'получаем название флешки
        i = i + 1              
      Next
    End If        
  Next
End If
Set fso = CreateObject("Scripting.FileSystemObject")
If zn = 0 Then 'в формат .htm
  repFileName = wshShell.CurrentDirectory & "\" & compName & "-" & Date & ".htm"'имя создаваемого файла в папке скрипта
  'создаем файл, если уже существует - перезапишем
  Set repFile = fso.CreateTextFile(repFileName, True)
  'пишем в файл начальные тэги и заголовок таблицы
  repFile.WriteLine "<html><title>USBMaster - Report</title><body><table border=" & Chr(34) & _
      1 & Chr(34) & " width = 90% align = center><tr><th colspan=" & Chr(34) & 2 & Chr(34) & _
      ">Список USB-устройств хранения информации, установленных на компьютере " & compName & _
      " " & Date & " г.</th></tr><tr><td>Серийный номер</td><td>Наименование</td></tr>"
  If IsArray(USBMas) Then'если массив - хоть что-нибудь есть
    For i = LBound(USBMas, 2) To UBound(USBMas, 2)'заполняем таблицу
      repFile.WriteLine "<tr><td>" & USBMas(0, i) & "</td><td>" & USBMas(1, i) & "</td></tr>"
    Next
  End If
  repFile.WriteLine "</table></body></html>"'закрываем тэги
  repFile.Close ' закрываем файл      
  wshShell.Run (repFileName) 'открываем файл программой по умолчанию
ElseIf zn = 1 Then 'в формат .csv
  repFileName = wshShell.CurrentDirectory & "\" & compName & "-" & Date & ".csv"'имя создаваемого файла в папке скрипта
  'создаем файл, если уже существует - перезапишем
  Set repFile = fso.CreateTextFile (repFileName, true)
  repFile.WriteLine "Серийный номер;Наименование" 'пишем заголовки столбцов
  If IsArray(USBMas) Then'если массив - хоть что-нибудь есть
    For i = LBound(USBMas,2) To UBound(USBMas,2)
      repFile.WriteLine USBMas(0,i) & ";" & USBMas(1,i)  
    Next
  End If
  repFile.Close' закрываем файл    
  wshShell.Run (repFileName)'открываем файл программой по умолчанию
End If    
End Sub

Далее напишем основной код скрипта:

On Error Resume Next
Dim mesaga'сообщение
Dim msgText'текст сообщения
msgText = "Выберите формат файла для сохранения:" & vbCrLf & _
    "________________________________________" & _
    vbCrLf & vbCrLf & _
    "ДА - htm" & vbCrLf & _
    "НЕТ - csv" & vbCrLf & _    
    "________________________________________"
mesaga = MsgBox (msgText,vbYesNoCancel + vbQuestion,"Извлечение информации")
If mesaga = vbYes Then 
  InfToFile(0)
ElseIf mesaga = vbNo Then 
  InfToFile(1)
End If

Собираем, сохраняем, запускаем… Everything’s gonna be allright.

Удаление информации об установленных флешках. Самое вкусное :)

Информация хранится в следующих разделах реестра:

«HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Enum\USBSTOR»

«HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Enum\USB»

«HKEY_LOCAL_MACHINE\SYSTEM\ControlSetХХХ\Enum\USBSTOR»

«HKEY_LOCAL_MACHINE\SYSTEM\ControlSetХХХ\Enum\USB»

где Х = цифра (ControlSet001, ControlSet002 и т.д)

По умолчанию полный доступ к перечисленным разделам имеет только учетная запись SYSTEM. Следовательно, мы не сможем в цикле пробежать по всем подразделам и удалить ненужные (или нужные). Изменить разрешения, используя заявленные выше средства, тоже не получится. Планировщик заданий Windows запускает назначенные задания от имени системы. Его и используем. Напишем скрипт, который будет создавать задание в планировщике, которое в свою очередь будет запускать этот же скрипт с параметрами в начале следующей минуты: 

'удаление из реестра информации об установленных флешках через
'планировщик заданий и аргументы скрипта
On Error Resume Next
Dim objReg 'с переменными особо заморачиваться не будем
Dim wshShell
Const HKLM = &H80000002
Const strSys = "SYSTEM"
Const strUSB = "\Enum\USB\"
Const strUSBSTOR = "\Enum\USBSTOR\"
Const CCS = "CurrentControlSet"
Const CSX = "ControlSet"
Set objReg = GetObject("winmgmts:\\.\root\default:StdRegProv")
Set wshShell = CreateObject("WScript.Shell")
'проверяем аргументы
If WScript.Arguments.Count = 0 Then'если нет аргументов
  mesaga = MsgBox ("Удалить информацию об установленных USB-устройствах?", vbYesNo + vbInformation, "Удаление информации")
  If mesaga = vbYes Then MkTask 'создаем задание  
ElseIf WScript.Arguments(0) = "/d" Then'если аргумент /d - типа delete :)
  ChkNDel(0)  'удаляем информацию от имени системы
End If

Sub MkTask()'процедура создания задания
Dim sched 'планировщик
Dim compName 'имя компьютера
compName = wshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")'получаем имя компьютера
Set sched = GetObject("WinNT://" & compName & "/schedule, service")'получаем службу планировщика заданий
If sched.Status <> 4 Then 'если служба планировщика не запущена
    If sched.Status = 1 Then 'если служба планировщика не работает
        sched.Start 'запустить
    ElseIf sched.Status = 7 Then 'если приостановлена
        sched.Continue 'возобновить
    Else 'если или ошибка службы или пытается что-то сделать
        MsgBox "Планировщик заданий не работает", vbCritical, "Ошибка"
        Exit Sub 'завершаем выполнение
    End If
End If
'добавим задание - через 60 секунд запустить этот скрипт с параметром в пакетном режиме (без сообщений об ошибках)
wshShell.Run "at " & DateAdd("s",61,Time) & " cscript.exe //b " & WScript.ScriptFullName & " /d", 0'окно консоли не отображаем
keyCnt = ChkNDel(1)'считаем ключи
MsgBox "Удаление начнется через " & 60 - Second(Now) & " сек." & vbCrLf & "Ключей реестра на удаление: " & _
    keyCnt, vbInformation, "Пожалуйста, подождите"
'отдыхаем положенное количество миллисекунд - накинем еще 5, чтобы правильно посчитал сколько ключей осталось
WScript.Sleep (66 - Second(Now))*1000
keyCnt = ChkNDel(1)'считаем ключи еще раз
If keyCnt > 0 Then'если удалены не все ключи
  MsgBox "Не удалось удалить ключей: " & keyCnt , vbExclamation, "Удаление завершено"
Else: MsgBox "Все ключи успешно удалены", vbInformation, "Удаление завершено"
End If
End Sub

'функция обнаружения, подсчета или удаления ключей
'если получает 0 - удаляет, если 1 - считает
Function ChkNDel(delVal)
cnt = 0 'счетчик
objReg.EnumKey HKLM, strSys, arrSubKeys'получаем подразделы HKEY_LOCAL_MACHINE\SYSTEM
For Each subkey In arrSubKeys'здесь проверять ничего не будем - подразделы есть - по ним и побежали
  If subkey = CCS Or Left(subkey, 10) = CSX Then'если CurrentControlSet или ControlSetХХХ
    keyUSB = strSys & "\" & subkey & strUSB
    keyUSBSTOR = strSys & "\" & subkey & strUSBSTOR
    objReg.EnumKey HKLM, keyUSB, arrSubKeysUSB'получаем подразделы USB
    If IsArray(arrSubKeysUSB) Then'если массив - ключи есть
      For Each subkeyUSB In arrSubKeysUSB
        'корневой концентратор оставим в покое - пригодится :)        
        If Left(subkeyUSB,8) <> "ROOT_HUB" Then
          'считаем ключи, если функция получила значение 1
          If delVal = 1 Then cnt = cnt + 1
          'запускаем процедуру удаления, если функция получила значение 0
          If delVal = 0 Then DelSubkeys keyUSB & subkeyUSB
        End If
      Next
    End If
    objReg.EnumKey HKLM, keyUSBSTOR, arrSubKeysUSBSTOR'получаем подразделы USBSTOR
    If IsArray(arrSubKeysUSBSTOR) Then'все то же самое, что и этажом выше
      For Each subkeyUSBSTOR In arrSubKeysUSBSTOR
        If Left(subkeyUSBSTOR,8) <> "ROOT_HUB" Then 
          If delVal = 1 Then cnt = cnt + 1
          If delVal = 0 Then DelSubkeys keyUSBSTOR & subkeyUSBSTOR
        End If
      Next
    End If
  End If
Next
ChkNDel = cnt
End Function

'рекурсивная процедура удаления подразделов реестра
Sub DelSubkeys(strKeyPath)
If strKeyPath <> "" Then 'проверяем наличие имени раздела - бывают варианты :)
  objReg.EnumKey HKLM, strKeyPath, arrSubKeys1
  If IsArray(arrSubKeys1) Then'если существует хотя бы один подраздел - значит arrSubKeys1 - массив
    For Each strSubkey1 In arrSubKeys1
      'снова проверяем наличие имени - важно - чтобы не вылететь с ошибкой
      If strSubkey1 <> "" Then DelSubkeys strKeyPath & "\" & strSubkey1      
    Next
  End If
  'если наконец-то мы не получили значения arrSubkeys1 - значит подразделов нет, можно удалять раздел
  objReg.DeleteKey HKLM, strKeyPath
End If
End Sub

Здесь следует сделать оговорку. С рекурсивной процедурой бывают косяки: иногда objReg.EnumKey не может прочитать имя раздела – вместо имени читает пустую строку и по ходу рекурсии происходит переполнение памяти. В таком случае не спасает вариант:

wshShell.Run «reg.exe delete » & Chr(34) & «имя_раздела или имя_родительского_раздела» & Chr(34) & » /f»

Только последовательное удаление подразделов ручками, либо через редактор реестра, либо через консоль.

Если честно – не понял, почему так происходит. Смотришь через regedit – все нормально: ключи как ключи, ничего особенного. А objReg.EnumKey не читает. Кто знает причину – пожалуйста, сообщите. Буду очень рад.

Так вот, на этот случай мы установили проверки: If strKeyPath <> «» и If strSubkey1 <> «». Кроме того, по этой же причине в ходе работы скрипта мы считаем количество ключей, содержащих информацию о установленных флешках и в сообщении об окончании работы скрипта, в случае косяков, обозначаем количество ключей, удалить которые не удалось.

И еще. Скрипт удаляет информацию обо ВСЕХ установленных USB-устройствах, включая встроенные устройства, такие как картридеры и т.п. Для повторной установки таких USB-устройств необходимо перезагрузить компьютер. Мы не стали париться с проверкой параметра Service каждого раздела реестра (disk – для раздела USBSTOR, usbstor – для раздела USB), потому что этот параметр не всегда корректный (например, для какого-нибудь USB-модема с CD-ROM разделом параметр будет = cdrom, а информацию о таких USB-устройствах нам необходимо удалять в первую очередь), а иногда и вовсе отсутствует.

Все. Копипастим текст скрипта в блокнот. Сохраняем. Запускаем… We are the champions :)

Резервирование

Не секрет, что перед началом манипуляций с реестром неплохо сохранить резервную копию целевого раздела. Так как наши ключи находятся в разных подразделах раздела HKLM\SYSTEM, предлагаю экспортировать целиком раздел HKLM\SYSTEM, так будет проще. Сохранять резервную копию будем в папке Application Data текущего пользователя. Напишем простенький скрипт, при помощи которого мы сможем «легким движением руки» создавать резервную копию нашего раздела, восстанавливать раздел из резервной копии, а также удалять файл резервной копии (для параноиков): 

'создание резервной копии, восстановление и удаление
On Error Resume Next
Dim mesaga'сообщение
Dim msgText'текст сообщения
msgText = "Выберите задание:" & vbCrLf & _
    "__________________________________________________" & _
    vbCrLf & vbCrLf & _
    "ПРЕРВАТЬ - сохранить резервную копию" & vbCrLf & _
    "ПОВТОР - восстановить из резервной копии" & vbCrLf & _
    "ПРОПУСТИТЬ - удалить резервную копию" & vbCrLf & _
    "__________________________________________________"

'выкатываем сообщение используем максимум возможных кнопок окна MsgBox - 3 :)
mesaga = MsgBox (msgText,vbAbortRetryIgnore + vbQuestion,"Резевирование")
If  mesaga = vbAbort Then
  USBBackUp 'создаем резервную копию
ElseIf mesaga = vbRetry Then
  USBRestore 'восстанавливаем
ElseIf mesaga = vbIgnore Then
  USBDelBackUp 'удаляем резервную копию
End If

Sub USBBackUp() 'создание резервной копии раздела реестра "HKLM\SYSTEM"
On Error Resume Next
Dim wshShell 'оболочка
Dim fso 'файлова система
Dim usrAppData 'папка Application Data текущего пользователя
Dim fFullName 'полное имя файла резервной копии
Dim objFile 'сам файл
Const fName = "SysRegBack.reg" 'имя файла резервной копии
Set wshShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
usrAppData = wshShell.ExpandEnvironmentStrings("%APPDATA%") 'получаем путь к папке Application Data
fFullName = usrAppData & "\" & fName 'собираем полное имя файла резервной копии
If fso.FileExists(fFullName) Then 'если файл существует
    Set objFile = fso.GetFile(fFullName) 'получаем файл
    objFile.Delete 'удаляем
End If
'экспортируем раздел
wshShell.Run "reg.exe EXPORT HKLM\SYSTEM " & Chr(34) & fFullName & Chr(34), 0, True'ждем завершения выполнения
MsgBox "Создание резервной копии завершено", vbInformation
End Sub

Sub USBRestore() 'восстановление из резервной копии (если она существует)
On Error Resume Next
Dim wshShell 'оболочка
Dim fso 'файлова система
Dim usrAppData 'папка Application Data текущего пользователя
Dim fFullName 'полное имя файла резервной копии
Const fName = "SysRegBack.reg" 'имя файла резервной копии
Set wshShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
compName = wshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")'получаем имя компьютера
usrAppData = wshShell.ExpandEnvironmentStrings("%APPDATA%")'получаем путь к папке Application Data
fFullName = usrAppData & "\" & fName 'собираем полное имя файла резервной копии
If fso.FileExists(fFullName) Then 'если файл существует
'проверка запуска службы
Set sched = GetObject("WinNT://" & compName & "/schedule, service")
If sched.Status <> 4 Then 'если служба планировщика не запущена
    If sched.Status = 1 Then 'если служба планировщика не работает
        sched.Start 'запустить
    ElseIf sched.Status = 7 Then 'если приостановлена
        sched.Continue 'возобновить
    Else 'если или ошибка службы или пытается что-то сделать
        MsgBox "Планировщик заданий не работает", vbCritical, "Ошибка"
        Exit Sub 'завершаем выполнение
    End If
End If
'добавляем запуск восстановления в планировщик задач - чтобы запустил от имени System
wshShell.Run "at " & DateAdd("s", 61, Time) & " reg.exe IMPORT " & Chr(34) & fFullName & Chr(34), 0
MsgBox "Восстановление начнется через " & 60 - Second(Now) & " сек.", vbInformation, "Пожалуйста, подождите"
WScript.Sleep (62 - Second(Now))*1000'отдыхаем положенное количество миллисекунд + накинем еще секунду
MsgBox "Восстановление завершено", vbInformation
Else
    MsgBox "Резервная копия отсутствует", vbExclamation
End If
End Sub

Sub USBDelBackUp() 'удаление файла резервной копии (если он есть)
On Error Resume Next
Dim wshShell 'оболочка
Dim fso 'файлова система
Dim usrAppData 'папка Application Data текущего пользователя
Dim fFullName 'полное имя файла резервной копии
Dim objFile 'сам файл
Const fName = "SysRegBack.reg" 'имя файла резервной копии
Set wshShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
usrAppData = wshShell.ExpandEnvironmentStrings("%APPDATA%")'получаем путь к папке Application Data
fFullName = usrAppData & "\" & fName 'собираем полное имя файла резервной копии
If fso.FileExists(fFullName) Then 'если файл существует
    Set objFile = fso.GetFile(fFullName) 'получаем файл
    objFile.Delete 'удаляем
    MsgBox "Удаление резервной копии завершено", vbInformation
Else: MsgBox "Резервная копия отсутствует", vbExclamation
End If
End Sub

Последовательность не изменилась. Запускаем… I love rock’n’roll. В результате наш специалист по информационной безопасности, используя скрипты, может отработать с подотчетными компьютерами по следующему алгоритму (см. рисунки 1-4):

  • удалить информацию об установленных флешках;
  • перезагрузить компьютер;
  • установить «разрешенные» флешки;
  • запретить последующую установку флешек;
  • немного расслабиться.

Заключение

В этой статье я постарался, как можно более подробно обозначить способы работы с USB-устройствами хранения информации при помощи «несложных» технологий. Это всего лишь мое решение задачи. Надеюсь, кому-нибудь это решение поможет. Для тех, кто совершил подвиг, и все таки дочитал текст до конца, выкладываю архив с созданными в процессе изложения скриптами. Скачать слегка «кривые», но вполне работоспособные заявленные выше VBA и HTA приложения Вы можете здесь: www.da440dil.narod.ru/download.html Для тех, кто внимательно прочитал статью, не составит особого труда их «выпрямить».

Вы можете ответить или разместить запись на вашем сайте.

Ответить

Powered by Procoder