关于如何监控U盘或光盘的问题

Question

想学习一下对可移动媒体的操作控制，主要实现以下几个功能：
1.用一个文本文件如xx.txt记录一些文件名称（如“病毒.xx”,"木马.xx"等等）
2.程序启动时先检查系统硬件自动播放是否被启用。是，则禁用自动播放。
3.当有媒体被添加到系统中（如U盘插入）：
    第一步检测媒体根目录下的文件夹和文件名称并与xx.txt中的文件名称对比，文件夹或文件名称在xx.txt中有记录的，删除该文件夹/文件；
    第二部检测媒体二级目录下的文件夹和文件名称并与xx.txt中的文件名称对比，文件夹或文件名称在xx.txt中有记录的，删除该文件夹/文件。
    二级目录以下的N级目录忽略。祝各位春节愉快！低头工作，抬头生活，幸福常有，快乐多多！
分有点少，请各位见谅，谢谢！

Answer 1

拦截WM_DEVICECHANGE消息处理就行 ' in  Module1.bas file
Option Explicit'-------------------------------------------------------------------------------------------
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
'-------------------------------------------------------------------------------------------Public Function CallBackWindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    On Error Resume Next
    CallBackWindowProc = GetSubclassObject(hWnd).WindowProc(hWnd, uMsg, wParam, lParam)
End FunctionPrivate Function GetSubclassObject(ByVal hWnd As Long) As Form1
    Dim pObj As Long
    Dim oObj As Form1
    
    Dim strClass As String
    strClass = "vSubClass" & hWnd
    pObj = GetProp(hWnd, strClass)
    
    If pObj <> 0 Then
        CopyMemory oObj, pObj, 4&
        Set GetSubclassObject = oObj
        CopyMemory oObj, 0&, 4&
    End If
End Function
 
 
' in form1.frm
Option ExplicitPrivate Type DEV_BROADCAST_HDR
    dbcv_size As Long
    dbcv_devicetype As Long
    dbcv_reserved As Long
End TypePrivate 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 TypePrivate Const GWL_WNDPROC = (-4)
Private Const WM_DEVICECHANGE           As Long = &H219Private Const DBT_DEVICEARRIVAL         As Long = 32768 '&H8000    ' system detected a new device
Private Const DBT_DEVICEREMOVECOMPLETE  As Long = 32772 '&H8004    ' device is gone
Private Const DBT_DEVTYP_VOLUME         As Long = 2 '&H2       ' logical volume
Private Const DBTF_MEDIA                As Long = 1 '&H1       ' media comings and goings
Private Const DBTF_NET                  As Long = 2 '&H2       ' network volumePrivate Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hWnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private 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
'-------------------------------------------------------------------------------------------------------
'
Private m_hPrevProc     As Long
Private m_hWnd          As Long
Private m_IsSubClass    As Boolean
 
Private Sub Form_Load()
    Dim strName As String
    Dim lResult As Long
       
    ' SubClass Window
    strName = "vSubClass" & hWnd
    If SetProp(Me.hWnd, strName, ObjPtr(Me)) <> 0 Then
        m_hPrevProc = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf CallBackWindowProc)
        m_IsSubClass = (m_hPrevProc <> 0)
    Else
        m_IsSubClass = False
    End If
  
End SubPrivate Sub Form_Unload(Cancel As Integer)
     ' UnSubclass
    If m_IsSubClass Then
        SetWindowLong Me.hWnd, GWL_WNDPROC, m_hPrevProc
    End If
End SubPublic Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, lParam As Long) As Long
    If (uMsg = WM_DEVICECHANGE) Then
        If wParam = DBT_DEVICEARRIVAL Or wParam = DBT_DEVICEREMOVECOMPLETE Then
            Dim hdr As DEV_BROADCAST_HDR
            CopyMemory ByVal VarPtr(hdr), ByVal lParam, LenB(hdr)
            If hdr.dbcv_devicetype = DBT_DEVTYP_VOLUME Then
                Dim volume As DEV_BROADCAST_VOLUME
                Dim strDriver As String
                CopyMemory ByVal VarPtr(volume), ByVal lParam, LenB(volume)
                strDriver = GetDriverName(volume.dbcv_unitmask)
                Debug.Print IIf(wParam = DBT_DEVICEARRIVAL, "插入", "移出") & "磁盘驱动器(" & strDriver & ":)"
                If (wParam = DBT_DEVICEARRIVAL) Then
                    DoEvents
                    Call ListDriverFiles(strDriver)
                End If
             End If
        End If
    End If
    WindowProc = CallWindowProc(m_hPrevProc, hWnd, uMsg, wParam, lParam)
End FunctionPrivate Function GetDriverName(ByVal lMask As Long) As String
    Dim drv(25) As Long
    drv(0) = &H1            'A
    drv(1) = &H2            'B
    drv(2) = &H4            'C
    drv(3) = &H8            'D
    drv(4) = &H10           'E
    drv(5) = &H20           'F
    drv(6) = &H40           'G
    drv(7) = &H80           'H
    drv(8) = &H100          'I
    drv(9) = &H200          'J
    drv(10) = &H400         'K
    drv(11) = &H800         'L
    drv(12) = &H1000        'M
    drv(13) = &H2000        'N
    drv(14) = &H4000        'O
    drv(15) = &H8000        'P
    drv(16) = &H10000       'Q
    drv(17) = &H20000       'R
    drv(18) = &H40000       'S
    drv(19) = &H80000       'T
    drv(20) = &H100000      'U
    drv(21) = &H200000      'V
    drv(22) = &H400000      'W
    drv(23) = &H800000      'X
    drv(24) = &H1000000     'Y
    drv(25) = &H2000000     'Z
 
    Dim i As Long
    For i = 0 To 25
        If lMask And drv(i) Then
            GetDriverName = Chr(Asc("A") + i)
            Exit Function
        End If
    Next
    GetDriverName = vbNullString
End FunctionPrivate Sub ListDriverFiles(ByVal strDriver As String)
    Dim strFile As String
     
    strFile = Dir(strDriver & ":\*.*", vbDirectory)
    While (strFile <> vbNullString)
        Debug.Print strDriver & ":\" & strFile
        strFile = Dir
    Wend
    
End Sub

Answer 2

WM_DEVICECHANGE
Windows消息_设备变化

Answer 3

主要就是要处理WM_DEVICECHANGE这个消息，当光盘，U盘等插入时，windows会触发这个消息，你的程序接收到这个消息了，就可以读取U盘等信息，然后处理你后面的逻辑