InfoCDRom

Private Sub cmdEnd_Click()
    Unload Me
    End
End Sub

Private Sub cmdDriveInfo_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 JustOneDrive 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
    r& = GetLogicalDriveStrings(Len(allDrives$), allDrives$)
    '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)
        JustOneDrive$ = Left$(allDrives$, pos% - 1)
        
        'and remove that from the Alldrives string,
        'so it won't be checked again
        allDrives$ = Mid$(allDrives$, pos% + 1, Len(allDrives$))
        
        'with the one drive, call the API to
        'determine the drive type
        DriveType& = GetDriveType(JustOneDrive$)
        
        'check if it's 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(JustOneDrive$)
            
            'we're done for now, so get out
            Exit Do
            
        End If
    End If
    
    Loop Until allDrives$ = "" Or DriveType& = DRIVE_CDROM
    'display the appropriate message
    If CDfound Then
        Label2 = "The CD ROM drive on your system is drive " & UCase$(JustOneDrive$) & vbCrLf
        Label2 = Label2 & "The volume label is " & CDLabel$
    Else: Label2 = "No CD ROM drives were detected on your system."
    End If
    
End Sub

Private Function rgbGetVolumeLabel(CDPath$) As String
    'create working variables
    'to keep it simple, use dummy variables for info
    'we're not interested in right now
    Dim r As Long
    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
    r& = GetVolumeInformation(CDPath$, _
        DrvVolumeName$, _
        Len(DrvVolumeName$), _
        UnusedVal1&, UnusedVal2&, _
        UnusedVal3&, _
        UnusedStr$, Len(UnusedStr$))
    'error check
    If r& = 0 Then Exit Function
    '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 Function

This code demonstrates how to determine if a CD-ROM exists on 
the target system, and obtain information about it.
Start a new project, and to the form add 2 command buttons 
(cmdDriveInfo nd cmdEnd) and a label (Label1) as indicated in 
the illustration. Place the following API declare code into 
the general declarations area of a bas module:

Option Explicit
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 = 5
'Add the following code to Form1.

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

End Sub

Private Sub cmdEnd_Click()
Unload Me
End
End Sub

Private Sub cmdDriveInfo_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 JustOneDrive 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

r& = GetLogicalDriveStrings(Len(allDrives$), allDrives$)
'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)

JustOneDrive$ = Left$(allDrives$, pos% - 1)

'and remove that from the Alldrives string,

'so it won't be checked again

allDrives$ = Mid$(allDrives$, pos% + 1, Len(allDrives$))

'with the one drive, call the API to

'determine the drive type

DriveType& = GetDriveType(JustOneDrive$)

'check if it's 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(JustOneDrive$)

'we're done for now, so get out

Exit Do

End If
End If

Loop Until allDrives$ = "" Or DriveType& = DRIVE_CDROM
'display the appropriate message

If CDfound Then
Label2 = "The CD ROM drive on your system is drive " & UCase$(JustOneDrive$) & vbCrLf
Label2 = Label2 & "The volume label is " & CDLabel$
Else: Label2 = "No CD ROM drives were detected on your system."
End If

End Sub

Private Function rgbGetVolumeLabel(CDPath$) As String
'create working variables

'to keep it simple, use dummy variables for info

'we're not interested in right now

Dim r As Long
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

r& = GetVolumeInformation(CDPath$, _
DrvVolumeName$, _
Len(DrvVolumeName$), _
UnusedVal1&, UnusedVal2&, _
UnusedVal3&, _
UnusedStr$, Len(UnusedStr$))
'error check

If r& = 0 Then Exit Function
'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 Function

This code demonstrates how to determine if a CD-ROM exists on
the target system, and obtain information about it.
Start a new project, and to the form add 2 command buttons
(cmdDriveInfo nd cmdEnd) and a label (Label1) as indicated in
the illustration. Place the following API declare code into
the general declarations area of a bas module: