[VBnet Disk/Drive] DeviceIoControl: Obtain Physical Drive Information

	Visual Basic Disk/Drive API Routines DeviceIoControl: Obtain Physical Drive Information

Posted:	Saturday January 8, 2000
Updated:	Monday December 26, 2011

Applies to:	VB4-32, VB5, VB6
Developed with:	VB6, Windows NT4
OS restrictions:	Windows NT4, Windows 2000, Windows XP
Author:	Thomas Kabir, VBnet - Randy Birch

Related:	DeviceIoControl: Check Media Availability DeviceIoControl: Load/Eject Removable Media DeviceIoControl: Lock/Unlock Removable Media Devices Win32_DiskDrive: WMI Disk Drive Information

Prerequisites

Windows NT, Windows 2000, Windows XP

Win NT/Win2000 developers have access to a unique API that provides low-level system information - DeviceIoControl.

This example succeeds only when it runs on Windows NT/Windows 2000/Windows XP, for two reasons:

The standard device input/output control codes are available only on Windows NT/2000/XP.
On Windows 95/98, an application must specify a virtual device driver in the CreateFile function—not a specific device.

On Windows NT/2000/XP, an application can use the DeviceIoControl function to perform direct input and output operations on, or retrieve information about, a floppy disk drive, hard disk drive, tape drive, or CD-ROM drive. This page demonstrates how to retrieve information about the installed physical drives on the system. It uses the CreateFile function to obtain a device handle to the physical drives, and then uses DeviceIoControl with the IOCTL_DISK_GET_DRIVE_GEOMETRY control code to fill a DISK_GEOMETRY structure with information about the drive.

The IOCTL_DISK_GET_DRIVE_GEOMETRY control code returns information about the physical disk's geometry: type, number of cylinders, tracks per cylinder, sectors per track, and bytes per sector. The DISK_GEOMETRY structure describes the geometry of disk devices and media. Note that the first parameter of the DISK_GEOMETRY type is defined as a LARGE_INTEGER, requiring the VB Currency data type to be used instead of a traditional Long.

This demo is based on code in Thomas Kabir's Physische Laufwerke demo,and is reproduced here with permission.

Note: The demo uses the VB6 FormatNumber function, which is not available in VB4-32 or VB5. Users of these versions should use Format$() instead, i.e. Format$(value, "###,###,###).

BAS Module Code

Place the following code into the general declarations area of a bas module:

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Const MAX_PATH As Long = 260
Public Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
Public Const FORMAT_MESSAGE_IGNORE_INSERTS As Long = &H200
Public Const FILE_SHARE_READ As Long = &H1
Public Const FILE_SHARE_WRITE As Long = &H2
Public Const OPEN_EXISTING As Long = 3
Public Const INVALID_HANDLE_VALUE As Long = -1
Public Const ERROR_FILE_NOT_FOUND As Long = 2
Public Const IOCTL_DISK_GET_DRIVE_GEOMETRY As Long = &H70000

'media type constants
Public Const unknown As Long = 0
Public Const F5_1Pt2_512 As Long = 1
Public Const F3_1Pt44_512 As Long = 2
Public Const F3_2Pt88_512 As Long = 3
Public Const F3_20Pt8_512 As Long = 4
Public Const F3_720_512 As Long = 5
Public Const F5_360_512 As Long = 6
Public Const F5_320_512 As Long = 7
Public Const F5_320_1024 As Long = 8
Public Const F5_180_512 As Long = 9
Public Const F5_160_512 As Long = 10
Public Const Removable As Long = 11
Public Const FixedMedia As Long = 12
Public Const F3_120M_512 As Long = 13
Public Const F3_640_512 As Long = 14
Public Const F5_640_512 As Long = 15
Public Const F5_720_512 As Long = 16
Public Const F3_1Pt2_512 As Long = 17
Public Const F3_1Pt23_1024 As Long = 18
Public Const F5_1Pt23_1024 As Long = 19
Public Const F3_128Mb_512 As Long = 20
Public Const F3_230Mb_512 As Long = 21
Public Const F8_256_128 As Long = 22
Public Const F3_200Mb_512 As Long = 23
Public Const F3_240M_512 As Long = 24
Public Const F3_32M_512 As Long = 25

Public Type DISK_GEOMETRY
   Cylinders         As Currency  'LARGE_INTEGER (8 bytes)
   MediaType         As Long
   TracksPerCylinder As Long
   SectorsPerTrack   As Long
   BytesPerSector    As Long
End Type

Public Declare Function FormatMessage Lib "kernel32" _
     Alias "FormatMessageA" _
    (ByVal dwFlags As Long, _
     lpSource As Long, _
     ByVal dwMessageId As Long, _
     ByVal dwLanguageId As Long, _
     ByVal lpBuffer As String, _
     ByVal nSize As Long, _
     Arguments As Any) As Long

Public Declare Function CreateFile Lib "kernel32" _
   Alias "CreateFileA" _
  (ByVal lpFileName As String, _
   ByVal dwDesiredAccess As Long, _
   ByVal dwShareMode As Long, _
   ByVal lpSecurityAttributes As Any, _
   ByVal dwCreationDisposition As Long, _
   ByVal dwFlagsAndAttributes As Long, _
   ByVal hTemplateFile As Long) As Long
    
Public Declare Function CloseHandle Lib "kernel32" _
   (ByVal hObject As Long) As Long

Public 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 Any) As Long


