以前也发过一几篇关于卸载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 "<Disk:" & objPattion.Index & ":" & objWmiObject.Index + 1 & ">" & 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