LOGO OA教程 ERP教程 模切知识交流 PMS教程 CRM教程 开发文档 其他文档  
 
网站管理员

真正获取硬盘序号和型号及固件版本

admin
2013年11月14日 22:12 本文热度 5641

 

建窗体,窗体放置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


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

Option Explicit

Private Const VER_PLATFORM_WIN32S [color=#0000ff]=
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

该文章在 2013/11/14 22:12:18 编辑过
关键字查询
相关文章
正在查询...
点晴ERP是一款针对中小制造业的专业生产管理软件系统,系统成熟度和易用性得到了国内大量中小企业的青睐。
点晴PMS码头管理系统主要针对港口码头集装箱与散货日常运作、调度、堆场、车队、财务费用、相关报表等业务管理,结合码头的业务特点,围绕调度、堆场作业而开发的。集技术的先进性、管理的有效性于一体,是物流码头及其他港口类企业的高效ERP管理信息系统。
点晴WMS仓储管理系统提供了货物产品管理,销售管理,采购管理,仓储管理,仓库管理,保质期管理,货位管理,库位管理,生产管理,WMS管理系统,标签打印,条形码,二维码管理,批号管理软件。
点晴免费OA是一款软件和通用服务都免费,不限功能、不限时间、不限用户的免费OA协同办公管理系统。
Copyright 2010-2024 ClickSun All Rights Reserved