Option Explicit
Option Compare Database
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, ByRef lpInBuffer As Any, ByVal nInBufferSize As Long, ByRef lpOutBuffer As Any, ByVal nOutBufferSize As Long, ByRef lpBytesReturned As Long, ByVal lpOverlapped As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const OPEN_EXISTING = 3
Private Const INVALID_HANDLE_VALUE = -1&
Public Const DFP_GET_VERSION = &H74080
Public Const DFP_SEND_DRIVE_COMMAND = &H7C084
Public Const DFP_RECEIVE_DRIVE_DATA = &H7C088
Public Const IDE_ATAPI_IDENTIFY = &HA1
Public Const IDE_ATA_IDENTIFY = &HEC
Public Const IDENTIFY_BUFFER_SIZE = 512
Public 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.
dwReserved1 As Long ' For future use.
dwReserved2 As Long ' For future use.
dwReserved3 As Long ' For future use.
dwReserved4 As Long ' For future use.
End Type
Public 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
Public 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).
bReserved1 As Byte ' Reserved for future expansion.
bReserved2 As Byte ' Reserved for future expansion.
bReserved3 As Byte ' Reserved for future expansion.
dwReserved1 As Long ' For future use.
dwReserved2 As Long ' For future use.
dwReserved3 As Long ' For future use.
dwReserved4 As Long ' For future use.
bBuffer() As Byte ' Input buffer.
End Type
Public Type DRIVERSTATUS
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.
bReserved1 As Byte ' Reserved for future expansion.
bReserved2 As Byte ' Reserved for future expansion.
dwReserved1 As Long ' Reserved for future expansion.
dwReserved2 As Long ' Reserved for future expansion.
End Type
Public Type SENDCMDOUTPARAMS
cBufferSize As Long ' Size of bBuffer in bytes
inDriveStatus As DRIVERSTATUS ' Driver status structure.
bBuffer() As Byte ' Buffer of arbitrary length in which to store the data read from the // drive.
End Type
Public Enum vbDiskDataType
vbDriveModelNumber = 0
vbDriveSerialNumber = 1
vbDriveControllerRevisionNumber = 2
vbControllerBufferSize = 3
vbDriveType = 4
End Enum
Function ConvertToString(DiskData() As Byte, firstIndex As Long, lastIndex As Long) As String
Dim Index As Integer
Dim s As String
Index = firstIndex
While Index <= lastIndex
s = s + Chr(DiskData(Index + 1)) + Chr(DiskData(Index))
Index = Index + 2
Wend
ConvertToString = Trim(s)
End Function
Function GetDiskData(DataType As vbDiskDataType) As String
GetDiskData = ""
Dim hPhysicalDriveIOCTL As Long
hPhysicalDriveIOCTL = CreateFile("\\.\PhysicalDrive0", _
GENERIC_READ Or GENERIC_WRITE, _
FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, _
OPEN_EXISTING, 0, 0)
If hPhysicalDriveIOCTL <> INVALID_HANDLE_VALUE Then
Dim VersionParams As GETVERSIONOUTPARAMS
Dim cbBytesReturned As Long
If DeviceIoControl(hPhysicalDriveIOCTL, DFP_GET_VERSION, _
Null, 0, VersionParams, Len(VersionParams), cbBytesReturned, 0) <> 0 Then
If VersionParams.bIDEDeviceMap > 0 Then
Dim cmd_in As SENDCMDINPARAMS
Dim cmd_out As SENDCMDOUTPARAMS
Dim buf(Len(cmd_out) + IDENTIFY_BUFFER_SIZE - 1) As Byte
Dim bIDCmd As Byte
If (VersionParams.bIDEDeviceMap And &H10) = &H10 Then
bIDCmd = IDE_ATAPI_IDENTIFY
Else
bIDCmd = IDE_ATA_IDENTIFY
End If
cmd_in.cBufferSize = IDENTIFY_BUFFER_SIZE
cmd_in.irDriveRegs.bFeaturesReg = 0
cmd_in.irDriveRegs.bSectorCountReg = 1
cmd_in.irDriveRegs.bSectorNumberReg = 1
cmd_in.irDriveRegs.bCylLowReg = 0
cmd_in.irDriveRegs.bCylHighReg = 0
cmd_in.irDriveRegs.bDriveHeadReg = &HA0 ' 0xA0 | ((bDriveNum & 1) << 4);
cmd_in.irDriveRegs.bCommandReg = bIDCmd
cmd_in.bDriveNumber = 0 ' bDriveNum
cmd_in.cBufferSize = IDENTIFY_BUFFER_SIZE
cbBytesReturned = 0
If DeviceIoControl(hPhysicalDriveIOCTL, DFP_RECEIVE_DRIVE_DATA, _
cmd_in, Len(cmd_in) - 1, buf(0), _
Len(cmd_out) + IDENTIFY_BUFFER_SIZE - 1, _
cbBytesReturned, 0) <> 0 Then
If DataType = vbDriveModelNumber Then GetDiskData = ConvertToString(buf, 70, 108)
If DataType = vbDriveSerialNumber Then GetDiskData = ConvertToString(buf, 36, 54)
If DataType = vbDriveControllerRevisionNumber Then GetDiskData = ConvertToString(buf, 62, 68)
If DataType = vbControllerBufferSize Then GetDiskData = Str((CLng(buf(58)) + CLng(buf(59)) * 256) * 512)
If DataType = vbDriveType Then
If (buf(16) And &H80) = &H80 Then
GetDiskData = "Removable"
ElseIf (buf(16) And &H40 = &H40) Then
GetDiskData = "Fixed"
Else
GetDiskData = "Unknown"
End If
End If
End If
End If
End If
CloseHandle hPhysicalDriveIOCTL
End If
End Function