vb6怎样读取win10下硬盘序列号

发布网友 发布时间:2022-02-23 02:10

我来回答

2个回答

懂视网 时间:2022-02-23 06:31

硬盘序列号的查法:

1.按下【windows】+【R】键,输入cmd

2.输入diskpart,按回车键

3.输入list disk,按回车键

4.输入select disk 0,按回车键

5.输入detail disk,按回车键

6.弹出的信息中第二行就是硬盘序列号

热心网友 时间:2022-02-23 03:39

vb6读取win10下硬盘序列号方法如下:


1、是指硬盘物理序列号,格式化没有变化。

2、支持vista 及win10系统。

3、支持多块硬盘(有的电脑装有几块硬盘)

4、支持串口及并口硬盘。

5、最好是源码或dll 等,代码如下:

'-------------------添加类模块clsMainInfo-------------------------

Option Explicit

Private Const VER_PLATFORM_WIN32S = 0

Private Const VER_PLATFORM_WIN32_WINDOWS = 1

Private Const VER_PLATFORM_WIN32_NT = 2

Private Const DFP_RECEIVE_DRIVE_DATA = &H7C088

Private Const FILE_SHARE_READ = &H1

Private Const FILE_SHARE_WRITE = &H2

Private Const GENERIC_READ = &H80000000

Private Const GENERIC_WRITE = &H40000000

Private Const OPEN_EXISTING = 3

Private Const Create_NEW = 1

Private Enum HDINFO

    HD_MODEL_NUMBER

    HD_SERIAL_NUMBER

    HD_FIRMWARE_REVISION

End Enum

Private Type OSVERSIONINFO

    dwOSVersionInfoSize As Long

    dwMajorVersion As Long

    dwMinorVersion As Long

    dwBuildNumber As Long

    dwPlatformId As Long

    szCSDVersion As String * 128

End Type 

Private Type IDEREGS

    bFeaturesReg As Byte

    bSectorCountReg As Byte

    bSectorNumberReg As Byte

    bCylLowReg As Byte

    bCylHighReg As Byte

    bDriveHeadReg As Byte

    bCommandReg As Byte

    bReserved As Byte

End Type

Private Type SENDCMDINPARAMS

    cBufferSize As Long

    irDriveRegs As IDEREGS

    bDriveNumber As Byte

    bReserved(1 To 3) As Byte

    dwReserved(1 To 4) As Long

End Type 

Private Type DRIVERSTATUS

    bDriveError As Byte

    bIDEStatus As Byte

    bReserved(1 To 2) As Byte

    dwReserved(1 To 2) As Long

End Type 

Private Type SENDCMDOUTPARAMS

    cBufferSize As Long

    DStatus As DRIVERSTATUS

    bBuffer(1 To 512) As Byte

End Type 

Private Declare Function GetVersionEx _

    Lib "kernel32" Alias "GetVersionExA" _

    (lpVersionInformation As OSVERSIONINFO) As Long 

Private Declare Function CreateFile _

    Lib "kernel32" Alias "CreateFileA" _

    (ByVal lpFileName As String, _

    ByVal dwDesiredAccess As Long, _

    ByVal dwShareMode As Long, _

    ByVal lpSecurityAttributes As Long, _

    ByVal dwCreationDisposition As Long, _

    ByVal dwFlagsAndAttributes As Long, _

    ByVal hTemplateFile As Long) As Long 

Private Declare Function CloseHandle _

    Lib "kernel32" _

    (ByVal hObject As Long) As Long

Private Declare Function DeviceIoControl _

    Lib "kernel32" _

    (ByVal hDevice As Long, _

    ByVal dwIoControlCode As Long, _

    lpInBuffer As Any, _

    ByVal nInBufferSize As Long, _

    lpOutBuffer As Any, _

    ByVal nOutBufferSize As Long, _

    lpBytesReturned As Long, _

    ByVal lpOverlapped As Long) As Long

Private Declare Sub ZeroMemory _

    Lib "kernel32" Alias "RtlZeroMemory" _

    (dest As Any, _

    ByVal numBytes As Long)

Private Declare Sub CopyMemory _

    Lib "kernel32" Alias "RtlMoveMemory" _

    (Destination As Any, _

    Source As Any, _

    ByVal Length As Long)

Private Declare Function GetLastError _

    Lib "kernel32" () As Long

Private mvarCurrentDrive As Byte

Private mvarPlatform As String

Public Function GetModelNumber() As String

    GetModelNumber = CmnGetHDData(HD_MODEL_NUMBER)

End Function 

Public Function GetSerialNumber() As String

    GetSerialNumber = CmnGetHDData(HD_SERIAL_NUMBER)

End Function 

Public Function GetFirmwareRevision() As String

    GetFirmwareRevision = CmnGetHDData(HD_FIRMWARE_REVISION)

End Function

