通过USB VID和PID卸载USB设备

以前也发过一几篇关于卸载USB设备的文章，其实原理都是一样都是使用同一个API "CM_Request_Device_Eject_ExW"来完成卸载工作，上一篇是通过遍历USB接点实现，这篇文章直接通过USB 的VID和PID获取其对应的DevInst来完成卸载工作。本篇文章通过使用了WMI技术来实现了很多关键点的功能。

 

查了很多资料想了很多方法也没找到从一个USB盘符获取该USB设备的VID和PID串比如，我的U盘VID和PID串是“Vid_0781&Pid_5151”，SerialNumber是“2204611D84C38930”，那么我们就可以通过

CM_Locate_DevNodeA(VarPtr(dwDevInst), "USB/Vid_0781&Pid_5151/2204611D84C38930", 0)来获取到dwDevInst，这样继续使用CM_Request_Device_Eject_ExA函数就可以完成对USB设备的卸载工作了。如果哪位朋友知道怎么从U盘的盘符获取到VID和PID串请与我联系，谢谢！

 

form

 

Option Explicit
Private Declare Function CM_Locate_DevNodeA Lib "setupapi.dll" (ByVal pdnDevInst As Long, ByVal DeviceInstanceId As String, ByVal ulFlags As Long) As Long
Private Declare Function CM_Request_Device_Eject_ExA Lib "setupapi.dll" (ByVal pdnDevInst As Long, ByVal VetoType As Long, ByVal pszVetoName As String, ByVal ulNameLength As Long, ByVal ulFlags As Long, ByVal hMachine As Long) As Long
'BOOL WINAPI CM_Locate_DevNodeA ( OUT PDEVINST pdnDevInst, IN DEVINSTID_A pDeviceID, IN ULONG ulFlags )
'BOOL WINAPI CM_Request_Device_Eject_ExA ( IN DEVINST dnDevInst, OUT PPNP_VETO_TYPE pVetoType, IN LPSTR pszVetoName, IN ULONG ulNameLength, IN ULONG ulFlags, IN HMACHINE hMachine )

Private Function GetSerialNumber(ByVal strDeviceId As String) As String '在DeviceId中获取SerialNumber
    Dim i As Integer
    Dim Length As Integer
    Length = Len(strDeviceId)
    For i = Length To 1 Step -1
        If Mid(strDeviceId, i, 1) = "/" Then
            GetSerialNumber = Mid(strDeviceId, i + 1, Length - i - 1)
            Exit Function
        End If
    Next
End Function

Private Sub GetUsbDevices() '获取所有usb分区
    Dim strWQL As String
    Dim objSWbemServices As SWbemServices, objWmiObject As SWbemObject, objWmiObjectSet As SWbemObjectSet, objPattions As SWbemObjectSet, objPattion As SWbemObject
    Dim objLogicalDiskToPartitions As SWbemObjectSet, objLogicalDiskToPartition As SWbemObject
   
    If ConnectWmiServer(objSWbemServices, ".") Then
        strWQL = "Select * From Win32_DiskDrive where InterfaceType='USB'"
        Set objPattions = objSWbemServices.ExecQuery(strWQL)
        For Each objPattion In objPattions
            strWQL = "Associators of {win32_DiskDrive.DeviceID='" & objPattion.DeviceID & "'} where AssocClass = Win32_DiskDriveToDiskPartition"
            Set objWmiObjectSet = objSWbemServices.ExecQuery(strWQL)
            For Each objWmiObject In objWmiObjectSet
                Debug.Print objWmiObject.Description; objWmiObject.Name; objWmiObject.PNPDeviceID; objWmiObject.Index
                strWQL = "Associators of {Win32_DiskPartition.DeviceID='" & objWmiObject.DeviceID & "'} where AssocClass = Win32_LogicalDiskToPartition"
                Set objLogicalDiskToPartitions = objSWbemServices.ExecQuery(strWQL)
                For Each objLogicalDiskToPartition In objLogicalDiskToPartitions
                    cboUsbDriveList.AddItem "" & objLogicalDiskToPartition.Description & "(" & objLogicalDiskToPartition.Name & ")"
                Next
            Next
        Next
        If cboUsbDriveList.ListCount Then
            cboUsbDriveList.ListIndex = 0
        Else
            cboUsbDriveList.Text = "目前没有发现USB设备"
        End If
        Set objSWbemServices = Nothing
        Set objWmiObject = Nothing
        Set objWmiObjectSet = Nothing
        Set objPattions = Nothing
        Set objPattion = Nothing
        Set objLogicalDiskToPartitions = Nothing
        Set objLogicalDiskToPartition = Nothing
    End If
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdRefresh_Click()
    Me.cboUsbDriveList.Clear
    GetUsbDevices
