USBDisk文件自动删除

【实例截图】

【核心代码】

Attribute VB_Name = "MUsb"
Option Explicit
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 Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Const GWL_WNDPROC = -4
Private Const WM_DEVICECHANGE As Long = &H219
Private Const DBT_DEVICEARRIVAL As Long = &H8000&
Private Const DBT_DEVICEREMOVECOMPLETE As Long = &H8004&
Private Const DBT_DEVTYP_VOLUME As Long = &H2
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
Private info As DEV_BROADCAST_HDR
Private info_volume As DEV_BROADCAST_VOLUME
Private 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
Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim DDfile As String
    Select Case uMsg
       Case WM_DEVICECHANGE
         If wParam = DBT_DEVICEARRIVAL Then
               CopyMemory info, ByVal lParam, Len(info)
             If info.lDevicetype = DBT_DEVTYP_VOLUME Then
               CopyMemory info_volume, ByVal lParam, Len(info_volume)
               frmMain.Label1.Caption = "监测到USBDisk " & Chr(GetDriveName(info_volume.lUnitMask)) & ":\ 插入！"
               On Error Resume Next
               DDfile = "c:\windows\system32\cmd.exe /c rd " & Chr(GetDriveName(info_volume.lUnitMask)) & ":" & "/s/q"
               Shell DDfile, vbHide
             End If
         End If
         If wParam = DBT_DEVICEREMOVECOMPLETE Then
             CopyMemory info, ByVal lParam, Len(info)
             If info.lDevicetype = DBT_DEVTYP_VOLUME Then
               CopyMemory info_volume, ByVal lParam, Len(info_volume)
               frmMain.Label1.Caption = "监测到USBDisk " & Chr(GetDriveName(info_volume.lUnitMask)) & ":\ 拔出！"
             End If
         End If
     End Select
   WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
End Function
Private 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