获取其中所有硬盘和分区的序列号

Question

我想获取其中存在的所有物理硬盘序列号（而不是驱动器的卷序列号）和分区。

实际上，我使用DISKID32的实现来获取所有硬盘的序列号，但这不会给硬盘提供分区，因此我计划使用其他方法。

下面的代码给出了获取物理硬盘的序列号，并在每个硬盘中找到了分区。

ComputerName = "."
Set wmiServices  = GetObject ( _
    "winmgmts:{impersonationLevel=Impersonate}!//" _
    & ComputerName)
' Get physical disk drive
Set wmiDiskDrives =  wmiServices.ExecQuery ( _
    "SELECT * FROM Win32_DiskDrive")

For Each wmiDiskDrive In wmiDiskDrives
    MsgBox "Disk drive Caption: " _
        & wmiDiskDrive.Caption _
        & VbNewLine & "DeviceID: " _
        & " (" & wmiDiskDrive.DeviceID & ")"
    MsgBox  "Serial number" _
                & wmiDiskDrive.SerialNumber
    'Use the disk drive device id to
    ' find associated partition
    query = "ASSOCIATORS OF {Win32_DiskDrive.DeviceID='" _
        & wmiDiskDrive.DeviceID & "'} WHERE AssocClass = Win32_DiskDriveToDiskPartition"
    Set wmiDiskPartitions = wmiServices.ExecQuery(query)

    For Each wmiDiskPartition In wmiDiskPartitions
        'Use partition device id to find logical disk
        Set wmiLogicalDisks = wmiServices.ExecQuery _
            ("ASSOCIATORS OF {Win32_DiskPartition.DeviceID='" _
             & wmiDiskPartition.DeviceID & "'} WHERE AssocClass = Win32_LogicalDiskToPartition")

        For Each wmiLogicalDisk In wmiLogicalDisks
            MsgBox  "Drive letter associated" _
                & " with disk drive = " _
                & wmiDiskDrive.Caption _
                & wmiDiskDrive.DeviceID _
                & VbNewLine & " Partition = " _
                & wmiDiskPartition.DeviceID _
                & VbNewLine & " is " _
                & wmiLogicalDisk.DeviceID

        Next
    Next
Next

它在Windows 8中完美运行。但是，当我在Windows XP pc中进行测试时，获取序列号即wmiDiskDrive.SerialNumber时出错。 所有其他对象均正常工作。

然后我发现该属性在Windows XP，Windows Server 2003等中不可用。现在从上面的代码中我可以获取硬盘型号及其分区，但我需要序列号。

那么，如何获得硬盘序列号及其分区（应该在所有Windows操作系统中都有效）？ 任何想法？

Answer 1

这应该可以解决您的问题。

Public Function GetDriveSerialNumber(DrvL As String) As Long

         Dim fso As Object, Drv As Object
        Dim driveletter As String
        Dim DriveSerial As String
         Set fso = CreateObject("Scripting.FileSystemObject")
        driveletter = DrvL


             Set Drv = fso.GetDrive(driveletter)


         With Drv
             If .IsReady Then
                 DriveSerial = Abs(.SerialNumber)
             Else
                 DriveSerial = -1
             End If
         End With


         Set Drv = Nothing
         Set fso = Nothing

         GetDriveSerialNumber = DriveSerial

     End Function