Visual Basic Disk/Drive API Routines
DeviceIoControl: Determine Media Type for CD/DVD Drives
Posted:   Sunday August 29, 2004
Updated:   Monday December 26, 2011
Applies to:   VB4-32, VB5, VB6
Developed with:   VB4-32, Windows XP
OS restrictions:   Windows XP or later
Author:   VBnet - Randy Birch, Norm Cook
Related:   GetDriveType: Enumerate and Identify Available System Drives
DeviceIoControl: Obtain Physical Drive Information
Windows XP or later to utilize the DeviceIoControl code in this demo.

GetDriveType: Enumerate and Identify Available System Drives showed how to enumerate local drives and determine their type. One limitation of GetDriveType used in that demo is it does not differentiate between different types of optical drives - both CD and DVD drives are identified as DRIVE_CDROM. In fact, as of Windows 2003 Windows DRIVE_* variables have not been expanded to more specifically identify new drive types that are now available.

This demo duplicates much of the functionality of the original GetDriveType demo, adding an additional test when DRIVE_CDROM is encountered to determine if the drive is a CD or a DVD. The workhorse behind this is DeviceIoControl, and as such this particular method is restricted to Windows XP or later, where the IOCTL_STORAGE_GET_MEDIA_TYPES_EX is supported. (There is also a IOCTL_STORAGE_GET_MEDIA_TYPES control code, however this takes a DISK_GEOMETRY structure to return physical characteristics of the drive; for the media type returned provides as limited information as GetDriveType (DeviceIoControl: Obtain Physical Drive Information).

Like the GetDriveType demo the code shown here provides two ways of calling the functions customized for VB6 or pre-VB6 apps.  The end result of both set of routines is exactly the same, as shown.

Note that when GetDriveType() returns 5 (DRIVE_CDROM) further testing is performed to retrieve the DeviceIoControl media type for this drive. The values for the media type member returned through DeviceIoControl do not coincide with the values used by GetDriveType. Therefore - as the illustration shows - both removable disks (DRIVE_REMOVABLE) and CDs (DRIVE_CDROM) are identified as 2.

If you run this code on a pre-XP machine, both the CD and DVD will be identified as "Optical drive (CD or DVD)" in the report (same as the GetDriveType demo).

This code was based on a newsgroup post by Norm Cook.

 BAS Module Code

 Form Code
To a project form add 2 command buttons (Command1 and Command2) and a list box (List1). Labels are optional. Add the following to the form:

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.
Private Const VER_PLATFORM_WIN32_NT = 2

  OSVSize         As Long 
  dwVerMajor      As Long 
  dwVerMinor      As Long 
  dwBuildNumber   As Long 
  PlatformID      As Long
  szCSDVersion    As String * 128
End Type

Private Declare Function GetVersionEx Lib "kernel32" _
   Alias "GetVersionExA" _
  (lpVersionInformation As Any) As Long

Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const GENERIC_READ As Long = &H80000000
Private Const GENERIC_WRITE As Long = &H40000000
Private Const FILE_SHARE_READ As Long = &H1
Private Const FILE_SHARE_WRITE As Long = &H2
Private Const OPEN_EXISTING As Long = 3


Private Const FILE_DEVICE_CD_ROM As Long = &H2
Private Const FILE_DEVICE_DVD As Long = &H33

Private Const DRIVE_REMOVABLE As Long = 2
Private Const DRIVE_FIXED As Long = 3
Private Const DRIVE_REMOTE As Long = 4
Private Const DRIVE_CDROM As Long = 5
Private Const DRIVE_RAMDISK As Long = 6

 Cylinders As Double
 MediaType As Long
 TracksPerCylinder As Long
 SectorsPerTrack As Long
 BytesPerSector As Long
 NumberMediaSides As Long
 MediaCharacteristics As Long
End Type

 DeviceType As Long
 MediaInfoCount As Long
End Type

Private Declare Function GetDriveType Lib "kernel32" _
     Alias "GetDriveTypeA" _
    (ByVal nDrive As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" _
     Alias "GetLogicalDriveStringsA" _
    (ByVal nBufferLength As Long, _
     ByVal lpBuffer As String) As Long
Private Declare Function CreateFile Lib "kernel32" _
   Alias "CreateFileA" _
  (ByVal lpFileName As String, _
   ByVal dwDesiredAccess As Long, _
   ByVal dwShareMode As Long, _
   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 hDrive 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

Private Sub Form_Load()

   Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
   Command1.Caption = "Get Drive/Media Type (all VB versions)"
   Command2.Caption = "Get Drive/Media Type (VB6 only)"
End Sub

Private Sub Form_DblClick()

End Sub

Private Sub Command1_Click()

  'VB4-32 / VB5 / VB6-compatible code
   Dim sAllDrives As String
   Dim sDrive As String
   Dim nDrvType As Long
  'get the list of all drives
   sAllDrives = GetDriveString()
  'separate the drive to
  'retrieve the drive type
   Do Until sAllDrives = Chr$(0)
     'strip off one drive
      sDrive = StripNulls(sAllDrives)
     'the next line is not required for the
     'code (the same call is made in
     'GetDrvDesc), but is included
     'in order to show the drive type returned
     'values in the listbox for this demo
      nDrvType = GetDriveTypeEx(sDrive)

      List1.AddItem sDrive & vbTab & nDrvType & vbTab & GetDrvDesc(sDrive)
End Sub

Private Sub Command2_Click()


   Dim sAllDrives As String
   Dim nDrvType As Long
   Dim sDrives() As String
   Dim cnt As Long
  'get the list of all drives
   sAllDrives = GetDriveString()
  'Change nulls to spaces, then trim.
  'This is required as using Split()
  'with Chr$(0) alone adds two additional
  'entries to the array drives at the end
  'representing the terminating characters.
   sAllDrives = Replace$(sAllDrives, Chr$(0), Chr$(32))
   sDrives() = Split(Trim$(sAllDrives), Chr$(32))

   For cnt = LBound(sDrives) To UBound(sDrives)
     'the next line is not required for the
     'code (the same call is made in
     'GetDrvDesc), but is included
     'in order to show the drive type returned
     'values in the listbox for this demo
      nDrvType = GetDriveTypeEx(sDrives(cnt))

      List1.AddItem sDrives(cnt) & _
                    vbTab & _
                    nDrvType & _
                    vbTab & _

End Sub

Private Function GetDrvDesc(RootPathName As String) As String
  'Used by both demos
  'Passed is the drive to check.
  'Returned is the type of drive.
   Select Case GetDriveType(RootPathName)
      Case 0: GetDrvDesc = "The drive type cannot be determined"
      Case 1: GetDrvDesc = "The root directory does not exist"

          Select Case Left$(RootPathName, 1)
              Case "a", "b": GetDrvDesc = "Floppy drive"
              Case Else: GetDrvDesc = "Removable drive"
          End Select

      Case DRIVE_FIXED:   GetDrvDesc = "Hard drive; can not be removed"
      Case DRIVE_REMOTE:  GetDrvDesc = "Remote (network) drive"
      Case DRIVE_CDROM:
           'a default description in case
           'the call below fails
            GetDrvDesc = "Optical Drive (CD or DVD)"
            Select Case GetDriveTypeEx(RootPathName)
               Case FILE_DEVICE_CD_ROM: GetDrvDesc = "CD-ROM drive"
               Case FILE_DEVICE_DVD: GetDrvDesc = "DVD drive"
            End Select
      Case DRIVE_RAMDISK: GetDrvDesc = "RAM disk"
   End Select

End Function

Private Function GetDriveString() As String

  'Used by both demos
  'returns string of available
  'drives each separated by a null
   Dim sBuffer As String
  'possible 26 drives, three characters
  'each plus a trailing null for each
  'drive letter and a terminating null
  'for the string
   sBuffer = Space$((26 * 4) + 1)
   If GetLogicalDriveStrings(Len(sBuffer), sBuffer) Then

     'just trim off the trailing spaces
      GetDriveString = Trim$(sBuffer)
   End If

End Function

Public Function GetDriveTypeEx(sDrive As String) As Long

   Dim tmp As Long
  'initial test
   GetDriveTypeEx = GetDriveType(sDrive)

  'if the drive type returned indicates a
  'CD (DRIVE_CDROM) perform a DeviceIoControl
  'test to determine if a CD or a DVD.
   If GetDriveTypeEx = DRIVE_CDROMThen
     'obtain the DeviceIoControl media
     'code for the drive
      GetDriveTypeEx = GetMediaType(sDrive)
   End If  
End Function

Private Function GetMediaType(sDrive As String) As Long

   Dim hDrive As Long
   Dim status As Long
   Dim returned As Long
   Dim mynull As Long

  'test for os - IOCTL_STORAGE_GET_MEDIA_TYPES_EX is XP or later only!
   If IsWinXPPlus() Then
      sDrive = UnQualifyPath(sDrive)

     'get a handle to the drive
      hDrive = CreateFile("\\.\" & UCase$(sDrive), _
                           GENERIC_READ Or GENERIC_WRITE, _
                           FILE_SHARE_READ Or FILE_SHARE_WRITE, _
                           mynull, OPEN_EXISTING, 0, mynull)
      If hDrive <> INVALID_HANDLE_VALUE Then
         status = DeviceIoControl(hDrive, _
                                  IOCTL_STORAGE_GET_MEDIA_TYPES_EX, _
                                  mynull, _
                                  0, _
                                  gmt, _
                                  2048, _
                                  returned, _
                                  ByVal 0)
         If status <> 0 Then

            GetMediaType = gmt.DeviceType
         End If  'status
      End If  'hDrive
      CloseHandle hDrive
   End If  'IsWinXPPlus

End Function

Private Function IsWinXPPlus() As Boolean

  'returns True if running Windows XP or later

   osv.OSVSize = Len(osv)

   If GetVersionEx(osv) = 1 Then
      IsWinXPPlus = (osv.PlatformID = VER_PLATFORM_WIN32_NT) And _
                    (osv.dwVerMajor >= 5 And osv.dwVerMinor >= 1)

   End If

End Function

Private Function StripNulls(startstr As String) As String

  'Used by VB4-32 / VB5 / VB6 Command1 demo only
  'Take a string separated by Chr$(0)
  'and split off 1 item, shortening the
  'string so next item is ready for removal.
   Dim pos As Long

   pos = InStr(startstr$, Chr$(0))
   If pos Then
      StripNulls = Mid$(startstr, 1, pos - 1)
      startstr = Mid$(startstr, pos + 1, Len(startstr))
   End If

End Function

Private Function UnQualifyPath(sPath As String) As String
   If Len(sPath) > 0 Then
      sPath = Trim$(sPath)
      If Right$(sPath, 1) = "\" Then
         UnQualifyPath = Left$(sPath, Len(sPath) - 1)
         UnQualifyPath = sPath
      End If
      UnQualifyPath = ""
   End If
End Function
If you're not using VB6, remember to comment out or delete the code in Command2 to prevent compile errors.


PayPal Link
Make payments with PayPal - it's fast, free and secure!


Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy


Hit Counter