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

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  
      Do
    
        '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
   Else
      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