- 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