Public Function GetDiskSizeString(dg As DISK_GEOMETRY) As String
  
   Dim nCapacity As Variant
                   
   With dg
     'Determine the disk capacity by multiplying
     'the returned values. Because Cylinders is
     'declared as Currency, it must be multiplied
     'by 10,000 to eliminate the decimal.
      nCapacity = (.Cylinders * 10000) * _
                   .TracksPerCylinder * _
                   .SectorsPerTrack * _
                   .BytesPerSector
   End With

  'Return a string representing the
  'drive size to three decimal places.
  'Note: FormatNumber is VB6-specific;  
  'if you use VB4-32 or VB5 use Format$
   Select Case nCapacity
   
      Case Is < (2 ^ 20):
         GetDiskSizeString = FormatNumber(nCapacity / 2 ^ 10, 3) & " KB"
       
      Case Is < (2 ^ 30)
         GetDiskSizeString = FormatNumber(nCapacity / 2 ^ 20, 3) & " MB"
       
      Case Is < (2 ^ 40)
         GetDiskSizeString = FormatNumber(nCapacity / 2 ^ 30, 3) & " GB"
       
      Case Else
         GetDiskSizeString = FormatNumber(nCapacity / 2 ^ 40, 3) & " TB"
   End Select

End Function


Public Function GetDiskGeometry(hDevice As Long) As DISK_GEOMETRY
    
   Dim bytesReturned As Long

  'Another handle check!
   If hDevice <> INVALID_HANDLE_VALUE Then
        
       'Call the function. The returned
       'information is passed directly
       'to the return value of this function.
        DeviceIoControl hDevice, _
                        IOCTL_DISK_GET_DRIVE_GEOMETRY, _
                        ByVal 0&, _
                        0&, _
                        GetDiskGeometry, _
                        Len(GetDiskGeometry), _
                        bytesReturned, _
                        ByVal 0&    
    End If
    
End Function


Public Function GetMediaType(MediaType As Long) As String

   Select Case MediaType
      Case 0: GetMediaType = "Format unknown"
      Case F5_1Pt2_512:  GetMediaType = "5.25, 1.2MB, 512 bytes/sector"
      Case F3_1Pt44_512: GetMediaType = "3.5, 1.44MB, 512 bytes/sector"
      Case F3_2Pt88_512: GetMediaType = "3.5, 2.88MB, 512 bytes/sector"
      Case F3_20Pt8_512: GetMediaType = "3.5, 20.8MB, 512 bytes/sector"
      Case F3_720_512:   GetMediaType = "3.5, 720KB, 512 bytes/sector"
      Case F5_360_512:   GetMediaType = "5.25, 360KB, 512 bytes/sector"
      Case F5_320_512:   GetMediaType = "5.25, 320KB, 512 bytes/sector"
      Case F5_320_1024:  GetMediaType = "5.25, 320KB, 1024 bytes/sector"
      Case F5_180_512:   GetMediaType = "5.25, 180KB, 512 bytes/sector"
      Case F5_160_512:   GetMediaType = "5.25, 160KB, 512 bytes/sector"
      Case Removable:    GetMediaType = "Removable media other than floppy"
      Case FixedMedia:   GetMediaType = "Fixed hard disk"
  
      Case F3_120M_512: GetMediaType = "3.5, 120M Floppy"
      Case F3_640_512: GetMediaType = "3.5, 640KB, 512 bytes/sector"
      Case F5_640_512: GetMediaType = "5.25, 640KB, 512 bytes/sector"
      Case F5_720_512: GetMediaType = "5.25, 720KB, 512 bytes/sector"
      Case F3_1Pt2_512: GetMediaType = "3.5, 1.2Mb, 512 bytes/sector"
      Case F3_1Pt23_1024: GetMediaType = "3.5, 1.23Mb, 1024 bytes/sector"
      Case F5_1Pt23_1024: GetMediaType = "5.25, 1.23MB, 1024 bytes/sector"
      Case F3_128Mb_512: GetMediaType = "3.5 MO 128Mb, 512 bytes/sector"
      Case F3_230Mb_512: GetMediaType = "3.5 MO 230Mb, 512 bytes/sector"
      Case F8_256_128: GetMediaType = "8, 256KB, 128 bytes/sector"
      Case F3_200Mb_512: GetMediaType = "3.5, 200M Floppy (HiFD)"
      Case F3_240M_512: GetMediaType = "3.5, 240Mb Floppy (HiFD)"
      Case F3_32M_512: GetMediaType = "3.5, 32Mb Floppy"
   End Select

