Visual Basic Disk/Drive API Routines
GetDriveType: Identify a System's CD-ROM Drive
Posted:   Sunday January 26, 1997
Updated:   Monday December 26, 2011
Applies to:   VB4-32, VB5, VB6
Developed with:   VB4-32, Windows 95
OS restrictions:   None
Author:   VBnet - Randy Birch


GetDriveType: Identify a System's CD-ROM Drive
DeviceIoControl: Load/Eject Removable Media
DeviceIoControl: Lock/Unlock Removable Media Devices

This code demonstrates how to determine the first CD-ROM on the target system, and obtain information about it.
 BAS Module Code
Place the following API declare code into the general declarations area of a bas module. If this is a one-form project, the declares below could be placed into the general declaration section of the form instead, with all Public references changed to Private.

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 Declare Function GetLogicalDriveStrings Lib "kernel32" _
   Alias "GetLogicalDriveStringsA" _
  (ByVal nBufferLength As Long, _
   ByVal lpBuffer As String) As Long

Public Declare Function GetDriveType Lib "kernel32" _
   Alias "GetDriveTypeA" _
  (ByVal nDrive As String) As Long

Declare Function GetVolumeInformation Lib "kernel32" _
   Alias "GetVolumeInformationA" _
  (ByVal lpRootPathName As String, _
   ByVal lpVolumeNameBuffer As String, _
   ByVal nVolumeNameSize As Long, _
   lpVolumeSerialNumber As Long, _
   lpMaximumComponentLength As Long, _
   lpFileSystemFlags As Long, _
   ByVal lpFileSystemNameBuffer As String, _
   ByVal nFileSystemNameSize As Long) As Long

Public Const DRIVE_CDROM As Long = 5
 Form Code
To a project form add two command buttons (Command1 and Command2), and a label (Label1) as indicated in the illustration. Add the following to the form:

Option Explicit

Private Sub Form_Load()

   Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
End Sub

Private Sub Command2_Click()
   Unload Me
End Sub

Private Sub Command1_Click()

  'get the available drives, determine their type,
  'and if CD, get the CD volume label  
   Dim r As Long
   Dim DriveType As Long
   Dim allDrives As String
   Dim oneDrive As String
   Dim CDLabel As String
   Dim pos As Integer
   Dim CDfound As Boolean

  'pad the string with spaces  
   allDrives = Space$(64)

  'Call the API to get the string containing all drives.
  'The API will return 0 if none, or the length of 
  'the string returned in 'allDrives' if successful.   

   r = GetLogicalDriveStrings(Len(allDrives), allDrives) 

   If r > 0 then

     'trim off any trailing spaces. 'AllDrives'
     'now contains all the drive letters.  
      allDrives = Left$(allDrives, r)

     'begin a loop  
        'first check that there is a chr$(0) in the string  
         pos = InStr(allDrives, Chr$(0))
        'if there's one, then...  
         If pos Then
           'extract the drive up to the Chr$(0)  
            oneDrive = Left$(allDrives, pos - 1)
           'and remove that from the allDrives string,
           'so it won't be checked again  
            allDrives = Mid$(allDrives, pos + 1)
           'with the one drive, call the API to
           'determine the drive type  
            DriveType = GetDriveType(oneDrive)
           'check if it is what we want  
            If DriveType = DRIVE_CDROM Then
              'got it (or at least the first one,
              'anyway, if more than one), so set
              'the found flag... this part can be modified 
              'to continue searching remaining drives for 
              'those systems that might have more than 
              'one CD installed. 
               CDfound = True
               CDLabel = rgbGetVolumeLabel(oneDrive)
              'we're done for now, so get out  
               Exit Do
           End If
         End If
      Loop Until (allDrives = "") Or (DriveType = DRIVE_CDROM)

   End If

  'display the appropriate message  
   If CDfound Then
      Label1.Caption = "The CD ROM drive on your system is drive " _
               & UCase$(oneDrive) & vbCrLf _
               & "The volume label is " & CDLabel
      Label1.Caption = "No CD ROM drives were detected on your system."
  End If
End Sub

Private Function rgbGetVolumeLabel(CDPath As String) As String

  'create working variables
  'to keep it simple, use dummy variables for info
  'we're not interested in right now  
   Dim DrvVolumeName As String
   Dim pos As Integer
   Dim UnusedVal1 As Long
   Dim UnusedVal2 As Long
   Dim UnusedVal3 As Long
   Dim UnusedStr As String
   DrvVolumeName = Space$(14)
   UnusedStr = Space$(32)

  'do what it says  
   If GetVolumeInformation(CDPath, _
                            DrvVolumeName, _
                            Len(DrvVolumeName), _
                            UnusedVal1, UnusedVal2, _
                            UnusedVal3, _
                            UnusedStr, Len(UnusedStr)) > 0 Then

     'the volume label   
      pos = InStr(DrvVolumeName, Chr$(0))
      If pos Then DrvVolumeName = Left$(DrvVolumeName, pos - 1)
      If Len(Trim$(DrvVolumeName)) = 0 Then DrvVolumeName = "(no label)"
      rgbGetVolumeLabel = DrvVolumeName

   End If

End Function
If your system has a CD-ROM its drive assignment is displayed.  In addition, if the drive has a CD in it, its volume label will be displayed. The method could be easily modified to return all CD drives on a multiple-drive system if needed.


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