VB 查找U盘是否插入

清疚 2022-09-28 14:29 148阅读 0赞

Option Explicit  
‘子类化窗体消息处理函数时需要使用的API，很常见，不作过多说明。  
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd   
As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long  
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal   
lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As   
Long, ByVal lParam As Long) As Long  
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc   
As Any, ByVal ByteLen As Long)  
Const GWL\_WNDPROC = -4  
Const WM\_DEVICECHANGE As Long = &H219  
Const DBT\_DEVICEARRIVAL As Long = &H8000&  
Const DBT\_DEVICEREMOVECOMPLETE As Long = &H8004&  
'设备类型：逻辑卷标  
Const DBT\_DEVTYP\_VOLUME As Long = &H2  
'与WM\_DEVICECHANGE消息相关联的结构体头部信息  
Private Type DEV\_BROADCAST\_HDR  
lSize As Long  
lDevicetype As Long '设备类型  
lReserved As Long  
End Type  
'设备为逻辑卷时对应的结构体信息  
Private Type DEV\_BROADCAST\_VOLUME  
lSize As Long  
lDevicetype As Long  
lReserved As Long  
lUnitMask As Long '和逻辑卷标对应的掩码  
iFlag As Integer    
End Type  
Public info As DEV\_BROADCAST\_HDR  
Public info\_volume As DEV\_BROADCAST\_VOLUME  
Public PrevProc As Long ‘原来的窗体消息处理函数地址  
Public Sub HookForm(F As Form)  
  PrevProc = SetWindowLong(F.hwnd, GWL\_WNDPROC, AddressOf WindowProc)  
End Sub  
Public Sub UnHookForm(F As Form)  
  SetWindowLong F.hwnd, GWL\_WNDPROC, PrevProc  
End Sub  
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam   
As Long, ByVal lParam As Long) As Long  
  Select Case uMsg  
  '插入USB DISK 则接收到此消息  
  Case WM\_DEVICECHANGE  
  If wParam = DBT\_DEVICEARRIVAL Then  
     
  '若插入USBDISK或者映射网络盘等则  
  'info.lDevicetype =2  
  '即DBT\_DEVTYP\_VOLUME  
     
  ‘利用参数lParam获取结构体头部信息  
  CopyMemory info, ByVal lParam, Len(info)  
     
  If info.lDevicetype = DBT\_DEVTYP\_VOLUME Then  
     
  CopyMemory info\_volume, ByVal lParam, Len(info\_volume)  
     
  '检测到有逻辑卷添加到系统中，则显示该设备根目录下全部文件名  
  ListFiles Chr(GetDriveName(info\_volume.lUnitMask)) & ":/",   
Form1.List1  
  End If  
  End If  
     
  If wParam = DBT\_DEVICEREMOVECOMPLETE Then  
     
  '若移走USBDISK或者映射网络盘等则  
  'info.lDevicetype =2  
  '即DBT\_DEVTYP\_VOLUME  
     
  ‘利用参数lParam获取结构体头部信息  
  CopyMemory info, ByVal lParam, Len(info)  
     
  If info.lDevicetype = DBT\_DEVTYP\_VOLUME Then  
  CopyMemory info\_volume, ByVal lParam, Len(info\_volume)  
     
  '清除LIST中的内容  
  Form1.List1.Clear  
  End If  
  End If    
     
  End Select  
  ' 调用原来的窗体消息处理函数  
  WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)  
     
End Function  
'根据输入的32位LONG型数据（只有一位为1）返回对应的卷标的ASCII数值  
'规则是1：A、2：B、4：C等等  
Function GetDriveName(ByVal lUnitMask As Long) As Byte  
Dim i As Long  
i = 0  
While lUnitMask Mod 2 <> 1  
  lUnitMask = lUnitMask / 2  
  i = i + 1  
Wend  
GetDriveName = Asc("A") + i  
End Function  
'显示插入逻辑卷根目录的文件名列表，需要在工程里引用Microsoft Scripting Runtime库。  
Function ListFiles(strPath As String, ByRef list As ListBox)  
  Dim fso As New Scripting.FileSystemObject  
  Dim objFolder As Folder  
  Dim objFile As File  
    
  Set objFolder = fso.GetFolder(strPath)  
    
  For Each objFile In objFolder.Files  
  list.AddItem objFile.Name  
  Next  
End Function  
窗体Form1代码：  
Option Explicit  
Private Sub Form\_Load()  
'子类化窗体的消息处理函数  
HookForm Me  
End Sub  
Private Sub Form\_Unload(Cancel As Integer)  
'程序退出时恢复原窗体处理函数  
UnHookForm Me  
End Sub  
效果图：  
  
备注：本示例程序不仅仅能检测U盘的插入，对CDROM、网络映射盘等设备也会作出同样的反应，如果需要只检测U盘，则需要在If info.lDevicetype =   
DBT\_DEVTYP\_VOLUME   
处再对iFlag结构成员作检测，其数值为0时表示设备为U盘。另外根据微软的解释，软盘的插拔是不会有引发该消息的，原因是只有支持软弹出技术的设备才会引发该消息。（原文：Messages   
for media arrival and removal are sent only for media in devices that support a   
soft-eject mechanism. ）  
本演示程序在WINDOWS98、XP系统下调试通过。