vb检测是否插入优盘
如题，vb中怎么样才能检测是否插入u盘呢？然后在后台对u盘就行一些简单的操作。
绝对正当用途~~~~
[解决办法]
插入 拔除 都有系统消息吧 在论坛里搜下 有相关例子
检测U盘http://www.vbgood.com/viewthread.php?tid=51306&highlight=%2B
[解决办法]
偵測U盤拔出與插入
'Form Code
Sub Form_Load()
RegDevNotify Me.hwnd
End Sub
Sub Form_Unload(Cancel As Integer)
UnregDevNotify
End Sub
'Module Code
Type Guid
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
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
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
Const GWL_WNDPROC = -4
Const DEVICE_NOTIFY_WINDOW_HANDLE = 0
Const WM_DEVICECHANGE = &H219&
Const DBT_DEVTYP_DEVICEINTERFACE = &H5&
Const DBT_DEVTYP_VOLUME = &H2&
Const DBT_DEVICEARRIVAL = &H8000&
Const DBT_DEVICEREMOVECOMPLETE = &H8004&
Const DRIVE_REMOVABLE = 2
Const DRIVE_NO_ROOT_DIR = 1
Declare Function SetWindowLongA Lib "User32.dll " (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function CallWindowProcA Lib "User32.dll " (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function RegisterDeviceNotificationA Lib "User32.dll " (ByVal hRecipient As Long, NotificationFilter As Any, ByVal Flags As Long) As Long
Declare Function UnregisterDeviceNotification Lib "User32.dll " (ByVal Handle As Long) As Long
Declare Sub RtlMoveMemory Lib "kernel32 " (Destination As Any, Source As Any, ByVal Length As Long)
Declare Function GetDriveTypeA Lib "kernel32 " (ByVal nDrive As String) As Long
Private m_hwnd As Long
Private m_lpPrevWndProc As Long
Private m_hDevNotify As Long
Public Sub RegDevNotify(ByVal hwnd As Long)
Dim dbcc As DEV_BROADCAST_DEVICEINTERFACE
If m_lpPrevWndProc = 0 Then
m_hwnd = hwnd
m_lpPrevWndProc = SetWindowLongA(m_hwnd, GWL_WNDPROC, AddressOf WndProc)
dbcc.dbcc_size = Len(dbcc)
dbcc.dbcc_devicetype = DBT_DEVTYP_DEVICEINTERFACE
m_hDevNotify = RegisterDeviceNotificationA(hwnd, dbcc, DEVICE_NOTIFY_WINDOW_HANDLE)
End If
End Sub
Public Sub UnregDevNotify()
If m_lpPrevWndProc Then
UnregisterDeviceNotification m_hDevNotify
SetWindowLongA 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 = CallWindowProcA(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
RtlMoveMemory dbcv, ByVal lParam, Len(dbcv)
If dbcv.dbcv_devicetype = DBT_DEVTYP_VOLUME Then
sDrv = GetDrvFromBit(dbcv.dbcv_unitmask)
If bArrival = True And GetDriveTypeA(sDrv & ":\ ") = DRIVE_REMOVABLE Then
MsgBox "可移動磁盤 " & sDrv & "被插入. ", vbInformation
ElseIf bArrival = False And GetDriveTypeA(sDrv & ":\ ") = DRIVE_NO_ROOT_DIR Then '因為撥出后,盤符會被刪除
MsgBox "可移動磁盤 " & sDrv & "被撥出. ", vbInformation
End If
End If
End Sub
Private Function GetDrvFromBit(ByVal nBits As Long) As String
Dim i As Long
For i = 0 To 25
If nBits And (2 ^ i) Then
GetDrvFromBit = Chr(vbKeyA + i)
Exit Function
End If
Next
End Function
[解决办法]
我这里有个源程序,LZ如果需要我可以发给你!
