基本信息
源码名称:USBDisk文件自动删除
源码大小:4.80KB
文件格式:.rar
开发语言:ASP
更新时间:2021-08-21
   友情提示:(无需注册或充值,赞助后即可获取资源下载链接)

     嘿,亲!知识可是无价之宝呢,但咱这精心整理的资料也耗费了不少心血呀。小小地破费一下,绝对物超所值哦!如有下载和支付问题,请联系我们QQ(微信同号):813200300

本次赞助数额为: 2 元 
   源码介绍

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