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

转载于:https://www.cnblogs.com/eyye/archive/2009/08/01/1536322.html