纯VB代码取得硬盘的物理序列号

    技术2025-04-15  39

    网上有很多获取硬盘序列号的代码,但大部分都只能取得逻辑分区的序列号,而不能取得硬盘的物理序列号。我们知道,逻辑分区的序列号是FORMAT时产生的,重新FORMAT将会改变。这对于要求唯一识别码的程式来说是致命的。这段代码利用API可以取得物理硬盘的很多特性,包括硬盘出厂时的唯一编号。这段代码我是从论坛获得,原作者不详。我将其稍做修改和增添,独立出两个常用的函数:GetDiskVolume 、GetHardDiskInfo  ......

    '============================================'模块功能: 取得硬盘的信息'编    程:来自互联网,阿勇修改'更新日期:2005/7/8'调用方法:'   GetDiskVolume() 取得逻辑盘的序列号'   GetHardDiskInfo() 取得物理盘的型号或序列号'============================================

    Private Const MAX_IDE_DRIVES As Long = 4   ' Max number of drives assuming primary/secondary, master/slave topologyPrivate Const READ_ATTRIBUTE_BUFFER_SIZE As Long = 512Private Const IDENTIFY_BUFFER_SIZE As Long = 512Private Const READ_THRESHOLD_BUFFER_SIZE As Long = 512Private Const DFP_GET_VERSION As Long = &H74080Private Const DFP_SEND_DRIVE_COMMAND As Long = &H7C084Private 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 Const CAP_IDE_ID_FUNCTION As Long = 1               ' ATA ID command supportedPrivate Const CAP_IDE_ATAPI_ID As Long = 2                  ' ATAPI ID command supportedPrivate Const CAP_IDE_EXECUTE_SMART_FUNCTION As Long = 4    ' SMART commannds supported

    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.    bReserved As Byte          ' reserved for future use.  Must be zero.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    ' command to (0,1,2,3).    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 Const SMART_CYL_LOW As Long = &H4FPrivate Const SMART_CYL_HI As Long = &HC2

    Private Type DRIVERSTATUS    bDriverError As Byte       ' Error code from driver,    bIDEStatus As Byte         ' Contents of IDE Error register.    bReserved(1) As Byte       ' Reserved for future expansion.    dwReserved(1) As Long      ' Reserved for future expansion.End Type

    Private Const SMART_NO_ERROR As Long = 0  ' No errorPrivate Const SMART_IDE_ERROR As Long = 1  ' Error from IDE controllerPrivate Const SMART_INVALID_FLAG As Long = 2  ' Invalid command flagPrivate Const SMART_INVALID_COMMAND As Long = 3  ' Invalid command bytePrivate Const SMART_INVALID_BUFFER As Long = 4  ' Bad buffer (null, invalid addr..)Private Const SMART_INVALID_DRIVE As Long = 5  ' Drive number not validPrivate Const SMART_INVALID_IOCTL As Long = 6   ' Invalid IOCTLPrivate Const SMART_ERROR_NO_MEM As Long = 7  ' Could not lock user's bufferPrivate Const SMART_INVALID_REGISTER As Long = 8  ' Some IDE Register not validPrivate Const SMART_NOT_SUPPORTED As Long = 9  ' Invalid cmd flag setPrivate Const SMART_NO_IDE_DEVICE As Long = 10 ' Cmd issued to device not present

    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 Const SMART_READ_ATTRIBUTE_VALUES As Long = &HD0    ' ATA4: RenamedPrivate Const SMART_READ_ATTRIBUTE_THRESHOLDS As Long = &HD1    ' Obsoleted in ATA4!Private Const SMART_ENABLE_DISABLE_ATTRIBUTE_AUTOSAVE As Long = &HD2Private Const SMART_SAVE_ATTRIBUTE_VALUES As Long = &HD3Private Const SMART_EXECUTE_OFFLINE_IMMEDIATE As Long = &HD4    ' ATA4Private Const SMART_ENABLE_SMART_OPERATIONS As Long = &HD8Private Const SMART_DISABLE_SMART_OPERATIONS As Long = &HD9Private Const SMART_RETURN_SMART_STATUS As Long = &HDA

    Private Type DRIVEATTRIBUTE    bAttrID As Byte        ' Identifies which attribute    wStatusFlags As Integer    ' see bit definitions below    bAttrValue As Byte     ' Current normalized value    bWorstValue As Byte    ' How bad has it ever been?    bRawValue(5) As Byte   ' Un-normalized value    bReserved As Byte      ' ...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    wBufferSize As Integer    wECCSize As Integer    sFirmwareRev(7) As Byte    sModelNumber(39) As Byte    wMoreVendorUnique As Integer    wDoubleWordIO As Integer    wCapabilities As Integer    wReserved1 As Integer    wPIOTiming As Integer    wDMATiming As Integer    wBS As Integer    wNumCurrentCyls As Integer    wNumCurrentHeads As Integer    wNumCurrentSectorsPerTrack As Integer    ulCurrentSectorCapacity(3) As Byte    '这里只能用byte,因为VB没有无符号的LONG型变量    wMultSectorStuff As Integer    ulTotalAddressableSectors(3) As Byte   '这里只能用byte,因为VB没有无符号的LONG型变量    wSingleWordDMA As Integer    wMultiWordDMA As Integer    bReserved(127) As ByteEnd Type

    Private Const ATTR_INVALID As Long = 0Private Const ATTR_READ_ERROR_RATE As Long = 1Private Const ATTR_THROUGHPUT_PERF As Long = 2Private Const ATTR_SPIN_UP_TIME As Long = 3Private Const ATTR_START_STOP_COUNT As Long = 4Private Const ATTR_REALLOC_SECTOR_COUNT As Long = 5Private Const ATTR_READ_CHANNEL_MARGIN As Long = 6Private Const ATTR_SEEK_ERROR_RATE As Long = 7Private Const ATTR_SEEK_TIME_PERF As Long = 8Private Const ATTR_POWER_ON_HRS_COUNT As Long = 9Private Const ATTR_SPIN_RETRY_COUNT As Long = 10Private Const ATTR_CALIBRATION_RETRY_COUNT As Long = 11Private Const ATTR_POWER_CYCLE_COUNT As Long = 12

    Private Const PRE_FAILURE_WARRANTY As Long = &H1Private Const ON_LINE_COLLECTION As Long = &H2Private Const PERFORMANCE_ATTRIBUTE As Long = &H4Private Const ERROR_RATE_ATTRIBUTE As Long = &H8Private Const EVENT_COUNT_ATTRIBUTE As Long = &H10Private Const SELF_PRESERVING_ATTRIBUTE As Long = &H20

    Private Const NUM_ATTRIBUTE_STRUCTS As Long = 30Private Const INVALID_HANDLE_VALUE As Long = -1

    Private Const VER_PLATFORM_WIN32s As Long = 0Private Const VER_PLATFORM_WIN32_WINDOWS As Long = 1Private 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 usageEnd Type

    Private Const CREATE_NEW As Long = 1Private Const GENERIC_READ As Long = &H80000000Private Const GENERIC_WRITE As Long = &H40000000Private Const FILE_SHARE_READ As Long = &H1Private Const FILE_SHARE_WRITE As Long = &H2Private Const OPEN_EXISTING  As Long = 3

    Private m_DiskInfo As IDSECTOR

    Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As LongPrivate 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 LongPrivate 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 LongPrivate Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

    Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long

    '信息类型枚举Enum eumInfoType    hdmodelsn = 0    hdOnlyModel = 1    hdOnlySN = 2End Enum

    '磁盘通道枚举Enum eumDiskNo    hdPrimaryMaster = 0    hdPrimarySlave = 1    hdSecondaryMaster = 2    hdSecondarySlave = 3End Enum

    '取得逻辑盘序列号 (非唯一)Function GetDiskVolume(Optional ByVal strDiskName = "C") As String    Dim TempStr1 As String * 256, TempStr2 As String * 256    Dim TempLon1 As Long, TempLon2 As Long, GetVal As Long        Dim tmpVol As String        Call GetVolumeInformation(strDiskName & ":/", TempStr1, 256, GetVal, TempLon1, TempLon2, TempStr2, 256)    If GetVal = 0 Then        tmpVol = ""    Else        tmpVol = Hex(GetVal)        tmpVol = String(8 - Len(tmpVol), "0") & tmpVol        tmpVol = Left(tmpVol, 4) & "-" & Right(tmpVol, 4)    End If    GetDiskVolume = tmpVolEnd Function

    '取得硬盘信息:型号/物理系列号(唯一)Function GetHardDiskInfo(Optional ByVal numDisk As eumDiskNo = hdPrimaryMaster, Optional ByVal numType As eumInfoType = hdOnlySN) As String

        If GetDiskInfo(numDisk) = 1 Then        Dim pSerialNumber As String, pModelNumber As String        pSerialNumber = StrConv(m_DiskInfo.sSerialNumber, vbUnicode)        pModelNumber = StrConv(m_DiskInfo.sModelNumber, vbUnicode)                Select Case numType            Case hdOnlyModel  '仅型号                GetHardDiskInfo = Trim(pModelNumber)            Case hdOnlySN  '仅系列号                GetHardDiskInfo = Trim(pSerialNumber)            Case Else   '型号,系列号                GetHardDiskInfo = Trim(pModelNumber) & "," & Trim(pSerialNumber)        End Select     End If

    End Function

    Private Function OpenSMART(ByVal nDrive As Byte) As Long  Dim hSMARTIOCTL As Long  Dim hd As String  Dim VersionInfo As OSVERSIONINFO

        hSMARTIOCTL = INVALID_HANDLE_VALUE    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(ByVal hSMARTIOCTL As Long, pSCIP As SENDCMDINPARAMS, pSCOP() As Byte, ByVal bIDCmd As Byte, ByVal bDriveNum As Byte, lpcbBytesReturned As Long) As Boolean    pSCIP.cBufferSize = IDENTIFY_BUFFER_SIZE

        pSCIP.irDriveRegs.bFeaturesReg = 0    pSCIP.irDriveRegs.bSectorCountReg = 1    pSCIP.irDriveRegs.bSectorNumberReg = 1    pSCIP.irDriveRegs.bCylLowReg = 0    pSCIP.irDriveRegs.bCylHighReg = 0

        pSCIP.irDriveRegs.bDriveHeadReg = &HA0 Or ((bDriveNum And 1) * 2 ^ 4)    '    pSCIP.irDriveRegs.bCommandReg = bIDCmd    pSCIP.bDriveNumber = bDriveNum    pSCIP.cBufferSize = IDENTIFY_BUFFER_SIZE   DoIDENTIFY = CBool(DeviceIoControl(hSMARTIOCTL, DFP_RECEIVE_DRIVE_DATA, _                 pSCIP, 32, _                 pSCOP(0), 528, _                 lpcbBytesReturned, 0))

    End Function

    Private Function DoEnableSMART(ByVal hSMARTIOCTL As Long, pSCIP As SENDCMDINPARAMS, pSCOP As SENDCMDOUTPARAMS, ByVal bDriveNum As Byte, lpcbBytesReturned As Long) As Boolean    pSCIP.cBufferSize = 0

        pSCIP.irDriveRegs.bFeaturesReg = SMART_ENABLE_SMART_OPERATIONS    pSCIP.irDriveRegs.bSectorCountReg = 1    pSCIP.irDriveRegs.bSectorNumberReg = 1    pSCIP.irDriveRegs.bCylLowReg = SMART_CYL_LOW    pSCIP.irDriveRegs.bCylHighReg = SMART_CYL_HI    pSCIP.irDriveRegs.bDriveHeadReg = &HA0 Or ((bDriveNum And 1) * 2 ^ 4)    pSCIP.irDriveRegs.bCommandReg = IDE_EXECUTE_SMART_FUNCTION    pSCIP.bDriveNumber = bDriveNum

        DoEnableSMART = CBool(DeviceIoControl(hSMARTIOCTL, DFP_SEND_DRIVE_COMMAND, _                    pSCIP, LenB(pSCIP) - 1, _                    pSCOP, LenB(pSCOP) - 1, _                    lpcbBytesReturned, 0))

    End Function

    '---------------------------------------------------------------------'---------------------------------------------------------------------Private Sub ChangeByteOrder(szString() As Byte, ByVal uscStrSize As Integer)

      Dim i As Integer  Dim bTemp As Byte

        For i = 0 To uscStrSize - 1 Step 2        bTemp = szString(i)        szString(i) = szString(i + 1)        szString(i + 1) = bTemp    Next i

    End Sub

    Private Sub DisplayIdInfo(pids As IDSECTOR, pSCIP As SENDCMDINPARAMS, ByVal bIDCmd As Byte, ByVal bDfpDriveMap As Byte, ByVal bDriveNum As Byte)

        ChangeByteOrder pids.sModelNumber, UBound(pids.sModelNumber) + 1

        ChangeByteOrder pids.sFirmwareRev, UBound(pids.sFirmwareRev) + 1

        ChangeByteOrder pids.sSerialNumber, UBound(pids.sSerialNumber) + 1

    End Sub

    Public Function GetDiskInfo(ByVal nDrive As Byte) As Long

      Dim hSMARTIOCTL As Long  Dim cbBytesReturned As Long  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)

            If Not (VersionParams.bIDEDeviceMap / 2 ^ nDrive And &H10) Then            If DoEnableSMART(hSMARTIOCTL, scip, OutCmd, nDrive, cbBytesReturned) Then                bDfpDriveMap = bDfpDriveMap Or 2 ^ nDrive            End If        End If        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)            Call DisplayIdInfo(m_DiskInfo, scip, bIDCmd, bDfpDriveMap, nDrive)            CloseHandle hSMARTIOCTL            GetDiskInfo = 1            Exit Function '>---> Bottom        End If        CloseHandle hSMARTIOCTL        GetDiskInfo = 0      Else 'NOT HSMARTIOCTL...        GetDiskInfo = -1    End If

    End Function

     

    本文来自博客,转载请标明出处:http://blog.csdn.net/yxtyxt3311/archive/2006/10/10/1328785.aspx

    最新回复(0)