VB读取硬盘序列号

Private Const MAX_IDE_DRIVES       As Long = 4
Private Const IDENTIFY_BUFFER_SIZE       As Long = 512
Private Const DFP_SEND_DRIVE_COMMAND       As Long = &H7C084
Private Const DFP_RECEIVE_DRIVE_DATA       As Long = &H7C088

Private Type GETVERSIONOUTPARAMS
        bVersion   As Byte                 '   Binary   driver   version.
        bRevision   As Byte               '   Binary   driver   revision.
        bReserved   As Byte               '   Not   used.
        bIDEDeviceMap   As Byte       '   Bit   map   of   IDE   devices.
        fCapabilities   As Long       '   Bit   mask   of   driver   capabilities.
        dwReserved(3)   As Long       '   For   future   use.
End Type
Private Type IDEREGS
        bFeaturesReg   As Byte                 '   Used   for   specifying   SMART   "commands".
        bSectorCountReg   As Byte           '   IDE   sector   count   register
        bSectorNumberReg   As Byte         '   IDE   sector   number   register
        bCylLowReg   As Byte                     '   IDE   low   order   cylinder   value
        bCylHighReg   As Byte                   '   IDE   high   order   cylinder   value
        bDriveHeadReg   As Byte               '   IDE   drive/head   register
        bCommandReg   As Byte                   '   Actual   IDE   command.
End Type

Private Type SENDCMDINPARAMS
        cBufferSize   As Long                   '   Buffer   size   in   bytes
        irDriveRegs   As IDEREGS             '   Structure   with   drive   register   values.
        bDriveNumber   As Byte                 '   Physical   drive   number   to   send
        bReserved(2)   As Byte                 '   Reserved   for   future   expansion.
        dwReserved(3)   As Long               '   For   future   use.
        bBuffer(0)   As Byte                     '   Input   buffer.
End Type
Private Const IDE_ATAPI_ID       As Long = &HA1           '   Returns   ID   sector   for   ATAPI.
Private Const IDE_ID_FUNCTION       As Long = &HEC           '   Returns   ID   sector   for   ATA.
Private Const IDE_EXECUTE_SMART_FUNCTION       As Long = &HB0           '   Performs   SMART   cmd.
Private Type DRIVERSTATUS
        bReserved(1)   As Byte                 '   Reserved   for   future   expansion.
        dwReserved(1)   As Long               '   Reserved   for   future   expansion.
End Type

Private Type SENDCMDOUTPARAMS
        cBufferSize   As Long                   '   Size   of   bBuffer   in   bytes
        drvStatus   As DRIVERSTATUS       '   Driver   status   structure.
        bBuffer(0)   As Byte                     '   Buffer   of   arbitrary   length   in   which   to   store   the   data   read   from   the                                                                                     '   drive.
End Type


Private Type ATTRTHRESHOLD
        bAttrID   As Byte                           '   Identifies   which   attribute
        bWarrantyThreshold   As Byte     '   Triggering   value
        bReserved(9)   As Byte               '   
End Type

Private Type IDSECTOR
        wGenConfig   As Integer
        wNumCyls   As Integer
        wReserved   As Integer
        wNumHeads   As Integer
        wBytesPerTrack   As Integer
        wBytesPerSector   As Integer
        wSectorsPerTrack   As Integer
        wVendorUnique(2)   As Integer
        sSerialNumber(19)   As Byte
        wBufferType   As Integer
        sFirmwareRev(7)   As Byte
        sModelNumber(39)   As Byte
End Type

Private Const VER_PLATFORM_WIN32s As Long = 0
Private Const VER_PLATFORM_WIN32_WINDOWS As Long = 1
Private Const VER_PLATFORM_WIN32_NT As Long = 2
Private Type OSVERSIONINFO
        dwOSVersionInfoSize   As Long
        dwMajorVersion   As Long
        dwMinorVersion   As Long
        dwBuildNumber   As Long
        dwPlatformId   As Long
        szCSDVersion   As String * 128                   '     Maintenance   string   for   PSS   usage
End Type

