U盘相关

wpxxsyzx

    做一个小程序，需要实时检测是否插入指定的U盘，用到了WMI时间，想到以前的帖子http://club.excelhome.net/forum.php?mod=viewthread&tid=733445&extra=page%3D1%26filter%3Dauthor%26orderby%3Ddateline%26digest%3D1%26digest%3D1%26orderby%3Ddateline最后没有介绍订阅事件，精简一下移植到vba，简单介绍一下，放到这里权当补充吧。

   声明一下，关于用U盘做钥匙盘及禁用U盘，论坛已经有很多讨论，这里只是演示wmi事件的使用，无意引入以上讨论。两个示例都是禁用U盘，但只对代码运行后插入U盘起作用，之前插入的不起作用。

1、监测是否插入U盘，如果有就自动弹出插入的U盘。
Public WithEvents wmiEvent As SWbemSink
Private Declare Function DeviceIoControl Lib "kernel32.dll" (ByVal hDevice As Long, ByRef dwIoControlCode As Long, _
               ByRef lpInBuffer As Any, ByVal nInBufferSize As Long, ByRef lpOutBuffer As Any, ByVal nOutBufferSize As Long, _
               ByRef lpBytesReturned As Long, ByRef lpOverlapped As Long) As Long
Private Declare Function CreateFile Lib "kernel32.dll" Alias "CreateFileA" (ByVal lpFileName As String, _
               ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByRef lpSecurityAttributes As Long, _
               ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Const GENERIC_READ As Long = &H80000000
Private Const GENERIC_WRITE As Long = &H40000000
Private Const EJECT_MEDIA As Long = &H202
Private Const FILE_DEVICE_MASS_STORAGE As Long = &H2D&
Private Sub CommandButton1_Click()
    Dim wmiLocator As New SWbemLocator
    Dim wmiServices As SWbemServices
    Set wmiEvent = New SWbemSink
    Set wmiServices = wmiLocator.ConnectServer(".", "root\CIMV2")
    wmiServices.ExecNotificationQueryAsync wmiEvent, "SELECT * FROM __InstanceCreationEvent WITHIN 1 WHERE TargetInstance ISA 'Win32_LogicalDisk'"
End Sub
Private Sub CommandButton2_Click()
    If Not wmiEvent Is Nothing Then
        wmiEvent.Cancel
        Set wmiEvent = Nothing
    End If
End Sub
Private Sub Eject(ByVal sName As String)
    Dim lngFunction As Long
    Dim lngReturn As Long
    Dim lngHand As Long
    Dim lngFlag As Long
    lngFlag = GENERIC_READ Or GENERIC_WRITE
    Do
        lngHand = CreateFile(sName, lngFlag, 0, ByVal CLng(0), 3, ByVal CLng(0), ByVal CLng(0))
        If lngHand <> -1 Then Exit Do
    Loop
    lngFunction = (FILE_DEVICE_MASS_STORAGE * (2 ^ 16)) Or (1 * (2 ^ 14)) Or (EJECT_MEDIA * (2 ^ 2)) Or 0
    DeviceIoControl lngHand, ByVal lngFunction, 0, 0, 0, 0, lngReturn, ByVal 0
End Sub
Private Sub wmiEvent_OnObjectReady(ByVal objWbemObject As WbemScripting.ISWbemObject, ByVal objWbemAsyncContext As WbemScripting.ISWbemNamedValueSet)
    Eject ("\\.\" & objWbemObject.Properties_.Item("TargetInstance").Value.Properties_.Item("Caption").Value)
End Sub



2、这个方法网上资料很多，缺点也不少。修改、监测和U盘有关的注册表项，如果注册表项被改动就自动改回原值，起到禁用的效果。也可以把代码中的注册表项换成其他你需要监测的注册表项。
Public WithEvents wmiEvent As SWbemSink
Const HKEY_LOCAL_MACHINE = &H80000002
Dim wmiLocator As New SWbemLocator
Dim wmiServices As SWbemServices
Dim wMIObject As SWbemObject
Private Sub CommandButton1_Click()
    Set wmiEvent = New SWbemSink
    Set wmiServices = wmiLocator.ConnectServer(".", "root\default")
    Set wMIObject = wmiServices.Get("StdRegProv")
    wMIObject.setDWORDValue HKEY_LOCAL_MACHINE, _
    "SYSTEM\CurrentControlSet\services\USBSTOR\", "Start", 4
    wmiServices.ExecNotificationQueryAsync wmiEvent, "SELECT * FROM RegistryKeyChangeEvent WITHIN 1" & _
    "WHERE Hive='HKEY_LOCAL_MACHINE' AND KeyPath='SYSTEM\\CurrentControlSet\\services\\USBSTOR'"
End Sub
Private Sub CommandButton2_Click()
    If Not wmiEvent Is Nothing Then
        wmiEvent.Cancel
        Set wmiEvent = Nothing
        wMIObject.setDWORDValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\services\USBSTOR\", "Start", 3
        Set wMIObject = Nothing
        Set wmiServices = Nothing
        Set wmiLocator = Nothing
    End If
End Sub
Private Sub wmiEvent_OnObjectReady(ByVal objWbemObject As WbemScripting.ISWbemObject, ByVal objWbemAsyncContext As WbemScripting.ISWbemNamedValueSet)
    Dim sValue
    wMIObject.GetDWORDValue HKEY_LOCAL_MACHINE, _
    "SYSTEM\CurrentControlSet\services\USBSTOR\", "Start", sValue
    If sValue <> 4 Then
        wMIObject.setDWORDValue HKEY_LOCAL_MACHINE, _
        "SYSTEM\CurrentControlSet\services\USBSTOR\", "Start", 4
        MsgBox "注册表:HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\services\USBSTOR\" & vbCrLf & _
        "下的键“Start”的值被修改！但是该键值已经强制重新设为4，即禁止U盘。"
    End If
End Sub

Iaixueexcel

好用，谢谢分享

bj079

下载试试，谢谢版主分享。

lovefoolu

{:soso_e142:}L太强大了，你的WMI帖子我都观摩过了，再次感谢

sunny_8848

下载学习 ，谢谢版主分享。

592rmb

好啊，收藏了学习

aman1516

版主推介，必精品，好好学习

ahh0511

谢谢分享，很多时候还是很有用的！

136211828

感谢版主，学习ing~

pplived

楼主很强大, 谢谢分享