Проверить, вставлен ли флеш-накопитель

Imports System.IO 
Imports System.Runtime.InteropServices 
Imports System.Threading 
 
Public Class Form_DetectRemovableDrive 
 
    ' отлавливание событий монтирования/размонтирования флешки, составления списка флешек 
 
    Const WM_DEVICECHANGE = &H219 
 
    Private Enum DeviceEvents 
        ConfigChangeCanceled = &H19 'A request to change the current configuration (dock or undock) has been canceled. 
        ConfigChanged = &H18 'The current configuration has changed, due to a dock or undock. 
        CustomEevent = &H8006 'A custom event has occurred. 
        DeviceArrival = &H8000 'A device or piece of media has been inserted and is now available. 
        DeviceQueryRemove = &H8001 'Permission is requested to remove a device or piece of media. Any application can deny this request and cancel the removal. 
        DeviceQueryRemoveFailed = &H8002 'A request to remove a device or piece of media has been canceled. 
        DeviceRemoveComplete = &H8004 'A device or piece of media has been removed. 
        DeviceRemovePending = &H8003 'A device or piece of media is about to be removed. Cannot be denied. 
        DeviceTypeSpecific = &H8005 'A device-specific event has occurred. 
        DeviceNodesChanged = &H7 'A device has been added to or removed from the system. 
        QueryChangeConfig = &H17 'Permission is requested to change the current configuration (dock or undock). 
        UserDefined = &HFFFF 
    End Enum 
 
    Private Enum DeviceTypes As UInteger 
        DeviceInterface = &H5 'Class of devices. This structure is a DEV_BROADCAST_DEVICEINTERFACE structure. 
        Handle = &H6 'File system handle. This structure is a DEV_BROADCAST_HANDLE structure. 
        OEM = &H0 'OEM- or IHV-defined device type. This structure is a DEV_BROADCAST_OEM structure. 
        Port = &H3 'Port device (serial or parallel). This structure is a DEV_BROADCAST_PORT structure. 
        Volume = &H2 'Logical volume. This structure is a DEV_BROADCAST_VOLUME structure. 
    End Enum 
 
    Private Enum DeviceFlags As UShort 
        Media = &H1 'Change affects media in drive. If not set, change affects physical device or drive. 
        Net = &H2 'Indicated logical volume is a network volume. 
    End Enum 
 
    Private Structure DeviceBroadcastHeader 
        Public Size As UInteger 
        Public DeviceType As DeviceTypes 
        Public Reserved As UInteger 
    End Structure 
 
    Private Structure DeviceBroadcastVolume 
        Public Size As UInteger 
        Public DeviceType As DeviceTypes 
        Public Reserved As UInteger 
        Public UnitMask As UInteger 
        Public Flags As DeviceFlags 
    End Structure 
 
    Private Function GetDriveLetter(ByVal UnitMask As UInteger) As Char 
        If UnitMask > 0 Then 
            Dim i As Integer = 0 
            Do While (i < 26) And ((UnitMask And 1) = 0) 
                UnitMask >>= 1 
                i += 1 
            Loop 
            GetDriveLetter = Chr(Asc("A") + i) 
        Else 
            GetDriveLetter = vbNullChar 
        End If 
    End Function 
 
    Protected Overrides Sub WndProc(ByRef m As Message) 
        Select Case m.Msg 
            Case WM_DEVICECHANGE : RaiseEvent OnDeviceChange(m) 
        End Select 
        MyBase.WndProc(m) 
    End Sub 
 
    Public Event OnDeviceChange(ByRef m As Message) 
 
    Private Sub Form_OnDeviceChange(ByRef m As Message) Handles Me.OnDeviceChange 
        Dim h As DeviceBroadcastHeader = m.GetLParam(GetType(DeviceBroadcastHeader)) 
        Select Case m.WParam 
            Case DeviceEvents.DeviceArrival 
                GetFlashes() 
            Case DeviceEvents.DeviceRemoveComplete 
                GetFlashes() 
        End Select 
    End Sub 
 
    Private Function GetDriveSize(ByVal butes As Object) As String 
        Dim retstr As String = "" 
        Dim ln As Long = butes.ToString.Length 
        If ln > 0 Then 
            Dim bsize As Long = CLng(butes) 
            If bsize < 1025 Then ' до килобайта 
                retstr = CStr(butes) & " Б" 
            End If 
            If bsize > 1024 And bsize < 1048577 Then ' до мегабайта 
                retstr = CStr(Math.Round(butes / 1024, 2)) & " КБ" 
            End If 
            If bsize > 1048576 And bsize < 1073741825 Then ' до гигабайта 
                retstr = CStr(Math.Round(butes / 1048576, 2)) & " МБ" 
            End If 
            If bsize > 1073741824 Then 'свыше гигабайта 
                retstr = CStr(Math.Round(butes / 1073741824, 2)) & " ГБ" 
            End If 
        Else 
            retstr = "" 
        End If 
        Return retstr 
    End Function 
 
    Private Sub GetFlashes() 
        Me.ListBox1.Items.Clear() 
        Dim DRV As IO.DriveInfo 
        Dim DRVCount As Integer = My.Computer.FileSystem.Drives.Count 
        For i = 0 To DRVCount - 1 
            DRV = My.Computer.FileSystem.Drives.Item(i) 
            If (DRV.IsReady = True) And (DRV.DriveType = IO.DriveType.Removable) Then 
                Me.ListBox1.Items.Add(DRV.Name & ", " & DRV.VolumeLabel & ", " & Me.GetDriveSize(DRV.TotalSize)) 
            End If 
        Next 
    End Sub 
 
    Private Sub Form_DetectRemovableDrive_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load 
        Me.Text = My.Application.Info.AssemblyName 
        GetFlashes() 
    End Sub 
 
    Private Sub btnEject_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnEject.Click 
        If Me.ListBox1.SelectedItems.Count = 0 Then 
            MsgBox("Выберите устройство в списке") 
            Exit Sub 
        End If 
        Dim drvname As String = Me.ListBox1.SelectedItem.ToString.Substring(0, 3) 
        Select Case DeviceEject(drvname) 
            Case Is = True 
                MsgBox("Устройство может быть извлечено") 
            Case Is = False 
                MsgBox("Устройство используется и не может быть извлечено") 
        End Select 
    End Sub 
 
    ' тут начинается таинство извлечения 
 
    Private Const LOCK_TIMEOUT As Integer = 10000       ' 10 секунд приостановки процесса 
    Private Const LOCK_RETRIES As Integer = 20 
    Private Const GENERIC_READ As Integer = &H80000000 
    Private Const GENERIC_WRITE As Integer = &H40000000 
    Private Const OPEN_EXISTING As Integer = 3 
    Private Const FILE_SHARE_READ As Integer = 1 
    Private Const FILE_SHARE_WRITE As Integer = 2 
    Private Const INVALID_HANDLE_VALUE As Integer = -1 
    Private Const FSCTL_LOCK_VOLUME As Integer = &H90018 
    Private Const FSCTL_DISMOUNT_VOLUME As Integer = &H90020 
    Private Const IOCTL_STORAGE_MEDIA_REMOVAL As Integer = &H2D4804 
    Private Const IOCTL_STORAGE_EJECT_MEDIA As Integer = &H2D4808 
    Private Const IOCTL_STORAGE_LOAD_MEDIA As Integer = &H2D480C 
 
    Private Structure PREVENT_MEDIA_REMOVAL 
        Dim PreventMediaRemoval As Boolean 
    End Structure 
 
    Private Declare Auto Function DeviceIoControl Lib "kernel32" (ByVal hDevice As IntPtr, ByVal dwIoControlCode As Integer, ByVal lpInBuffer As IntPtr, ByVal nInBufferSize As Integer, ByVal lpOutBuffer As IntPtr, ByVal nOutBufferSize As Integer, ByRef lpBytesReturned As Integer, ByVal lpOverlapped As IntPtr) As Boolean 
    Private Declare Unicode Function CreateFile Lib "kernel32" Alias "CreateFileW" (ByVal lpFileName As String, ByVal dwDesiredAccess As Integer, ByVal dwShareMode As Integer, ByVal lpSecurityAttributes As IntPtr, ByVal dwCreationDisposition As Integer, ByVal dwFlagsAndAttributes As Integer, ByVal hTemplateFile As IntPtr) As IntPtr 
    Declare Function CloseHandle Lib "kernel32" (ByVal hObject As IntPtr) As Boolean 
 
    Private Function OpenVolume(ByVal drive As DriveInfo) As IntPtr 
        Dim hVolume As IntPtr 
        Dim driveLetter As String = CChar(drive.Name) ' this will take only the first character 
        Dim dwAccessFlags As Integer 
        Select Case drive.DriveType 
            Case DriveType.Removable 
                dwAccessFlags = GENERIC_READ Or GENERIC_WRITE 
            Case DriveType.CDRom 
                dwAccessFlags = GENERIC_READ 
            Case Else 
                Throw New ArgumentException(String.Format("Cannot eject--'{0}' is not a removable drive.", drive.Name)) 
        End Select 
 
        hVolume = CreateFile(String.Format("\\.\{0}:", driveLetter), dwAccessFlags, FILE_SHARE_READ Or FILE_SHARE_WRITE, Nothing, OPEN_EXISTING, 0, Nothing) 
        If hVolume = INVALID_HANDLE_VALUE Then 
            Throw New IOException("Unable to open volume") 
        End If 
        Return hVolume 
    End Function 
 
    Private Function LockVolume(ByVal hVolume As IntPtr) As Boolean 
        Dim dwBytesReturned As UInteger 
        Dim dwSleepAmount As UInteger 
        dwSleepAmount = LOCK_TIMEOUT / LOCK_RETRIES 
        For nTryCount As Integer = 1 To LOCK_RETRIES 
            If (DeviceIoControl(hVolume, FSCTL_LOCK_VOLUME, Nothing, 0, Nothing, 0, dwBytesReturned, Nothing)) Then 
                Return True 
            End If 
            ' Thread.Sleep(dwSleepAmount) 
        Next 
        Return False 
    End Function 
 
    Private Function DismountVolume(ByVal hVolume As IntPtr) As Boolean 
        Dim dwBytesReturned As UInteger 
        Return DeviceIoControl(hVolume, FSCTL_DISMOUNT_VOLUME, Nothing, 0, Nothing, 0, dwBytesReturned, Nothing) 
    End Function 
 
    Private Function PreventRemovalOfVolume(ByVal hVolume As IntPtr, ByVal fPreventRemoval As Boolean) As Boolean 
        Dim dwBytesReturned As UInteger 
        Dim PMR As PREVENT_MEDIA_REMOVAL 
        Dim bufferSize As Integer = Marshal.SizeOf(GetType(PREVENT_MEDIA_REMOVAL)) 
        Dim succeeded As Boolean = False 
        Dim lpInBuffer As IntPtr = IntPtr.Zero 
        Try 
            lpInBuffer = Marshal.AllocCoTaskMem(bufferSize) 
            PMR.PreventMediaRemoval = fPreventRemoval 
            Marshal.StructureToPtr(PMR, lpInBuffer, False) 
            succeeded = DeviceIoControl(hVolume, IOCTL_STORAGE_MEDIA_REMOVAL, lpInBuffer, bufferSize, Nothing, 0, dwBytesReturned, Nothing) 
        Finally 
            If lpInBuffer <> IntPtr.Zero Then 
                Marshal.FreeCoTaskMem(lpInBuffer) 
            End If 
        End Try 
        Return succeeded 
    End Function 
 
    Private Function EjectMedia(ByVal hVolume As IntPtr) As Boolean 
        Dim dwBytesReturned As UInteger 
        Return DeviceIoControl(hVolume, IOCTL_STORAGE_EJECT_MEDIA, Nothing, 0, Nothing, 0, dwBytesReturned, Nothing) 
    End Function 
 
    Private Function LoadMedia(ByVal hVolume As IntPtr) As Boolean 
        Dim dwBytesReturned As UInteger 
        Return DeviceIoControl(hVolume, IOCTL_STORAGE_LOAD_MEDIA, Nothing, 0, Nothing, 0, dwBytesReturned, Nothing) 
    End Function 
 
    Public Function DeviceEject(ByVal driveName As String) As Boolean ' можно также открыть лоток оптического привода 
        Dim drive As New DriveInfo(driveName) 
        Dim hVolume As IntPtr 
        Dim dismountSucceeded As Boolean = False 
        Dim ejectSucceeded As Boolean = False 
        ' Open the volume. 
        hVolume = OpenVolume(drive) 
        ' Lock and dismount the volume. 
        If (LockVolume(hVolume) AndAlso DismountVolume(hVolume)) Then 
            ' Set prevent removal to false and eject the media. 
            If (PreventRemovalOfVolume(hVolume, False) AndAlso EjectMedia(hVolume)) Then 
                ejectSucceeded = True 
            End If 
        End If 
        ' Close the volume so other processes can use the drive. 
        If Not CloseHandle(hVolume) Then 
            ejectSucceeded = False 
        End If 
        Return ejectSucceeded 
    End Function 
 
    Public Function DeviceLoad(ByVal driveName As String) As Boolean ' можно также закрыть лоток оптического привода 
        Dim drive As New DriveInfo(driveName) 
        Dim hVolume As IntPtr 
        Dim loadSucceeded As Boolean = False 
        ' Open the volume. 
        hVolume = OpenVolume(drive) 
        ' Load the media. 
        If LoadMedia(hVolume) Then 
            loadSucceeded = True 
        End If 
        ' Close the volume so other processes can use the drive. 
        If Not CloseHandle(hVolume) Then 
            loadSucceeded = False 
        End If 
        Return loadSucceeded 
    End Function 
 
End Class