以前也發過一幾篇關於卸載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