VB 判断USB是否正在使用

       '标准模块代码:

       Option Explicit

       '-------------------------------声明部分------------------------------

       Private Type Guid

           Data1 As Long

           Data2 As Integer

           Data3 As Integer

           Data4(7) As Byte

       End Type

       Private Type DEV_BROADCAST_DEVICEINTERFACE

           dbcc_size As Long

           dbcc_devicetype As Long

           dbcc_reserved As Long

           dbcc_classguid As Guid

           dbcc_name As Long

       End Type

       Private Type DEV_BROADCAST_VOLUME

           dbcv_size As Long

           dbcv_devicetype As Long

           dbcv_reserved As Long

           dbcv_unitmask As Long

           dbcv_flags As Integer

       End Type

       Private Const GWL_WNDPROC = -4

       Private Const DEVICE_NOTIFY_WINDOW_HANDLE = 0

       Private Const WM_DEVICECHANGE = &H&

       Private Const DBT_DEVTYP_DEVICEINTERFACE = &H5&

       Private Const DBT_DEVTYP_VOLUME = &H2&

       Private Const DBT_DEVICEARRIVAL = &H&

       Private Const DBT_DEVICEREMOVECOMPLETE = &H&

       Private Const DBTF_MEDIA = &H1&

       Private Const DRIVE_REMOVABLE = 2

       Private Declare Function SetWindowLong Lib "User.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

       Private Declare Function CallWindowProc Lib "User.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

       Private Declare Function RegisterDeviceNotification Lib "User.dll" Alias "RegisterDeviceNotificationA" (ByVal hRecipient As Long, NotificationFilter As Any, ByVal Flags As Long) As Long

       Private Declare Function UnregisterDeviceNotification Lib "User.dll" (ByVal Handle As Long) As Long

       Private Declare Sub CopyMemory Lib "kernel" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

       Private Declare Function GetDriveType Lib "kernel" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

       '-------------------------------实现部分------------------------------

       Private m_hwnd As Long, m_lpPrevWndProc As Long

       Private m_hDevNotify As Long

       '------------------------向系统请求接收USB通知------------------------

       Public Sub RegDevNotify(ByVal hwnd As Long)

           Dim dbcc As DEV_BROADCAST_DEVICEINTERFACE

           If m_lpPrevWndProc = 0 Then

               m_hwnd = hwnd

               m_lpPrevWndProc = SetWindowLong(m_hwnd, GWL_WNDPROC, AddressOf WndProc)

               dbcc.dbcc_size = Len(dbcc)

               dbcc.dbcc_devicetype = DBT_DEVTYP_DEVICEINTERFACE

       '----------------------向系统注册，允许接收设备通知-----------------------

               m_hDevNotify = RegisterDeviceNotification(hwnd,c opc client 源码 dbcc, DEVICE_NOTIFY_WINDOW_HANDLE)

           End If

       End Sub

       Public Sub UnregDevNotify()

           If m_lpPrevWndProc Then

       '-----------------------取消系统注册，不再接收设备通知-------------------

               UnregisterDeviceNotification m_hDevNotify

               SetWindowLong m_hwnd,小程序外包源码 GWL_WNDPROC, m_lpPrevWndProc

               m_lpPrevWndProc = 0

           End If

       End Sub

       Private Function WndProc(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

           If msg = WM_DEVICECHANGE Then

       　　'---------------当设备变动是，判断是源码要编译嘛插入还是移出---------------

               If wParam = DBT_DEVICEARRIVAL Or wParam = DBT_DEVICEREMOVECOMPLETE Then

                   Call GetDevInfo(wParam = DBT_DEVICEARRIVAL, lParam)

               End If

           End If

           WndProc = CallWindowProc(m_lpPrevWndProc, m_hwnd, msg, wParam, lParam)

       End Function

       Private Sub GetDevInfo(ByVal bArrival As Boolean, ByVal lParam As Long)

           Dim dbcv As DEV_BROADCAST_VOLUME, sDrv As String

           CopyMemory dbcv, ByVal lParam, Len(dbcv)

       '----------判断设备是否是磁盘---------- 

           If dbcv.dbcv_devicetype = DBT_DEVTYP_VOLUME And dbcv.dbcv_flags = DBTF_MEDIA Then

       　　'----------判断是否是U盘，并输出信息------------

               sDrv = GetDrvFromBit(dbcv.dbcv_unitmask)

               If GetDriveType(sDrv & ":") = DRIVE_REMOVABLE The易推创意源码n

                   MsgBox "可移动磁盘" & sDrv & IIf(bArrival, "插入", "拨出")

               End If

           End If

       End Sub

       Private Function GetDrvFromBit(ByVal nBits As Long) As String

           Dim i As Long

           For i = 0 To 

               If nBits And (2 ^ i) Then

                   GetDrvFromBit = Chr(vbKeyA + i)

                   Exit Function

               End If

           Next

       End Function

       '窗体模块代码:

       Option Explicit

       '-------------------------------调用示例------------------------------

       Private Sub Form_Load()

           RegDevNotify Me.hwnd

       End Sub

       Private Sub Form_Unload(Cancel As Integer)

           UnregDevNotify

       End Sub