VB读取优盘物理序列号

阿杰 · 发表于 2010-9-16 16:35:25

Public Function GetUDiskID() As String
'**********************
'*Function:读取优盘物理序列号
'*Author:张旋(zxsoft)
'**********************
On Error Resume Next
Dim objWMIService As Object
Dim colDevices As Object
Dim objdevice As Object
Dim UDiskID As String
Dim isUDisk As Boolean
Dim objUsbDevice As Object
Dim colUSBDevices As Object
isUDisk = False
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colDevices = objWMIService.ExecQuery("Select * From Win32_USBControllerDevice")
Dim ret
For Each objdevice In colDevices
Set colUSBDevices = objWMIService.ExecQuery("Select * From Win32_PnPEntity Where DeviceID = '" & Split(Replace(objdevice.Dependent, Chr(34), ""), "=")(1) & "'")
For Each objUsbDevice In colUSBDevices
If Left(objUsbDevice.DeviceID, 8) = "STORAGE" Then
GetUDiskID = UDiskID
Exit Function
End If
If Left(objUsbDevice.DeviceID, 8) = "USB\VID_" Then
UDiskID = Split(objUsbDevice.DeviceID, "")(2)
If InStr(UDiskID, "&") > 0 Then
ret = Split(UDiskID, "&")
UDiskID = ret(UBound(ret) - 2)
End If
End If
Next
Next
GetUDiskID = "U-Disk-Not-Found"
End Function
'终于找到那个读序列号的代码了！原来放在gmail里啦！帖出来吧！就是比我写的好呀
Sub cc()
On Error Resume Next
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_USBHub")
For Each objItem In colItems
a = objItem.DeviceID 'U盘识别为:USB\VID_09A6&PID_800\20040418154911-00，故用VID判别
If a Like "*VID*" Then b = Split(a, ""): MsgBox b(UBound(b))
'上句亦可:If InStr(a, "VID") Then b = Split(a, ""): MsgBox b(UBound(b))
Next
End Sub
Private Sub Form_Load()
Debug.Print GetUDiskID()
cc
End Sub