End Function


Public Function GetSystemMessage(msgID As Long) As String
    
   Dim ret As Long
   Dim sBuff As String
    
   sBuff = Space(256)
    
   ret = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM _
                       Or FORMAT_MESSAGE_IGNORE_INSERTS, _
                       0&, msgID, _
                       0, sBuff, Len(sBuff), ByVal 0)
        
   If (ret <> 0) Then
      GetSystemMessage = Left(sBuff, ret)
   Else
      GetSystemMessage = "unknown error"
   End If
    
End Function

Form Code

Add a listview (ListView1) and a command button to a form. To the listview, add seven column headers as shown above, and set the style to report mode. Add the following to the form:

Option Explicit

Private Sub Command1_Click()

   GetPhysicalDrives

End Sub


Private Sub GetPhysicalDrives()

   Dim hDevice As Long
   Dim dg As DISK_GEOMETRY
   Dim nCapacity As Variant
   Dim nDevice As Long
    
   Do
      
     'Attempt to obtain a handle to the device
     'that is to perform the operation, in this
     'case physical drive n. The first drive
     'is 0, second drive is 1 etc.
     '
     'hDevice will return INVALID_HANDLE_VALUE
     'when no more physical drives are located.
      hDevice = CreateFile("\\.\PHYSICALDRIVE" & CStr(nDevice), _
                            0&, _
                            FILE_SHARE_READ Or FILE_SHARE_WRITE, _
                            ByVal 0&, _
                            OPEN_EXISTING, _
                            0&, 0&)
            
     
     'If a valid handle, pass that to
     'obtain the physical disk geometry
      If hDevice <> INVALID_HANDLE_VALUE Then
            
        'Obtain the DISK_GEOMETRY type information
        'and determine the disk capacity
         dg = GetDiskGeometry(hDevice)
         
        'Add data to the listview
         LVAdd nDevice, dg
         
        'Close the device handle and
        'increment the device number count.
         CloseHandle hDevice
         nDevice = nDevice + 1
            
      Else
      
        'hDevice was invalid, so determine the error
         If Err.LastDllError = ERROR_FILE_NOT_FOUND Then
         
           'No more physical drives.
            Exit Do
         
         Else
         
           'This should never fire!
            MsgBox "GetPhysicalDrives error:" & vbCrLf & _
                    GetSystemMessage(Err.LastDllError), vbCritical
            Exit Do
            
         End If

      End If
        
   Loop
    
End Sub


Private Sub LVAdd(nDevice As Long, dg As DISK_GEOMETRY)

   Dim itmX As ListItem
                
   Set itmX = ListView1.ListItems.Add(, , "Drive " & nDevice)
   
   itmX.SubItems(1) = GetDiskSizeString(dg)      'size in KB, MB, GB, TB
   itmX.SubItems(2) = CStr(dg.Cylinders * 10000)
   itmX.SubItems(3) = CStr(dg.TracksPerCylinder)
   itmX.SubItems(4) = CStr(dg.SectorsPerTrack)
   itmX.SubItems(5) = CStr(dg.BytesPerSector)
   itmX.SubItems(6) = GetMediaType(dg.MediaType) 'media type, i.e. fixed
   
End Sub

Comments

PayPal Link