Private Declare Function GetVersionEx()Function GetVersionEx Lib "KERNEL32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Const GENERIC_READ       As Long = &H80000000
Private Const GENERIC_WRITE       As Long = &H40000000
Private Const OPEN_EXISTING         As Long = 3
Private Declare Function CreateFile()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 DeviceIoControl()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 CopyMemory()Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function CloseHandle()Function CloseHandle Lib "KERNEL32" (ByVal hObject As Long) As Long
Private m_DiskInfo As IDSECTOR

Private Function OpenSMART()Function OpenSMART(ByVal nDrive As Byte) As Long
      Dim hSMARTIOCTL&, hd$
      Dim VersionInfo     As OSVERSIONINFO
      VersionInfo.dwOSVersionInfoSize = Len(VersionInfo)
      GetVersionEx VersionInfo
      Select Case VersionInfo.dwPlatformId
            Case VER_PLATFORM_WIN32s
                  OpenSMART = hSMARTIOCTL
            Case VER_PLATFORM_WIN32_WINDOWS
                  hSMARTIOCTL = CreateFile("\\.\SMARTVSD", 0, 0, 0, CREATE_NEW, 0, 0)
            Case VER_PLATFORM_WIN32_NT
                  If nDrive < MAX_IDE_DRIVES Then
                        hd = "\\.\PhysicalDrive" & nDrive
                        hSMARTIOCTL = CreateFile(hd, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
                  End If
      End Select
      OpenSMART = hSMARTIOCTL
End Function

Private Function DoIDENTIFY()Function DoIDENTIFY(ByVal hSMARTIOCTL As Long, pSCIP As SENDCMDINPARAMS, pSCOP() As Byte, ByVal bIDCmd As Byte, ByVal bDriveNum As Byte, lpcbBytesReturned As Long) As Boolean
      pSCIP.irDriveRegs.bDriveHeadReg = &HA0 Or ((bDriveNum And 1) * 2 ^ 4)
      pSCIP.irDriveRegs.bCommandReg = bIDCmd
      pSCIP.bDriveNumber = bDriveNum
      DoIDENTIFY = CBool(DeviceIoControl(hSMARTIOCTL, DFP_RECEIVE_DRIVE_DATA, pSCIP, 32, pSCOP(0), 528, lpcbBytesReturned, 0))
End Function

Public Function GetDiskInfo()Function GetDiskInfo(ByVal nDrive As Byte) As Long
      Dim hSMARTIOCTL&, cbBytesReturned&
      Dim VersionParams     As GETVERSIONOUTPARAMS
      Dim scip     As SENDCMDINPARAMS
      Dim scop()     As Byte
      Dim OutCmd     As SENDCMDOUTPARAMS
      Dim bDfpDriveMap     As Byte
      Dim bIDCmd     As Byte                                           '   IDE   or   ATAPI   IDENTIFY   cmd
      Dim uDisk     As IDSECTOR
      m_DiskInfo = uDisk
      hSMARTIOCTL = OpenSMART(nDrive)
      If hSMARTIOCTL <> INVALID_HANDLE_VALUE Then
            Call DeviceIoControl(hSMARTIOCTL, DFP_GET_VERSION, ByVal 0, 0, VersionParams, Len(VersionParams), cbBytesReturned, 0)
            bIDCmd = IIf((VersionParams.bIDEDeviceMap \ 2 ^ nDrive And &H10), IDE_ATAPI_ID, IDE_ID_FUNCTION)
            ReDim scop(LenB(OutCmd) + IDENTIFY_BUFFER_SIZE - 1) As Byte
            If DoIDENTIFY(hSMARTIOCTL, scip, scop, bIDCmd, nDrive, cbBytesReturned) Then
                  CopyMemory m_DiskInfo, scop(LenB(OutCmd) - 4), LenB(m_DiskInfo)
                  CloseHandle hSMARTIOCTL
                  GetDiskInfo = 1
                  Exit Function
            End If
            CloseHandle hSMARTIOCTL
            GetDiskInfo = 0
      End If
End Function

Public Function GetHDlist()Function GetHDlist() As String
      If GetDiskInfo(0) = 1 Then
            GetHDlist = "硬盘物理系列号:" & Trim(StrConv(m_DiskInfo.sSerialNumber, vbUnicode))
            'GetHDlist = "硬盘型号:" & StrConv(m_DiskInfo.sModelNumber, vbUnicode)
      Else
        GetHDlist = "读取错误"
      End If
End Function