Source code for Issue Number 70

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. 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

Code of the Week Home

Source Code

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

Public Sub InitializeDevice()
    CloseAll
    SetupCDPlayer
    SetTimeFormat tf_tmsf
End Sub

Private Sub SetupCDPlayer()
    mciSendString "OPEN CDAUDIO ALIAS CD WAIT SHAREABLE", 0, 0, 0
End Sub

Public Sub CloseAll()
    mciSendString "CLOSE ALL", 0, 0, 0
End Sub

Private Sub SetTimeFormat(eTimeFormat As enumTimeFormat)
    Select Case eTimeFormat
        Case tf_tmsf
            mciSendString "set cd time format tmsf wait", 0, 0, 0
        Case tf_milliseconds
            mciSendString "set cd time format milliseconds", 0, 0, 0
    End Select
End Sub

Public Sub Play(Optional lStartTrack As Long = 0, Optional lFinishTrack As Long = 0)
    If lStartTrack = 0 And lFinishTrack = 0 Then
        mciSendString "play cd", 0, 0, 0
    Else
        If lStartTrack <> 0 And lFinishTrack = 0 Then
            mciSendString "play cd from " & lStartTrack & " to " & TrackCount, 0, 0, 0
        Else
            mciSendString "play cd from " & lStartTrack & " to " & lFinishTrack, 0, 0, 0
        End If
    End If
End Sub

Public Sub StopNow()  ' Stop is a reserved word so we used StopNow instead
    mciSendString "stop cd wait", 0, 0, 0
End Sub

Public Sub Pause()
    mciSendString "pause cd", 0, 0, 0
End Sub

Public Function IsMediaPresent() As Boolean
    Dim sRet As String

    sRet = String(50, " ")
    mciSendString "status cd media present", sRet, Len(sRet), 0
    IsMediaPresent = Trim(Left(sRet, 5))
End Function

Public Function TrackCount() As Long
    Dim sRet As String

    sRet = String(50, " ")
    mciSendString "status cd number of tracks wait", sRet, Len(sRet), 0
    TrackCount = CLng(Trim(sRet))
End Function