Build Your Own CD Player; a module of CD functions.

Category:

Multimedia/Games

Type:

Modules

Difficulty:

Advanced

Author: Anonymous

Version Compatibility: Visual Basic 6

More information:

This module of functions interacts with the MCI device to help provide the functions necessary to create your own Windows CD player.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
' (None)

Code:

'api to send the commands to the mci device
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
'api to check for mci success or error
Private Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long 'Get the error message of the mcidevice if any
'will hold the mci returned error value
Dim Error As Long
'buffer to hold our returned data
Dim TheStat As String * 128
'check the mci device for to see if a error occured
'and give description.
Public Function checkError() As String
    checkError = Space$(255)
    mciGetErrorString Error, checkError, Len(checkError)
End Function
'start the cdaudio mci device.
Public Function startCD()
    'need to call this function first
    Error = mciSendString("open cdaudio alias cd wait shareable", 0, 0, 0)
End Function
'start playing the cd
Public Function playCD()
    Error = mciSendString("play cd", 0, 0, 0)
End Function
'stop the cd from playing
Public Function stopCD()
    Error = mciSendString("stop cd", 0, 0, 0)
End Function
'close all alias's from the mci device
Public Function closeAll()
    Error = mciSendString("close all", 0, 0, 0)
End Function
'get the position in minutes, seconds, and frames
Public Function getPositionMSF() As String
    Error = mciSendString("set cd time format msf", 0, 0, 0)
    Error = mciSendString("status cd position", TheStat, 128, 0)
    getPositionMSF = TheStat
End Function
'get the position in milli-seconds
Public Function getPositionMS() As String
    Error = mciSendString("set cd time format ms", 0, 0, 0)
    Error = mciSendString("status cd position", TheStat, 128, 0)
    getPositionMS = TheStat
End Function
'get the position in tracks, minutes, seconds, and frames
Public Function getPositionTMSF() As String
    Error = mciSendString("set cd time format tmsf", 0, 0, 0)
    Error = mciSendString("status cd position", TheStat, 128, 0)
    getPositionTMSF = TheStat
End Function
'get the current time format
Public Function getTimeFormat() As String
    Error = mciSendString("status cd time format", TheStat, 128, 0)
    getTimeFormat = TheStat
End Function
'open the cd tray
Public Function setDoorOpen()
    Error = mciSendString("set cd door open", 0, 0, 0)
End Function
'close the cd tray
Public Function setDoorClosed()
    Error = mciSendString("set cd door closed", 0, 0, 0)
End Function
'get the total number of tracks on the cd
Public Function getNumberTracks() As Long
    On Error Resume Next
    Error = mciSendString("status cd number of tracks", TheStat, 128, 0)
    getNumberTracks = CLng(Trim$(TheStat))
End Function
'set the cd to play a specified track
Public Function setTrack(track As Long)
    Error = mciSendString("play cd from " & track, 0, 0, 0)
End Function
'pause the current track that is playing
Public Function pauseCD()
    Error = mciSendString("pause cd", 0, 0, 0)
End Function
'resume a paused track
Public Function resumeCD()
    Error = mciSendString("play cd", 0, 0, 0)
End Function
'fast forward a specified amount of seconds
Public Function fastForward(seconds As Long)
    Dim pos As String * 128
    Error = mciSendString("set cd time format ms", 0, 0, 0)
    Error = mciSendString("status cd position", pos, 128, 0)
    pos = CLng(Val(pos))
    If isPlaying = True Then
        Error = mciSendString("play cd from " & pos + seconds * 1000, 0, 0, 0)
    Else
        Error = mciSendString("seek cd to " & pos + seconds * 1000, 0, 0, 0)
    End If
End Function
'rewind a specified amount of seconds
Public Function fastRewind(seconds As Long)
    Dim pos As String * 128
    Error = mciSendString("set cd time format ms", 0, 0, 0)
    Error = mciSendString("status cd position", pos, 128, 0)
    pos = CLng(Val(pos))
    If isPlaying = True Then
        Error = mciSendString("play cd from " & pos - seconds * 1000, 0, 0, 0)
    Else
        Error = mciSendString("seek cd to " & pos - seconds * 1000, 0, 0, 0)
    End If
End Function
'check to see if the cd alias is playing
Public Function isPlaying() As Boolean
    Error = mciSendString("status cd mode", TheStat, 128, 0)
    If Left(TheStat, 7) = "playing" Then
        isPlaying = True
    Else
        isPlaying = False
    End If
End Function
'get the length of a track in milli-seconds
Public Function trackLengthMS(track As Long) As Long
    Error = mciSendString("set cd time format ms", 0, 0, 0)
    Error = mciSendString("status cd length track " & track, TheStat, 128, 0)
    trackLengthMS = Val(TheStat)
End Function
'get the length of the cd in milli-seconds
Public Function cdLengthMS() As Long
    Error = mciSendString("set cd time format ms", 0, 0, 0)
    Error = mciSendString("status cd length", TheStat, 128, 0)
    cdLengthMS = Val(TheStat)
End Function
Public Function cdLengthMSF() As String
    Error = mciSendString("set cd time format msf", 0, 0, 0)
    Error = mciSendString("status cd length", TheStat, 128, 0)
    cdLengthMSF = TheStat
End Function
Public Function trackLengthMSF(track As Long) As String
    Error = mciSendString("set cd time format msf", 0, 0, 0)
    Error = mciSendString("status cd length track " & track, TheStat, 128, 0)
    trackLengthMSF = TheStat
End Function
'set off the audio output(mute)
Public Function setAudioOff()
    Error = mciSendString("set cd audio all off", 0, 0, 0)
End Function
'set the audio back on
Public Function setAudioOn()
    Error = mciSendString("set cd audio all on", 0, 0, 0)
End Function