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