如何通过VB检索闪存的序列号 [英] how to retrive serialnumber of flash memory by VB

问题描述

我需要通过Visual Basic读取闪存的S/N.你能帮我吗
请给我回复[DELETED] @ irnase.com

[edit]电子邮件已删除-OriginalGriff [/edit]

解决方案

这很有可能无法正常工作:我还没有遇到闪存驱动器带有序列号，但这也许是因为我买了便宜的序列号...

添加对System.Management的引用，然后:

 暗全部 As  新 ManagementObjectSearcher(" )
对于 每个 mo  As  ManagementObject 全部.[获取]()
 Dim  mediaTag  As  新建 ManagementObject("  + mo("  DeviceID")&  '")
Console.WriteLine(mediaTag(" ).ToString())
下一个 

这是我的方法...

代码顶部:

 '  **获取音量信息-
公共 声明 功能 GetVolumeInformation 库 "  _
  别名 " ( ByVal  lpRootPathName  As  字符串，_
   ByVal  lpVolumeNameBuffer  As  字符串， ByVal  nVolumeNameSize  As  长，_
  lpVolumeSerialNumber  As  长，lpMaximumComponentLength  As  长，_
  lpFileSystemFlags  As  长， ByVal  lpFileSystemNameBuffer  As  字符串，_
   ByVal  nFileSystemNameSize  As  长) As  长 

获取序列号功能:

 公共 功能 GetSerialNum( ByVal  sAppPath  As  字符串) As  长
     Dim  jSerNum  As  长
    暗 sFSNBuff  As  字符串
     Dim  sSerNum  As  字符串
    暗 sVolBuff  As  字符串
     Dim  sDrvSave  As  字符串
    暗 sDirSave  As  字符串

    '  **初始化.
    sVolBuff = 字符串( 255 ， 0 )
    sFSNBuff = 字符串( 255 ， 0 )

    '  **确保sAppPath设置为"x:\".
    sAppPath = Left(sAppPath， 2 )& " 

    '  **保存信息.
    sDrvSave = Left(CurDir()， 2 )
    sDirSave = CurDir(sAppPath)

    '  **更改为sAppPath的根.
    调用 ChDrive(左侧(sAppPath， 2 ))
    致电 ChDir(sAppPath)

    '  **获取"x:\"的序列号.
    调用 GetVolumeInformation(sAppPath，" ，  0 ，jSerNum， 0 ， 0 ， " ， 0 )

    '  **如果出错，请获取"x:"的序列号.
    如果 jSerNum =  0  然后
        sAppPath = Left(sAppPath， 2 )
        调用 GetVolumeInformation(sAppPath，sVolBuff， 255 ，jSerNum， 0 ， 0 ，_
          sFSNBuff， 255 )
    结束 如果

    '  **返回已保存的目录和驱动器.
    致电 ChDir(sDirSave)

    '  **返回.
    GetSerialNum = jSerNum
结束 功能 

功能 GetUSBSerialNo( As  字符串)
         Dim  PnPID  As   String 
        PnPID = USBSerialNo(驱动器号)
     
        如果 不是 Trim(PnPID)= " " 其他
            GetUSBSerialNo = " 
       结束 如果
     
    结束 功能
     
     
    功能 USBSerialNo( ByVal  DriveLetter  As  字符串)
     
    昏暗 objFSO
    昏暗 objFolder
    暗目录
    常量 OverwriteExisting = 真实
     
     Dim 序列号 As   String 
     
    昏暗 ComputerName
    ComputerName = " 
     Dim  wmiServices，wmiDiskDrives，wmiDiskDrive，查询，wmiDiskPartitions，wmiDiskPartition，wmiLogicalDisks，wmiLogicalDisk
     
    设置 wmiServices = GetObject(_
        "  _
        &电脑名称)
     
    设置 wmiDiskDrives = wmiServices.ExecQuery(" )
     
    对于 每个 wmiDiskDrive 在中wmiDiskDrives
     
        SerialNo = wmiDiskDrive.PNPDeviceID '  1 
     
     查询= " 的关联者_
            & wmiDiskDrive.deviceid& " 
        设置 wmiDiskPartitions = wmiServices.ExecQuery(query)
     
        对于 每个 wmiDiskPartition 在中wmiDiskPartitions
            设置 wmiLogicalDisks = wmiServices.ExecQuery _
                ("  _的关联者
                 & wmiDiskPartition.deviceid& " 
     
            对于 每个 wmiLogicalDisk 在中
     
            如果(wmiLogicalDisk.deviceid = DriveLetter) And (wmiLogicalDisk.DriveType = 然后  2 
                USBSerialNo =序列号
                退出 功能
            结束 如果
     
            下一步
        下一步
    下一步
    结束 功能
     
     
    功能 formatSerialNo( ByVal  PnPID  As  字符串)
        昏暗 arrSerialNo
        昏暗 arrSerialNo1
        arrSerialNo =拆分(PnPID，" )
        昏暗我
        arrSerialNo1 =拆分(arrSerialNo(UBound(arrSerialNo))，" )
     
        如果 UBound(arrSerialNo1)>  0  然后
            formatSerialNo = arrSerialNo1(UBound(arrSerialNo1)- 1 )
        其他
            formatSerialNo = arrSerialNo1(UBound(arrSerialNo1))
        结束 如果
     
    结束 功能
     



私有  Sub  Command1_Click()
MsgBox GetUSBSerialNo(J)
结束 子 

i need to read S/N of flash memory by Visual Basic . can you help me
please reply me to [DELETED]@irnase.com

[edit]Email removed - OriginalGriff[/edit]

解决方案

There is a very good chance that this won''t work: I have yet to meet a flash drive with a serial number, but maybe that''s because I buy cheap ones...

Add a reference to System.Management, then:

Dim all As New ManagementObjectSearcher("SELECT * FROM Win32_DiskDrive WHERE InterfaceType='USB'")
For Each mo As ManagementObject In all.[Get]()
	Dim mediaTag As New ManagementObject("Win32_PhysicalMedia.Tag='" + mo("DeviceID") & "'")
	Console.WriteLine(mediaTag("SerialNumber").ToString())
Next

Here is my method...

Top of code:

' ** Get volume information -
Public Declare Function GetVolumeInformation Lib "kernel32" _
  Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _
  ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
  lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
  lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
  ByVal nFileSystemNameSize As Long) As Long

Get Serial Number Function:

Public Function GetSerialNum(ByVal sAppPath As String) As Long
    Dim jSerNum As Long
    Dim sFSNBuff As String
    Dim sSerNum As String
    Dim sVolBuff As String
    Dim sDrvSave As String
    Dim sDirSave As String

    ' ** Init.
    sVolBuff = String(255, 0)
    sFSNBuff = String(255, 0)

    ' ** Make sure sAppPath is set to "x:\".
    sAppPath = Left(sAppPath, 2) & "\"

    ' ** Save info.
    sDrvSave = Left(CurDir(), 2)
    sDirSave = CurDir(sAppPath)

    ' ** Change to the root of sAppPath.
    Call ChDrive(Left(sAppPath, 2))
    Call ChDir(sAppPath)

    ' ** Get serial number for "x:\".
    Call GetVolumeInformation(sAppPath, "", 0, jSerNum, 0, 0, "", 0)

    ' ** If error, get serial number for "x:".
    If jSerNum = 0 Then
        sAppPath = Left(sAppPath, 2)
        Call GetVolumeInformation(sAppPath, sVolBuff, 255, jSerNum, 0, 0, _
          sFSNBuff, 255)
    End If

    ' ** Return to saved directory and drive.
    Call ChDir(sDirSave)

    ' ** Return.
    GetSerialNum = jSerNum
End Function

Function GetUSBSerialNo(ByVal DriveLetter As String)
        Dim PnPID As String
        PnPID = USBSerialNo(DriveLetter)
     
        If Not Trim(PnPID) = "" Then
            GetUSBSerialNo = formatSerialNo(PnPID)
        Else
            GetUSBSerialNo = ""
       End If
     
    End Function
     
     
    Function USBSerialNo(ByVal DriveLetter As String)
     
    Dim objFSO
    Dim objFolder
    Dim Directory
    Const OverwriteExisting = True
     
    Dim SerialNo As String
     
    Dim ComputerName
    ComputerName = "."
    Dim wmiServices, wmiDiskDrives, wmiDiskDrive, query, wmiDiskPartitions, wmiDiskPartition, wmiLogicalDisks, wmiLogicalDisk
     
    Set wmiServices = GetObject( _
        "winmgmts:{impersonationLevel=Impersonate}!//" _
        & ComputerName)
     
    Set wmiDiskDrives = wmiServices.ExecQuery("SELECT Caption, DeviceID,PNPDeviceID FROM Win32_DiskDrive")
     
    For Each wmiDiskDrive In wmiDiskDrives
     
        SerialNo = wmiDiskDrive.PNPDeviceID '1
     
     query = "ASSOCIATORS OF {Win32_DiskDrive.DeviceID='" _
            & wmiDiskDrive.deviceid & "'} WHERE AssocClass = Win32_DiskDriveToDiskPartition"
        Set wmiDiskPartitions = wmiServices.ExecQuery(query)
     
        For Each wmiDiskPartition In wmiDiskPartitions
            Set wmiLogicalDisks = wmiServices.ExecQuery _
                ("ASSOCIATORS OF {Win32_DiskPartition.DeviceID='" _
                 & wmiDiskPartition.deviceid & "'} WHERE AssocClass = Win32_LogicalDiskToPartition")
     
            For Each wmiLogicalDisk In wmiLogicalDisks
     
            If (wmiLogicalDisk.deviceid = DriveLetter) And (wmiLogicalDisk.DriveType = 2) Then '2
                USBSerialNo = SerialNo
                Exit Function
            End If
     
            Next
        Next
    Next
    End Function
     
     
    Function formatSerialNo(ByVal PnPID As String)
        Dim arrSerialNo
        Dim arrSerialNo1
        arrSerialNo = Split(PnPID, "\")
        Dim i
        arrSerialNo1 = Split(arrSerialNo(UBound(arrSerialNo)), "&")
     
        If UBound(arrSerialNo1) > 0 Then
            formatSerialNo = arrSerialNo1(UBound(arrSerialNo1) - 1)
        Else
            formatSerialNo = arrSerialNo1(UBound(arrSerialNo1))
        End If
     
    End Function
     



Private Sub Command1_Click()
MsgBox GetUSBSerialNo(J)
End Sub

这篇关于如何通过VB检索闪存的序列号的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！