InfoCD

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

form add 2 command buttons (cmdDriveInfoand cmdEnd) 
and a label (Label1)

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

form add 2 command buttons (cmdDriveInfoand cmdEnd)
and a label (Label1)