The CDController class will show you how to control your audio CD player with a few easy-to-call methods. This version of the class has much better error-checking and many more features.

Public Sub InitializeDevice()

InitializeDevice will setup the CD Player to play audio CDs.

Public Function IsMediaPresent() As Boolean

IsMediaPresent will return True if there is playable media in the CD drive otherwise it will return False.

Public Function TrackCount() As Long

TrackCount will return the number of tracks that are on the CD currently in the CD drive.

Public Sub CloseAll()

CloseAll will close any and all channels that the CDController class has opened. You should do this before terminating any program that uses the CDController class.

Public Sub Play(Optional lStartTrack As Long = 0, Optional lFinishTrack As Long = 0)
Public Sub Pause()
Public Sub StopNow()

Pause and StopNow work exactly like you would expect. We would have liked to use Stop for this method name, but it is a reserved word so we used StopNow instead.

Public Function TrackCount() As Long

Returns the number of tracks that are recorded on the CD currently loaded in the drive.

Public Property Get TrackNumber() As Long
Public Property Let TrackNumber(lTrack As Long)

The get property returns the track the CD is currently cued or playing from. The let property will change the track number to the track passed in lTrack. If the CD was playing it will continue to play after the track change.

Public Function Mode() As String

Returns the current state of the CD device. Possible values that can be returned are "not ready", "paused", "playing", and "stopped" values. Some devices can return the additional "open", "parked", "seeking" values.

Public Property Get Position() As String
Public Property Let Position(sPosition As String)

The get property returns the current cued or playing location of the CD device. The position is returned in the format specified with SetTimeFormat. The default for this class is tmsf which stands for tracks, minutes, seconds, and frames. This means that if the CD device is currently playing track two, the Position property might return 02:04:32:35 which would mean track 2 and 4 minutes 32 seconds and 35 frames into the track.

Public Property Get LengthOfDisc() As String

The length of the disc in the format specified by SetTimeFormat.

Public Function LengthOfTrack(lTrack As Long) As String

The length of the track specified by lTrack in the format specified by SetTimeFormat. This can be used to gather a list of tracks and the associated lengths.

Public Function IsPlaying() As Boolean

Returns True when a CD is playing and False otherwise.

Public Sub RewindTrack()

Rewinds a track to the start of the current track.

Public Sub SplitPosition(sPos As String, lTrack As Long, sTimeInto As String)

The below sample will show you how to open the CD device and start playing it. For a complete CD player sample, http://www.codeoftheweek.com/membersonly/bi/issue71 for a downloadable project.

    Dim CD As New CDController

    CD.InitializeDevice
    If CD.IsMediaPresent Then
        MsgBox "There are " & CD.TrackCount & " tracks on this CD."
        CD.Play
    End If
    CD.CloseAll

Just paste create a new class module and then paste this source code into it. You can name the module CDController.

'----------------------------------------------------------------------
'
'   Module Name:    CDController
'   Written By:     C&D Programming Corp.
'   Create Date:    1/99
'   Copyright:      Copyright 1999 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit

