PlayerMCI

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

Sub GetCDPosition(Track%, Min%, Sec%)
Dim s As String * 30
mciSendString "status cd position", s, Len(s), 0
Track = CInt(Mid$(s, 1, 2))
Min = CInt(Mid$(s, 4, 2))
Sec = CInt(Mid$(s, 7, 2))
End Sub

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

VERSION 5.00
Begin VB.Form frmMain
BackColor= &H00C0C0C0&
BorderStyle= 1 'Fixed Single
Caption = "Cd Player"
ClientHeight = 2340
ClientLeft= 5100
ClientTop= 1575
ClientWidth= 3495
LinkTopic= "Form1"
MaxButton= 0 'False
PaletteMode= 1 'UseZOrder
ScaleHeight= 2340
ScaleWidth= 3495
Begin VB.Frame Frame1
BackColor= &H00C0C0C0&
Caption = "Track Jump"

ForeColor= &H00000000&
Height = 855
Left = 120
TabIndex= 2
Top= 960
Width = 3255
Begin VB.CommandButton Command1
Caption = "Play"
Height = 375
Left = 1440
TabIndex= 6
Top= 360
Width = 615
End
Begin VB.CommandButton Command5
Caption = "Stop"
Height = 375
Left = 2400
TabIndex= 5
Top= 360
Width = 615
End
Begin VB.TextBox Text1
BackColor= &H80000006&
BeginProperty Font
Name = "Comic Sans MS"
Size = 6.75
Charset = 0
Weight = 400
Underline= 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor= &H00FFFFFF&
Height = 285
Left = 720
TabIndex= 3
Text = "1"
Top= 360
Width = 375
End
Begin VB.Label Label2
BackColor= &H80000012&
BorderStyle= 1 'Fixed Single
Caption = "Track:"
BeginProperty Font
Name = "Comic Sans MS"
Size = 6.75
Charset = 0
Weight = 400
Underline= 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor= &H00FFFFFF&
Height = 285
Left = 120
TabIndex= 4
Top= 360
Width = 615
End
End
Begin VB.CommandButton Command4
Caption = "Open Tray"
Height = 375
Left = 120
TabIndex= 1
Top= 1920
Width = 975
End
Begin VB.CommandButton Command3
Caption = "Close Tray"
Height = 375
Left = 2400
TabIndex= 0
Top= 1920
Width = 975
End
Begin VB.Frame frmTime
BackColor= &H00C0C0C0&
Caption = "Time Jump"
ForeColor= &H00000000&
Height = 735
Left = 120
TabIndex= 7
Top= 120
Width = 3255
Begin VB.CommandButton Command7
Caption = ">>"
BeginProperty Font
Name = "Comic Sans MS"
Size = 6.75
Charset = 0
Weight = 400
Underline= 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2400
TabIndex= 10
Top= 240
Width = 495
End
Begin VB.CommandButton Command6
Caption = "<<"
BeginProperty Font
Name = "Comic Sans MS"
Size = 6.75
Charset = 0
Weight = 400
Underline= 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1800
TabIndex= 9
Top= 240
Width = 495
End
Begin VB.TextBox Text2
BackColor= &H00000000&
BeginProperty Font
Name = "Comic Sans MS"
Size = 6.75
Charset = 0
Weight = 400
Underline= 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor= &H00FFFFFF&
Height = 285
Left = 120
TabIndex= 8
Text = "5"
Top= 240
Width = 495
End
Begin VB.Label Label1
BackColor= &H80000012&
BorderStyle= 1 'Fixed Single
Caption = "Seconds"
BeginProperty Font
Name = "Comic Sans MS"
Size = 6.75
Charset = 0
Weight = 400
Underline= 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor= &H00FFFFFF&
Height = 285
Left = 600
TabIndex= 11
Top= 240
Width = 735
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Atribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Snd As CDAudio
Private Sub Command1_Click()
Snd.SeekCDtoX Val(Text1)
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()
Dim x As Integer
For x = 1 To 10000
Snd.StopPlay
Next x
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 "WarP...14/m and from Mass rep'in my Krew" & _
Chr(10) & "WarPx2@juno.com", vbInformation, _
"Bout WarP"
End Sub

Private Sub Form_Load()
Set Snd = New CDAudio
Snd.ReadyDevice
End Sub

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

'Type the following into the Form, NOT THE Module/Bas!!

'It wont work if its not 'in the Form.

'Copy and Paste everything below this line into the form:


Dim Snd As CDAudio

Private Sub Play_Click()
Snd.SeekCDtoX Val(TrackNumber)
End Sub

Private Sub CloseTray_Click()
Snd.CloseCD
End Sub

Private Sub OpenTray_Click()
Snd.EjectCD
End Sub

Private Sub Stop_Click()
Dim x As Integer
For x = 1 To 10000
Snd.StopPlay
Next x
End Sub

Private Sub FastRVS_Click()
Snd.ReWind Val(Time) * 1000
End Sub

Private Sub FastFWD_Click()
Snd.FastForward Val(Time) * 1000
End Sub

Private Sub Form_Load()
Set Snd = New CDAudio
Snd.ReadyDevice
End Sub

Private Sub Form_Unload(Cancel As Integer)
Snd.StopPlay
Snd.UnloadAll
End Sub
Assumes:
Ok here are the directions before you start making the
CD Player. Please follow 'the directions and dont skip anything!!
Before you Do anytihng, add a new Class Module to the project

1.)Make a TextBox and name it "Time" and make its text "5"
2.)Make a TextBox and name it "TrackNumber" and make its caption "1"
3.)Make a Label and name it "Seconds" and make its caption "Seconds"
4.)Make a Label and name it "Track" and make its caption "Track:"
5.)Make a CommandButton and name it "FastRVS" and make its caption "<<"
6.)Make a CommandButton and name it "FastFWD" and make its caption ">>"
7.)Make a CommandButton and name it "Play" and make its caption "Play"
8.)Make a CommandButton and name it "Stop" and make its caption "Stop"
9.)Make a CommandButton and name it "CloseTray" and make its caption "CloseTray"
10.)Make a CommandButton and name it "OpenTray" and make its caption "OpenTray"

Side Effects:
For those who are STILL having problems
with my coding, please do the following:
Open up an txt editior(NotePad, WordPad Etc...)
Copy and Paste the below into the NotePad
when u finish, rename the text file(.txt) to (.frm) instead
then start a new project, add the class module from the below ofthis
and the .frm file u just renamed and youll be allset!