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

VB读取优盘物理序列号


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


马大哈 发表于 2010-9-17 18:20:52

顶顶。

做U盘管理程序用得着。

沉默的人 发表于 2011-2-13 14:08:59

呵呵学习看看。

yxcsky 发表于 2011-3-17 22:13:57

顶收藏了。。。

hjvvsvhsvs 发表于 2011-3-31 10:38:48

我复制下了，感谢！

upring 发表于 2015-9-17 09:28:40

谢谢 阿杰 代码收了
页: [1]
查看完整版本: VB读取优盘物理序列号