End Sub

Private Sub cmdUnload_Click()
    Dim strUsbHubs() As String
    Dim KeyCount As Long, SerialNumberCount As Long
    Dim i As Long, j As Long
    Dim strSerialNumbers() As String
    Dim strDrive As String
    Dim strWQL As String
    Dim objSWbemServices As SWbemServices, objWmiObject As SWbemObject, objWmiObjectSet As SWbemObjectSet
    Dim objPattions As SWbemObjectSet, objPattion As SWbemObject
    Dim strDeviceId As String
    Dim strDeviceInstanceId As String
    Dim strSerialNumber As String
    Dim lngRet As Long, dwDevInst As Long
   
    On Error GoTo ErrorHandle
    strDrive = Mid(cboUsbDriveList.List(cboUsbDriveList.ListIndex), InStr(cboUsbDriveList.List(cboUsbDriveList.ListIndex), "(") + 1, 2)
    strWQL = "Associators of {Win32_LogicalDisk='" & strDrive & "'} where ResultClass = Win32_DiskPartition"
    If ConnectWmiServer(objSWbemServices, ".") Then
        '这里获取了所有磁盘的DeviceId这里面包括了磁盘的SerialNumber，下面我们需要用SerialNumber去查找USB的VID和PID
        Set objPattions = objSWbemServices.ExecQuery(strWQL)
        For Each objPattion In objPattions
            strWQL = "Select * From win32_DiskDrive where Index=" & objPattion.DiskIndex
            Set objWmiObjectSet = objSWbemServices.ExecQuery(strWQL)
            For Each objWmiObject In objWmiObjectSet
                strDeviceId = objWmiObject.PNPDeviceID
                strSerialNumber = GetSerialNumber(strDeviceId)
                If InStr(strSerialNumber, "&") Then
                    strSerialNumber = Left(strSerialNumber, InStr(strSerialNumber, "&") - 1)
                End If
                '遍历所有USB设备，这里包括正在使用的和曾经使用过的我们通过SerialNumber去查找目前正在使用的
                strUsbHubs = GetSubKeys("/Registry/Machine/SYSTEM/CurrentControlSet/Enum/USB")
                KeyCount = UBound(strUsbHubs) + 1
                For i = 0 To KeyCount - 1
                    '查找所有USB设备的SerialNumber
                    strSerialNumbers = GetSubKeys("/Registry/Machine/SYSTEM/CurrentControlSet/Enum/USB/" & strUsbHubs(i))
                    SerialNumberCount = UBound(strSerialNumbers) + 1
                    For j = 0 To SerialNumberCount - 1
                        If strSerialNumber = strSerialNumbers(j) Then
                            strDeviceInstanceId = "USB/" & strUsbHubs(i) & "/" & strSerialNumbers(j)
                            '这里这种方法不是很好，是通过U盘的SerialNumber去查找VID和PID对于一些没有SerialNumber的显然这种方法是不行的
                            '目前我还没想到怎么直接从U盘的盘符取到VID和PID现在只有将就用这种方法了
                            lngRet = CM_Locate_DevNodeA(VarPtr(dwDevInst), strDeviceInstanceId, 0)
                            If lngRet = 0 Then
                                lngRet = CM_Request_Device_Eject_ExA(dwDevInst, 0, vbNullString, 0, 0, 0)
                                Exit For
                            End If
                        End If
                    Next
                    Erase strSerialNumbers
                Next
                Erase strUsbHubs
            Next
        Next
    End If

ErrorHandle:
    Set objSWbemServices = Nothing
    Set objWmiObject = Nothing
    Set objWmiObjectSet = Nothing
    Set objPattions = Nothing
    Set objPattion = Nothing
    cmdRefresh_Click
