Make A CD Player

'Add Class Module to your project (In the menu choose Project -> Add Class Module,
'Then click Open). Change the Class Module name to CDAudio (In the Project
'Explorer press on Class1 and press F4).
'Add 14 Command Buttons and 2 Text Boxes to your form.
'Insert into Text1 the track number to play. Insert into Text2 the Rewind\FastForward
'speed.
'Insert the following code to your Class Module :

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

Function StartPlay()
mciSendString "play cd", 0, 0, 0
End Function

Function SetTrack(Track%)
mciSendString "seek cd to " & Str(Track), 0, 0, 0
End Function

Function StopPlay()
mciSendString "stop cd wait", 0, 0, 0
End Function

Function PausePlay()
mciSendString "pause cd", 0, 0, 0
End Function

Function EjectCD()
mciSendString "set cd door open", 0, 0, 0
End Function

Function CloseCD()
mciSendString "set cd door closed", 0, 0, 0
End Function

Function UnloadAll()
mciSendString "close all", 0, 0, 0
End Function

Function SetCDPlayerReady()
mciSendString "open cdaudio alias cd wait shareable", 0, 0, 0
End Function
Function SetFormat_tmsf()
mciSendString "set cd time format tmsf wait", 0, 0, 0
End Function

Function SetFormat_milliseconds()
mciSendString "set cd time format milliseconds", 0, 0, 0
End Function

Function CheckCD$()
Dim s As String * 30
mciSendString "status cd media present", s, Len(s), 0
CheckCD = s
End Function

Function GetNumTracks%()
Dim s As String * 30
mciSendString "status cd number of tracks wait", s, Len(s), 0
GetNumTracks = CInt(Mid$(s, 1, 2))
End Function

Function GetCDLength$()
Dim s As String * 30
mciSendString "status cd length wait", s, Len(s), 0
GetCDLength = s
End Function

Function GetTrackLength$(TrackNum%)
Dim s As String * 30
mciSendString "status cd length track " & TrackNum, s, Len(s), 0
GetTrackLength = s
End Function

Function GetCDPosition$()
Dim s As String * 30
mciSendString "status cd position", s, Len(s), 0
GetCDPosition = s
End Function

Function CheckIfPlaying%()
CheckIfPlaying = 0
Dim s As String * 30
mciSendString "status cd mode", s, Len(s), 0
If Mid$(s, 1, 7) = "playing" Then CheckIfPlaying = 1
End Function

Function SeekCDtoX(Track%)
StopPlay
SetTrack Track
StartPlay
End Function

Function ReadyDevice()
UnloadAll
SetCDPlayerReady
SetFormat_tmsf
End Function

Function FastForward(Spd%)
Dim s As String * 40
SetFormat_milliseconds
mciSendString "status cd position wait", s, Len(s), 0
CheckIfPlaying%
If CheckIfPlaying = 1 Then
mciSendString "play cd from " & CStr(CLng(s) + Spd), 0, 0, 0
Else
mciSendString "seek cd to " & CStr(CLng(s) + Spd), 0, 0, 0
End If
SetFormat_tmsf
End Function

Function ReWind(Spd%)
Dim s As String * 40
SetFormat_milliseconds
mciSendString "status cd position wait", s, Len(s), 0
CheckIfPlaying%
If CheckIfPlaying = 1 Then
mciSendString "play cd from " & CStr(CLng(s) - Spd), 0, 0, 0
Else
mciSendString "seek cd to " & CStr(CLng(s) - Spd), 0, 0, 0
End If
SetFormat_tmsf
End Function

'Insert the following code to your form:

Dim Snd As CDAudio
Private Sub Command1_Click()
Snd.SeekCDtoX Val(Text1)
End Sub

Private Sub Command10_Click()
MsgBox Snd.CheckIfPlaying
End Sub

Private Sub Command11_Click()
s = Snd.GetCDPosition
MsgBox "Track: " & CInt(Mid$(s, 1, 2)) & " Min: " & _
CInt(Mid$(s, 4, 2)) & " Sec: " & CInt(Mid$(s, 7, 2))
Track = CInt(Mid$(s, 1, 2))
Min = CInt(Mid$(s, 4, 2))
Sec = CInt(Mid$(s, 7, 2))
End Sub

Private Sub Command12_Click()
s = Snd.GetCDPosition
MsgBox Snd.GetTrackLength(CInt(Mid$(s, 1, 2)))
End Sub

Private Sub Command13_Click()
Snd.PausePlay
End Sub

Private Sub Command14_Click()
Snd.StartPlay
End Sub

Private Sub Command2_Click()
s$ = Snd.GetCDLength
MsgBox "Total length of CD: " & s, , "CD len"
End Sub

Private Sub Command3_Click()
Snd.CloseCD
End Sub

Private Sub Command4_Click()
Snd.EjectCD
End Sub

Private Sub Command5_Click()
Snd.StopPlay
End Sub

Private Sub Command6_Click()
Snd.ReWind Val(Text2) * 1000
End Sub

Private Sub Command7_Click()
Snd.FastForward Val(Text2) * 1000
End Sub

Private Sub Command8_Click()
MsgBox Snd.CheckCD
End Sub

Private Sub Command9_Click()
MsgBox Snd.GetNumTracks
End Sub

Private Sub Form_Load()
Set Snd = New CDAudio
Snd.ReadyDevice
Command1.Caption = "Play track"
Command2.Caption = "Get CD Length"
Command3.Caption = "Close CD"
Command4.Caption = "Eject CD"
Command5.Caption = "Stop"
Command6.Caption = "Rewind"
Command7.Caption = "Fast Forward"
Command8.Caption = "Check if CD in drive"
Command9.Caption = "Get numbre of tracks"
Command10.Caption = "Check If Playing"
Command11.Caption = "Get CD Position"
Command12.Caption = "Get current track Length"
Command13.Caption = "Pause"
Command14.Caption = "Resume"
Text1.Text = "1"
Text2.Text = "5"
End Sub

Private Sub Form_Unload(Cancel As Integer)
Snd.StopPlay
Snd.UnloadAll
End Sub