真正获取硬盘序号和型号及固件版本
当前位置:点晴教程→知识管理交流
→『 技术文档交流 』
建窗体,窗体放置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 编辑过 |
关键字查询
相关文章
正在查询... |