End Sub

Private Sub Form_Load()
    GetUsbDevices
End Sub

 

'连接WMI服务函数(此函数也可以连接远程计算机，当要连接远程计算机时把参数“strComputerName”指示为IP地址即可但是注意的是还要提供用户名和密码)
Private Function ConnectWmiServer(ByRef objSWbemServices As SWbemServices, _
                                  ByVal strComputerName As String, _
                                  Optional ByVal strNameSpace As String = "root/cimv2", _
                                  Optional ByVal strUserName As String = "", _
                                  Optional ByVal strPassWord As String = "" _
                                  ) As Boolean
    Dim objSWbemLocator As SWbemLocator
    On Error GoTo ErrLine
    Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")
    '提升权限为DEBUG权限
    objSWbemLocator.Security_.Privileges.Add wbemPrivilegeDebug
    If strComputerName <> "." Then
        Set objSWbemServices = objSWbemLocator.ConnectServer(strComputerName, strNameSpace, strUserName, strPassWord)
    Else
        Set objSWbemServices = objSWbemLocator.ConnectServer()
    End If
    ConnectWmiServer = True
    Set objSWbemLocator = Nothing
    Exit Function
ErrLine:
    ConnectWmiServer = False
    Set objSWbemLocator = Nothing
End Function

 

bas:

 

Option Explicit

Private Type UNICODE_STRING
    Length As Integer
    MaximumLength As Integer
    Buffer As Long
End Type

Private Type OBJECT_ATTRIBUTES
    Length As Long
    RootDirectory As Long
    ObjectName As Long
    Attributes As Long
    SecurityDescriptor As Long
    SecurityQualityOfService As Long
End Type

Private Type KEY_VALUE_FULL_INFORMATION
    TitleIndex As Long
    Type As Long
    DataOffset As Long
    DataLength As Long
    NameLength As Long
    Name As Long
End Type

Private Type LARGE_INTEGER
    Lowpart As Long
    Highpart As Long
End Type

Private Type KEY_BASIC_INFORMATION
    LastWriteTim As LARGE_INTEGER
    TitleIndex As Long
    NameLength As Long
    Name As Long
End Type

Private Type KEY_FULL_INFORMATION
    LastWriteTim As LARGE_INTEGER
    TitleIndex As Long
    ClassOffset As Long
    ClassLength As Long
    SubKeys As Long
    MaxNameLen As Long
    MaxClassLen As Long
    Values As Long
    MaxValueNameLen As Long
    MaxValueDataLen As Long
    Class As Long
End Type

Private Enum KEY_INFORMATION_CLASS
    KeyBasicInformation
    KeyNodeInformation
    KeyFullInformation
    KeyNameInformation
    KeyCachedInformation
    KeyFlagsInformation
End Enum

Private Enum KEY_VALUE_INFORMATION_CLASS
    KeyValueBasicInformation
    KeyValueFullInformation
    KeyValuePartialInformation
    KeyValueFullInformationAlign64
    KeyValuePartialInformationAlign64
End Enum

Private Const STATUS_BUFFER_OVERFLOW = &H80000005
Private Const STATUS_BUFFER_TOO_SMALL = &HC0000023
Private Const OBJ_CASE_INSENSITIVE = &H40

Private Const READ_CONTROL = &H20000
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL

Private Declare Function ZwClose Lib "ntdll.dll" (ByVal ObjectHandle As Long) As Long

Private Declare Sub RtlInitUnicodeString Lib "ntdll.dll" (ByVal DestinationString As Long, ByVal SourceString As Long)

Private Declare Function ZwOpenKey Lib "ntdll.dll" (KeyHandle As Long, ByVal DesiredAccess As Long, ByVal ObjectAttributes As Long) As Long

Private Declare Function ZwQueryKey Lib "ntdll.dll" (ByVal KeyHandle As Long, _
                                                     ByVal KeyInformationClass As KEY_INFORMATION_CLASS, _
                                                     ByVal KeyInformation As Long, _
                                                     ByVal KeyInformationLength As Long, _
                                                     ResultLength As Long _
                                                     ) As Long
                                                    