Private Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" _
            (ByVal dwError As Long, ByVal lpstrBuffer As String, _
                    ByVal uLength As Long) As Long

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
            (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
                    ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long


Public Enum enumTimeFormat
    tf_tmsf                 ' track/minute/second/frame
    tf_milliseconds
End Enum
'
'   Removes the trailing null from a string
'
Private Function RemoveNull(sData As String) As String
    sData = Trim(sData)
    If Len(sData) > 0 Then
        If Right(sData, 1) = vbNullChar Then
            sData = Left(sData, Len(sData) - 1)
        End If
    End If
    RemoveNull = sData
End Function
'
'   Retrieves the error string as defined in the multimedia library winmm.dll
'
Private Function ErrorString(lError As Long) As String
    Dim sBuf As String
    Dim lRet As Long
    ' pad out buffer
    sBuf = String(129, " ")
    lRet = mciGetErrorString(lError, sBuf, Len(sBuf))
    sBuf = Trim(sBuf)
    ' remove null terminator
    ErrorString = Left(sBuf, Len(sBuf) - 1)
End Function
'
'   Initializes the cd audio player
'
Public Sub InitializeDevice()
    CloseAll
    SetupCDPlayer
    SetTimeFormat tf_tmsf
End Sub
'
'   sets up an alias that is used in the other functions and routines in this class
'
Private Sub SetupCDPlayer()
    Dim lRet As Long

    lRet = mciSendString("open cdaudio alias cd wait shareable", 0, 0, 0)
    If lRet <> 0 Then
        Err.Raise 5, "SetupCDPlayer", ErrorString(lRet)
    End If
End Sub
'
'   closes all channels this class opened
'
Public Sub CloseAll()
    Dim lRet As Long
    lRet = mciSendString("close all", 0, 0, 0)
    If lRet <> 0 Then
        Err.Raise 5, "CloseAll", ErrorString(lRet)
    End If
End Sub
'
'   sets the appropriate time format for the cd audio device.  This routine will
'   determine how functions like Position return the information to the calling
'   routines.
'
Public Sub SetTimeFormat(eTimeFormat As enumTimeFormat)
    Dim lRet As Long
    Select Case eTimeFormat
        Case tf_tmsf
            lRet = mciSendString("set cd time format tmsf wait", 0, 0, 0)
        Case tf_milliseconds
            lRet = mciSendString("set cd time format milliseconds", 0, 0, 0)
    End Select
    If lRet <> 0 Then
        Err.Raise 5, "SetTimeFormat", ErrorString(lRet)
    End If
End Sub
'
'   Starts playing an audio CD.  You can optionally specify the start and finish track.
'   If no track numbers are specified it will play the entire cd.
'
Public Sub Play(Optional lStartTrack As Long = 0, Optional lFinishTrack As Long = 0)
    Dim lRet As Long

    If lStartTrack = 0 And lFinishTrack = 0 Then
        lRet = mciSendString("play cd", 0, 0, 0)
    Else
        If lStartTrack <> 0 And lFinishTrack = 0 Then
            lRet = mciSendString("play cd from " & lStartTrack & " to " & TrackCount, 0, 0, 0)
        Else
            lRet = mciSendString("play cd from " & lStartTrack & " to " & lFinishTrack, 0, 0, 0)
        End If
    End If
    If lRet <> 0 Then
        Err.Raise 5, "Play", ErrorString(lRet)
    End If
End Sub
'
'   Stops playing the CD.  We could not determine what exactly is different
'   between stop cd and pause cd (at least in our configuration).
'
Public Sub StopNow()  ' Stop is a reserved word so we used StopNow instead
    Dim lRet As Long

    lRet = mciSendString("stop cd wait", 0, 0, 0)
    If lRet <> 0 Then
        Err.Raise 5, "StopNow", ErrorString(lRet)
    End If
End Sub
'
'   Pauses playing the CD.  We could not determine what exactly is different
'   between stop cd and pause cd (at least in our configuration).
'
Public Sub Pause()
    Dim lRet As Long
    lRet = mciSendString("pause cd", 0, 0, 0)
    If lRet <> 0 Then
        Err.Raise 5, "Pause", ErrorString(lRet)
    End If
End Sub

'
'   Determines if there is any cd media present in the cd device.
'   Returns True or False
'
Public Function IsMediaPresent() As Boolean
    Dim sRet As String
    Dim lRet As Long

    sRet = String(50, " ")
    lRet = mciSendString("status cd media present", sRet, Len(sRet), 0)
    If lRet <> 0 Then
        Err.Raise 5, "IsMediaPresent", ErrorString(lRet)
    End If

    IsMediaPresent = Trim(Left(sRet, 5))
End Function

'
'   Returns the number of tracks on the cd media.  Data cd's usually
'   return 1 track and audio cd's will return the number of tracks defined
'   by the manufacturer.
'
Public Function TrackCount() As Long
    Dim sRet As String
    Dim lRet As Long

    sRet = String(50, " ")
    mciSendString "status cd number of tracks wait", sRet, Len(sRet), 0
    If lRet <> 0 Then
        Err.Raise 5, "TrackCount", ErrorString(lRet)
    End If
    TrackCount = CLng(Trim(sRet))
End Function

'
'   Retrieves the track number the cd device is currently playing or cued to
'   play.
'
Public Property Get TrackNumber() As Long
    Dim sRet As String
    Dim lRet As Long

    sRet = String(50, " ")
    mciSendString "status cd current track wait", sRet, Len(sRet), 0
    If lRet <> 0 Then
        Err.Raise 5, "CurrentTrack", ErrorString(lRet)
    End If
    TrackNumber = CLng(RemoveNull(sRet))
End Property

'
'   Sets the track number that the cd device is playing or cued to play.
'   If the cd was playing at the start of this call it will be playing at
'   the end of this call unless an error occurs.
'
Public Property Let TrackNumber(lTrack As Long)
    Dim lRet As Long
    Dim bWasPlaying As Boolean

    bWasPlaying = IsPlaying
    If bWasPlaying Then
        Pause
    End If
    lRet = mciSendString("seek cd to " & lTrack & " wait", 0, 0, 0)
    If lRet <> 0 And lRet <> 282 Then ' attempt to seek byond end of CD
        Err.Raise 5, "TrackNumber", ErrorString(lRet)
    End If
    If bWasPlaying Then
        Play
    End If
End Property

'
'   All devices can return the "not ready", "paused", "playing", and "stopped" values.
'   Some devices can return the additional "open", "parked", "recording", and
'   "seeking" values.
'
Public Function Mode() As String
    Dim sRet As String
    Dim lRet As Long

    sRet = String(50, " ")

    lRet = mciSendString("status cd mode wait", sRet, Len(sRet), 0)
    If lRet <> 0 Then
        Err.Raise 5, "Mode", ErrorString(lRet)
    End If
    Mode = RemoveNull(sRet)
End Function

'
'   Returns the current position of the cd device as set in SetTimeFormat
'
Public Property Get Position() As String
    Dim sRet As String
    Dim lRet As Long

    sRet = String(50, " ")
    lRet = mciSendString("status cd position wait", sRet, Len(sRet), 0)
    If lRet <> 0 Then
        Err.Raise 5, "Position", ErrorString(lRet)
    End If
    Position = RemoveNull(sRet)
End Property

'
'   Sets the position of the cd device using the time format specified in
'   SetTimeFormat
'
Public Property Let Position(sPosition As String)
    Dim lRet As Long

    lRet = mciSendString("seek cd to " & sPosition, 0, 0, 0)
    If lRet <> 0 Then
        Err.Raise 5, "Position", ErrorString(lRet)
    End If
End Property

'
'   Takes an tmsf format position string and converts it to the track number and
'   position into that track number.  A future version of this class will include
'   additional features to perform various mathematical functions on tmsf strings
'
Public Sub SplitPosition(sPos As String, lTrack As Long, sTimeInto As String)
    If InStr(sPos, ":") <> 0 Then
        lTrack = CLng(Left(sPos, 2))
        sTimeInto = Mid$(sPos, 4)
    Else
        sTimeInto = sPos
    End If
End Sub

'
'   Retrieves the length of the cd disc currently loaded in the time format
'   specified by SetTimeFormat
'
Public Property Get LengthOfDisc() As String
    Dim sRet As String
    Dim lRet As Long

    sRet = String(50, " ")
    lRet = mciSendString("status cd length wait", sRet, Len(sRet), 0)
    If lRet <> 0 Then
        Err.Raise 5, "LengthOfDisc", ErrorString(lRet)
    End If
    LengthOfDisc = RemoveNull(sRet)
End Property

'
'   Retrieves the length of the track specified by lTrack in the time format
'   specified by SetTimeFormat
'
Public Function LengthOfTrack(lTrack As Long) As String
    Dim sRet As String
    Dim lRet As Long

    sRet = String(50, " ")
    lRet = mciSendString("status cd length track " & lTrack & " wait", sRet, Len(sRet), 0)
    If lRet <> 0 Then
        Err.Raise 5, "LengthOfTrack", ErrorString(lRet)
    End If
    LengthOfTrack = RemoveNull(sRet)
End Function

'
'   Returns true if the cd is currently playing
'
Public Function IsPlaying() As Boolean
    IsPlaying = (Mode = "playing")
End Function

'
'   Begin playing the current track at the beginning
'
Public Sub RewindTrack()
    Dim lTrack As Long

    lTrack = TrackNumber
    If IsPlaying Then
        TrackNumber = lTrack
        Play
    Else
        TrackNumber = lTrack
    End If
End Sub

'
'   Loads a listbox with a listing of the available track on the currently
'   loaded cd.  This can be easily modified to work load information from a
'   database to show track names and stuff like that.  It might even be useful
'   to see this as a small user control that you can paste into your project.
'   If anybody wants to write that for publication, let us know at
'   publish@codeoftheweek.com
'
Public Sub FillTrackList(lst As ListBox)
    Dim lTracks As Long
    Dim lTrack As Long

    lTracks = TrackCount
    For lTrack = 1 To lTracks
        lst.AddItem lTrack & " - " & LengthOfTrack(lTrack)
    Next
End Sub