Public Property Let CurrentDrive(ByVal vData As Byte)

    If vData < 0 Or vData > 3 Then

        Err.Raise 10000, , "Illegal Drive Number"

    End If

    mvarCurrentDrive = vData

End Property

Public Property Get CurrentDrive() As Byte

    CurrentDrive = mvarCurrentDrive

End Property

Public Property Get Platform() As String

    Platform = mvarPlatform

End Property

Private Sub Class_Initialize()

    Dim OS As OSVERSIONINFO

    OS.dwOSVersionInfoSize = Len(OS)

    Call GetVersionEx(OS)

    mvarPlatform = "Unk"

    Select Case OS.dwPlatformId

        Case Is = VER_PLATFORM_WIN32S

            mvarPlatform = "32S"

        Case Is = VER_PLATFORM_WIN32_WINDOWS

            If OS.dwMinorVersion = 0 Then

                mvarPlatform = "W95"

            Else

                mvarPlatform = "W98"

            End If

        Case Is = VER_PLATFORM_WIN32_NT

            mvarPlatform = "WNT"

    End Select

End Sub

Private Function CmnGetHDData(hdi As HDINFO) As String

    Dim bin As SENDCMDINPARAMS

    Dim bout As SENDCMDOUTPARAMS

    Dim hdh As Long

    Dim br As Long

    Dim ix As Long

    Dim hddfr As Long

    Dim hddln As Long

    Dim s As String

    Select Case hdi

        Case HD_MODEL_NUMBER

            hddfr = 55

            hddln = 40

        Case HD_SERIAL_NUMBER

            hddfr = 21

            hddln = 20

        Case HD_FIRMWARE_REVISION

            hddfr = 47

            hddln = 8

        Case Else

            Err.Raise 10001, "Illegal HD Data type"

    End Select

    Select Case mvarPlatform

        Case "WNT"

            hdh = CreateFile("\\.\PhysicalDrive" & mvarCurrentDrive, GENERIC_READ + GENERIC_WRITE, FILE_SHARE_READ + FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)

        Case "W95", "W98"

            hdh = CreateFile("\\.\Smartvsd", 0, 0, 0, Create_NEW, 0, 0)

        Case Else

            Err.Raise 10002, , "Illegal platform (only WNT, W98 or W95)"

    End Select

    If hdh = 0 Then

        Err.Raise 10003, , "Error on CreateFile"

    End If

    ZeroMemory bin, Len(bin)

    ZeroMemory bout, Len(bout)

    With bin

        .bDriveNumber = mvarCurrentDrive

        .cBufferSize = 512

        With .irDriveRegs

            If (mvarCurrentDrive And 1) Then

                .bDriveHeadReg = &HB0

            Else

                .bDriveHeadReg = &HA0

            End If

            .bCommandReg = &HEC

            .bSectorCountReg = 1

            .bSectorNumberReg = 1

        End With

    End With

    DeviceIoControl hdh, DFP_RECEIVE_DRIVE_DATA, bin, Len(bin), bout, Len(bout), br, 0

    s = vbNullString

    For ix = hddfr To hddfr + hddln - 1 Step 2

        If bout.bBuffer(ix + 1) = 0 Then Exit For

        s = s & Chr(bout.bBuffer(ix + 1))

        If bout.bBuffer(ix) = 0 Then Exit For

        s = s & Chr(bout.bBuffer(ix))

    Next ix

    CloseHandle hdh

    CmnGetHDData = Trim(s)

End Function

Option Explicit

'纯vb的获取硬盘序列号代码 (摘自枕善居)

'窗体放置1个ComBox,命名为cbDrive,1个ListBox,命名为lstMain,一个CommandButton,命名为cmdGo,添加如下代码

Dim h As clsMainInfo

Private Sub cmdGo_Click()

    Dim hT As Long

    Dim uW() As Byte

    Dim dW() As Byte

    Dim pW() As Byte 

    Set h = New clsMainInfo

    With h

        .CurrentDrive = Val(cbDrive.Text)

         lstMain.Clear

         lstMain.AddItem "当前驱动器: " & .CurrentDrive

         lstMain.AddItem ""

         lstMain.AddItem "硬盘型号: " & .GetModelNumber

         lstMain.AddItem "序列号: " & .GetSerialNumber

         lstMain.AddItem "固件版本: " & .GetFirmwareRevision

    End With

    Set h = Nothing

End Sub

Private Sub Form_Load()

    cbDrive.AddItem 0

    cbDrive.AddItem 1

    cbDrive.AddItem 2

    cbDrive.AddItem 3

    cbDrive.ListIndex = 0

End Sub

声明声明:本网页内容为用户发布,旨在传播知识,不代表本网认同其观点,若有侵权等问题请及时与本网联系,我们将在第一时间删除处理。E-MAIL:11247931@qq.com