插上移动盘时程序得到移动盘的盘符？

Question

当我插上移动盘时程序能得到消息，并得到移动盘的盘符。
问用hook和api函数怎么实现，主要得到msg、wparam、lparam后怎么处理并得到移动盘的盘符？
谢谢

Answer 1

Option Explicit
  Private Const DRIVE_UNKNOWN = 0
Private Const DRIVE_ABSENT = 1
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias _
    "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _
    ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
    (ByVal nDrive As String) As Long
    
Private Function GetAllDrives() As String
'Returns all mapped drives
    Dim lngRet As Long
    Dim strDrives As String * 255
    Dim lngTmp As Long
    lngTmp = Len(strDrives)
    lngRet = GetLogicalDriveStrings(lngTmp, strDrives)
    GetAllDrives = Left$(strDrives, lngRet)
End FunctionPrivate Function GetSpecialDriveType(strDriveName As String) As String
    Dim lngRet As Long
    Dim strDrive As String
    lngRet = GetDriveType(strDriveName)
    Select Case lngRet
        Case DRIVE_UNKNOWN 'The drive type cannot be determined.
            strDrive = "Unknown Drive Type"
        Case DRIVE_ABSENT 'The root directory does not exist.
            strDrive = "Drive does not exist"
        Case DRIVE_REMOVABLE 'The drive can be removed from the drive.
            strDrive = "Removable Media"
        Case DRIVE_FIXED 'The disk cannot be removed from the drive.
            strDrive = "Fixed Drive"
        Case DRIVE_REMOTE  'The drive is a remote (network) drive.
            strDrive = "Network Drive"
        Case DRIVE_CDROM 'The drive is a CD-ROM drive.
            strDrive = "CD Rom"
        Case DRIVE_RAMDISK 'The drive is a RAM disk.
            strDrive = "Ram Disk"
    End Select
    GetSpecialDriveType = strDrive
End FunctionPrivate Function GetRemovableDrive() As String
    Dim strAllDrives As String
    Dim strTmp As String
    Dim strDrive As String
    
    strAllDrives = GetAllDrives
    If strAllDrives <> "" Then
        Do
            strTmp = Mid$(strAllDrives, 1, InStr(strAllDrives, vbNullChar) - 1)
            strAllDrives = Mid$(strAllDrives, InStr(strAllDrives, vbNullChar) + 1)
            Select Case GetSpecialDriveType(strTmp)
                Case "Removable Media":
                    Debug.Print "Removable drive : " & strTmp
                    strDrive = strDrive & " | " & strTmp
                Case "CD Rom":
                    Debug.Print " CD Rom drive : " & strTmp
                Case "Fixed Drive":
                    Debug.Print " Local drive : " & strTmp
                Case "Network Drive":
                    Debug.Print " Network drive : " & strTmp
            End Select
        Loop While strAllDrives <> ""
    End If
    If Len(strDrive) > 0 Then
        GetRemovableDrive = Right$(strDrive, Len(strDrive) - 3)
    End If
End FunctionPrivate Sub Form_Load()
    Dim strRemovableDrive As String
        
    strRemovableDrive = GetRemovableDrive
    If Len(strRemovableDrive) > 0 Then
        MsgBox "All removable drives: " & strRemovableDrive
    Else
        MsgBox "None removable drive found!"
    End If
End Sub

Answer 2

你可以试试SysInfo控件的事件
Private Sub SysInfo1_DeviceArrival(ByVal DeviceType As Long, ByVal DeviceID As Long, ByVal DeviceName As String, ByVal DeviceData As Long)
'新设备插入
End SubPrivate Sub SysInfo1_DeviceRemoveComplete(ByVal DeviceType As Long, ByVal DeviceID As Long, ByVal DeviceName As String, ByVal DeviceData As Long)
'设备移出
End Sub

Answer 3

模块：Option Explicit
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public 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
Public Const GWL_WNDPROC = (-4)
Public Const DBT_DEVICEARRIVAL = &H8000&
Public Const DBT_DEVICEREMOVECOMPLETE = &H8004&
Public HPrev As Long
 
Public Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    On Error GoTo ErrH
    If Msg = 537 Then
        Select Case wParam
            Case DBT_DEVICEARRIVAL:
                MsgBox ("设备插入")
            Case DBT_DEVICEREMOVECOMPLETE:
                MsgBox ("设备弹出")
        End Select
    End If
    WndProc = CallWindowProc(HPrev, hWnd, Msg, wParam, lParam)
    
    Exit Function
ErrH:
        MsgBox "出错"
End Function窗体：Option ExplicitPrivate Sub Form_Load()
    HPrev = GetWindowLong(Form1.hWnd, GWL_WNDPROC)
    SetWindowLong Form1.hWnd, GWL_WNDPROC, AddressOf WndProc
End SubPrivate Sub Form_Unload(Cancel As Integer)
    SetWindowLong Form1.hWnd, GWL_WNDPROC, HPrev
End Sub