harddisk.bas

使用WMI读取硬盘信息

Attribute VB_Name = "HardDisk"
Option Explicit

'以下这一行是必须的，困为要做结构复制。而结构中有数组。所以，没有它则会错位
Option Base 0

Private Const DFP_GET_VERSION = &H74080
Private Const DFP_SEND_DRIVE_COMMAND = &H7C084
Private Const DFP_RECEIVE_DRIVE_DATA = &H7C088

'#pragma pack(1)
Private Type TGETVERSIONOUTPARAMS   '{
    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(4) As Long 'For future use.
End Type

Private Type TIDEREGS
    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 TSENDCMDINPARAMS
    cBufferSize As Long   'Buffer size in bytes
    irDriveRegs As TIDEREGS   '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.
    ''BYTE  bBuffer(1)   'Input buffer.
End Type

Private Type TDRIVERSTATUS
    bDriverError As Byte  'Error code from driver, 'or 0 if no error.
    bIDEStatus  As Byte  'Contents of IDE Error register.
           'Only valid when bDriverError 'is SMART_IDE_ERROR.
    bReserved(1) As Byte   'Reserved for future expansion.
    dwReserved(1) As Long   'Reserved for future expansion.
End Type

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

'下面的结构是要从另一结构复制数据过来的，所以，必须是字节数与VC的完全一致
'而不能用兼容变量，但这里的我们还是用了兼容变量，Integer,因为此结构中这一
'类型的的变量程序中没有用到，如果要用到，建议改为Byte类型。因为VB没有USHORT

Private Type TIDSECTOR
    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 Byte
End Type

'/*+++
'Global vars
'---*/
Private vers As TGETVERSIONOUTPARAMS
Private in_data As TSENDCMDINPARAMS
Private out_data As TSENDCMDOUTPARAMS
Private H As Long
Private i As Long
Private j As Byte

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 Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
          (lpVersionInformation As OSVERSIONINFO) As Long

Private Const VER_PLATFORM_WIN32S = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2

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 Const CREATE_NEW = 1
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2

Private Type OVERLAPPED
    Internal As Long
    InternalHigh As Long
    offset As Long
    OffsetHigh As Long
    hEvent As Long
End Type

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, lpOverlapped As OVERLAPPED) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
         hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)


Private Sub ChangeByteOrder(szString() As Byte, uscStrSize As Long)
    Dim i As Long
    Dim temp As String
     For i = 0 To uscStrSize - 1 Step 2
        temp = szString(i)
        szString(i) = szString(i + 1)
        szString(i + 1) = temp
     Next i
End Sub

Public Function GetAllHardDiskSerial() As String
    Dim HardDiskSerials() As String
    Dim rtn As String
    Dim i As Integer
    
    HardDiskSerials = HardDiskSerial()
    
    For i = LBound(HardDiskSerials) To UBound(HardDiskSerials)
        If i = LBound(HardDiskSerials) Then
            rtn = Trim(HardDiskSerials(i))
        Else
            If Trim(HardDiskSerials(i)) <> "" Then
                rtn = rtn & "^" & Trim(HardDiskSerials(i))
            End If
        End If
        
    Next
    
    GetAllHardDiskSerial = rtn
    
End Function

Private Function hdid9x() As String()
    
    Dim rtn(0 To 3) As String
    
    'We start in 95/98/Me
    H = CreateFile("\\.\Smartvsd", 0, 0, 0, CREATE_NEW, 0, 0)
    If H = 0 Then
'        hdid9x = "open smartvsd.vxd failed"
        Err.Raise 1101, "hdid9x", "open smartvsd.vxd failed"
    End If
    
    Dim olp As OVERLAPPED
    Dim lRet As Long
    lRet = DeviceIoControl(H, DFP_GET_VERSION, ByVal 0&, 0, vers, Len(vers), ByVal i, olp)
    If lRet = 0 Then
'            hdid9x = "DeviceIoControl failed:DFP_GET_VERSION"
            CloseHandle (H)
            Err.Raise 1101, "hdid9x", "DeviceIoControl failed:DFP_GET_VERSION"
    End If
    
    'If IDE identify command not supported, fails
    If (vers.fCapabilities And 1) <> 1 Then
'        hdid9x = "Error: IDE identify command not supported."
        CloseHandle (H)
        Err.Raise 1101, "hdid9x", "Error: IDE identify command not supported."
    End If
    
    'Display IDE drive number detected
    Dim sPreOutStr As String
    sPreOutStr = DetectIDE(vers.bIDEDeviceMap)
'    hdid9x = sPreOutStr
    
    'Identify the IDE drives
    For j = 0 To 3
        Dim phdinfo As TIDSECTOR
        Dim s(40) As Byte
        
        If (j And 1) = 1 Then
            in_data.irDriveRegs.bDriveHeadReg = &HB0
        Else
            in_data.irDriveRegs.bDriveHeadReg = &HA0
        End If
        If (vers.fCapabilities And (16 \ (2 ^ j))) = (16 \ (2 ^ j)) Then
            'We don't detect a ATAPI device.
'            hdid9x = "Drive " & CStr(j + 1) & " is a ATAPI device, we don't detect it"
             Err.Raise 1101, "hdid9x", "Drive " & CStr(j + 1) & " is a ATAPI device, we don't detect it"
        Else
              in_data.irDriveRegs.bCommandReg = &HEC
              in_data.bDriveNumber = j
              in_data.irDriveRegs.bSectorCountReg = 1
              in_data.irDriveRegs.bSectorNumberReg = 1
              in_data.cBufferSize = 512
              
              lRet = DeviceIoControl(H, DFP_RECEIVE_DRIVE_DATA, in_data, Len(in_data), out_data, Len(out_data), ByVal i, olp)
              
              If lRet = 0 Then
'                  hdid9x = "DeviceIoControl failed:DFP_RECEIVE_DRIVE_DATA"
                  CloseHandle (H)