Private Declare Function ZwEnumerateValueKey Lib "ntdll.dll" (ByVal KeyHandle As Long, _
                                                              ByVal Index As Long, _
                                                              ByVal KeyValueInformationClass As KEY_VALUE_INFORMATION_CLASS, _
                                                              ByVal KeyValueInformation As Long, _
                                                              ByVal KeyValueInformationLength As Long, _
                                                              ResultLength As Long _
                                                              ) As Long
                                                             
Private Declare Function ZwEnumerateKey Lib "ntdll.dll" (ByVal KeyHandle As Long, _
                                                         ByVal Index As Long, _
                                                         ByVal KeyInformationClass As KEY_INFORMATION_CLASS, _
                                                         ByVal KeyInformation As Long, _
                                                         ByVal KeyInformationLength As Long, _
                                                         ResultLength As Long _
                                                         ) As Long
                                                             
                                                             
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)

Public Function GetSubKeys(ByVal lpRegKey As String) As String()
    Dim strSubKeys() As String
    Dim KeyHandle As Long
    Dim ntStatus As Long
    Dim ResultLength As Long
    Dim bytBuffer() As Byte
    Dim bytValueBuffer() As Byte
    Dim strValue As String
    Dim KeyBase As KEY_BASIC_INFORMATION
    Dim KeyValueFull As KEY_VALUE_FULL_INFORMATION
    Dim KeyFull As KEY_FULL_INFORMATION
    Dim i As Integer
    Dim ustrKeyName As UNICODE_STRING
    Dim objAttr As OBJECT_ATTRIBUTES
    Dim strKeyName As String
   
    RtlInitUnicodeString VarPtr(ustrKeyName), StrPtr(lpRegKey)
   
    objAttr.Length = LenB(objAttr)
    objAttr.ObjectName = VarPtr(ustrKeyName)
    objAttr.Attributes = OBJ_CASE_INSENSITIVE
    ntStatus = ZwOpenKey(KeyHandle, KEY_READ, VarPtr(objAttr))
    If ntStatus >= 0 Then
        ntStatus = ZwQueryKey(KeyHandle, _
                              KeyFullInformation, _
                              0, _
                              0, _
                              ResultLength _
                              )
        If ntStatus = STATUS_BUFFER_OVERFLOW Or ntStatus = STATUS_BUFFER_TOO_SMALL Then
            ReDim bytBuffer(ResultLength - 1)
            ntStatus = ZwQueryKey(KeyHandle, _
                                  KeyFullInformation, _
                                  VarPtr(bytBuffer(0)), _
                                  ResultLength, _
                                  ResultLength _
                                  )
            If ntStatus >= 0 Then
                CopyMemory VarPtr(KeyFull), VarPtr(bytBuffer(0)), LenB(KeyFull)
                ReDim strSubKeys(KeyFull.SubKeys - 1)
                For i = 0 To KeyFull.SubKeys - 1
                    ntStatus = ZwEnumerateKey(KeyHandle, _
                                              i, _
                                              KeyBasicInformation, _
                                              0, _
                                              0, _
                                              ResultLength _
                                              )
                    If ntStatus = STATUS_BUFFER_OVERFLOW Or ntStatus = STATUS_BUFFER_TOO_SMALL Then
                        ReDim bytValueBuffer(ResultLength - 1)
                        ntStatus = ZwEnumerateKey(KeyHandle, _
                                                  i, _
                                                  KeyBasicInformation, _
                                                  VarPtr(bytValueBuffer(0)), _
                                                  ResultLength, _
                                                  ResultLength _
                                                  )
                        If ntStatus >= 0 Then
                            CopyMemory VarPtr(KeyBase), VarPtr(bytValueBuffer(0)), LenB(KeyBase)
                            strValue = String(KeyBase.NameLength / 2, 0)
                            CopyMemory StrPtr(strValue), VarPtr(bytValueBuffer(0)) + 16, KeyBase.NameLength
                            strKeyName = strValue
                            strSubKeys(i) = strKeyName
                        End If
                        Erase bytValueBuffer
                    End If
                Next
            End If
            Erase bytBuffer
        End If
        ZwClose KeyHandle
    End If
    GetSubKeys = strSubKeys
End Function