I have found plenty of examples of cd players on and various other places and I can even make my own one using the MCI etc but what I would really like help with is how to populate a popup menu dynamically with the track(s) ie :

1.] Track 1 - 03:48
2.] Track 3 - 02:49


Better yet if anyone knows how to get the actual track names along with the duration period of the track ie

1.] DJ ALLIGATOR - 3:35
2.] Guns n Roses - 4:50


That would be better, I would also need the default items in the popup menu with out them being replaced by any of the dynamically added tracks ie so that the user can use the menu to alter the volume, mute the volume, change between tracks, pause or play a track which I want in the same menu item just like you do when you click the play button it plays either the selected track from a drop down or it pauses an already playing track, if one is playing then it changes the caption of play to pause and when you click pause it changes it back to play.

It is mainly the dynamically filling the popup menu without over writing default items in the pop up menu ie play, pause, stop, next track, previous track, exit, etc ......  that I am after with regards to getting help with !

Thanks in advance !
LVL 23
Shane Russell2nd Line Desktop SupportAsked:
Who is Participating?
At one time CDDB offered an OCX to do the job.

This is an extract of the code written before it was available The connection to GraceNote is not implemented

The control returns times in Minutes-Seconds-Frames (msf).


Option Explicit

Private Sub Command1_Click()
Debug.Print ReadCDToc
End Sub

Private Sub Form_Load()
End Sub

Option Explicit
DefInt A-Z
#If Win32 Then
    Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
    Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
    Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
    Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lplFileName As String) As Integer
#End If
Global di ' debugging integer (for For loops in Immediate pane)(Hangover frm VB3)
Global Const ART_ID = 0
Global Const ART_FORENAME = 1
Global Const ART_NAME = 2
Global Const ART_ALIAS = 3
Global Const ART_YOB = 4
Global Const ART_YOD = 5
Global Const ART_NAT = 6
Public AlbumFormLoaded As Integer
Global Const SOURCE_DATABASE = 0
Global Const SOURCE_MANUAL = 2
Global TRACK_Track_ID

Global TracksArtists_ID
Global TracksArtists_BILLING
Global TracksArtists_NAME
Global TracksArtists_FORENAME
Global TracksArtists_YOB
Global TracksArtists_ROLE
Global TracksArtists_TOPCOL

Global Const AutoAdd = True
Global Const AlbumFormType$ = "Old"
'Global AlbumTable As Table
Global AlbumDirty
Public IgnoreRTBoxChange  As Integer
Global Upperletters$
Global UpdatingMainArtistFlag
Global UpdatedMainArtistFlag
Global NewAlbumArtist$
Global TracksArtists_IDs()
Global TrackArtRoles$()
Global TrackArtBillings()
Global TrackPanelCount
Global DoneAwaited
'Global cddbQuery As String
Type CDProfile
    TrackCount As Integer
    RunTime As Long
End Type

Type Album
    Reference As String
    Jupiter As String
    Set As String
    MainTitle As String
    MainArtist As String
    Genre As String
    Label As String
    MediaType As String
    MediaSpeed As String
    MediaSize As Integer
    Stereo As String
    YOP As String
    Owner As String
    Cost As String
    Album_Id As Long
    RunTime As Long
    ufsmRunTime As Long
    TrackCount As Integer
    Vendor As String
    Digital As String
    cddbQuery As String
End Type
Global CurrentCD As Album
Global DefaultAlbum As Album
Type Track
    Side As Integer
    ID As Long
    No As Integer
    Title As String
    ufsmRunTime As Long
    RunTime As Long
    Stereo As String
    Genre As String
    YOR As String
    Artist As String
End Type
Global CDTrack() As Track
Type Requests
    Phase As Integer
    CommandLine As String
    ReceivedText As String
End Type

Global LastCDPosition&
Global SaveBeforeTrackEdit
Global PlayerStatus
Global CD_IDStatus
Global PictureCount
'Global CDMatchStatus
Global Const PS_OFF = 0
Global Const PS_STARTING = 1
Global Const PS_READY = 2
Global Const PS_PLAYING = 3
Global Const PS_PAUSED = 4
Global Const PS_STOPPED = 5
Global Const PS_NOCD = 6
Global Const PS_UNLOADING = 7
Global Const PS_LOADING = 8

Global Const ID_UNKNOWN = 0
Global Const ID_READINGCD = 1
Global Const ID_READCD = 2
Global Const ID_IDENTIFYING = 3
Global Const ID_NEW = 4
Global Const ID_IDENTIFIED = 5
Global Const ID_NOCD = 6
Global Const ID_NONAUDIO = 7

Global Const CD_NEW = 0
Global Const CD_EXACT = 1
Global Const CD_JUPITER = 2
Global Const CD_LOST_TIMES = 3

Global PlayerStatusText$(PS_LOADING)
Global CD_IDStatusText$(ID_NONAUDIO)
Global ArtistGridHeading$(ART_NAT)
Global ArtistGridColWidth(ART_NAT)
Global Inifile$
Global SearchName$, SearchForeName$
Dim CRLF As String
Type typeMSF
    min_ As Integer
    sec As Integer
    Frame As Integer
End Type

Dim CDTrackPositions() As typeMSF
Dim CDTrackLengths() As typeMSF

Private Function cddb_discid(TrackCount) As String
    Dim i As Integer
    Dim t, n
    i = 1
    Debug.Print "TrackCount:" & TrackCount
    While (i < TrackCount)
        n = n + cddb_sum(SecondsCount(CDTrackPositions(i)))
        i = i + 1
        Debug.Print "Digit sum:", i, n
    t = SecondsCount(CDTrackPositions(TrackCount)) - SecondsCount(CDTrackPositions(1))
    Debug.Print "Length in Seconds(1):", t
    t = Fix(CurrentCD.RunTime / 100)
    Debug.Print "Length in Seconds(2):", t
    cddb_discid$ = Right$("00" & Hex$(n Mod &HFF), 2) & Right$("0000" & Hex$(t), 4) & Right$("00" & Hex$(TrackCount - 1), 2)

End Function
Public Function ReadCDToc()
    Dim t, msfCDLength As typeMSF, OneFrame As typeMSF, Carry
    OneFrame.Frame = 1
    'CurrentCD = DefaultAlbum
    CurrentCD.RunTime = AddSecsFrames(MSFtoSecsFrames(MainForm.MMControl1.Length), 1)
    CurrentCD.ufsmRunTime = MainForm.MMControl1.Length + &H10000
    CurrentCD.TrackCount = MainForm.MMControl1.Tracks
    ReDim CDTrack(CurrentCD.TrackCount)
    ReDim CDTrackPositions(1 To MainForm.MMControl1.Tracks + 1)
    ReDim CDTrackLengths(1 To MainForm.MMControl1.Tracks + 1)
    For t = 1 To CurrentCD.TrackCount
        MainForm.MMControl1.Track = t
        CDTrack(t).ufsmRunTime = MainForm.MMControl1.TrackLength
        Debug.Print "CDTrack(t).ufsmRunTime", CDTrack(t).ufsmRunTime, ;
        CDTrack(t).RunTime = MSFtoSecsFrames(MainForm.MMControl1.TrackLength)
        Debug.Print "CDTrack(t).RunTime", CDTrack(t).RunTime
        CDTrackPositions(t) = LongToMSF(MainForm.MMControl1.TrackPosition)
        'Debug.Print "CDTrackPositions(t)", CDTrackPositions(t), ;
        CDTrackLengths(t) = LongToMSF(MainForm.MMControl1.TrackLength)
        'Debug.Print "CDTrackLengths(t)", CDTrackLengths(t), ;
    Next t
    msfCDLength = AddMSF(LongToMSF(MainForm.MMControl1.Length), OneFrame)
    t = CurrentCD.TrackCount
    If t > 0 Then 'avoid runtime error if t=0
        'Calculate start of leadout
        CDTrack(t).ufsmRunTime = CDTrack(t).ufsmRunTime + &H10000
        Debug.Print "CDTrack(t).ufsmRunTime", CDTrack(t).ufsmRunTime, ;
        CDTrackLengths(t) = AddMSF(CDTrackLengths(t), OneFrame)
        CDTrackPositions(t + 1) = AddMSF(CDTrackPositions(t), CDTrackLengths(t))
        ReadCDToc = MainForm.MMControl1.Tracks
    End If
    CurrentCD.cddbQuery = cddb_discid$(MainForm.MMControl1.Tracks + 1) & " " & MainForm.MMControl1.Tracks & GetOffsetList & " " & SecondsCount(msfCDLength)
    MsgBox "cddbCurrentCD.cddbQuery " & CurrentCD.cddbQuery
    Select Case CurrentCD.cddbQuery
        Case "00000000 0 0"
            ReadCDToc = 0
        Case "02106F01 1 150 4207"
            ReadCDToc = 1
        Case Else
            ReadCDToc = 2
    End Select
End Function

Public Function MSFtoSecsFrames(CDTime As Long) As Long
    Dim Frames As Long
    Dim Minutes As Long
    Dim Seconds As Long
    Dim Unused As Long
    Dim t, HexStr$
    Dim RunTime As Long
    If CDTime > 0 Then
        HexStr$ = Right$("00000000" & Hex$(CDTime), 8)
        Minutes = Val("&h00" & Mid$(HexStr$, 7, 2))
        RunTime = RunTime + Minutes * 6000
        Seconds = Val("&h00" & Mid$(HexStr$, 5, 2))
        RunTime = RunTime + Seconds * 100
        Frames = Val("&h00" & Mid$(HexStr$, 3, 2))
        RunTime = RunTime + Frames
        Unused = Val("&h00" & Mid$(HexStr$, 1, 2))
        MSFtoSecsFrames = RunTime
    End If
End Function

Public Function AddSecsFrames(Time1 As Long, Time2 As Long) As Long
    Dim Secs1, Secs2, Secs3 As Long, Frames1, Frames2, Frames3, Carry
    Secs1 = Fix(Time1 / 100)
    Secs2 = Fix(Time2 / 100)
    Frames1 = Time1 Mod 100
    Frames2 = Time2 Mod 100
    Frames3 = Frames1 + Frames2
    Carry = Fix(Frames3 / 75)
    Frames3 = Frames3 Mod 75
    Secs3 = Secs1 + Secs2 + Carry
    AddSecsFrames = Secs3 * 100 + Frames3
End Function
Public Function LongToMSF(CDTime As Long) As typeMSF
    Dim Result As typeMSF
    Dim HexStr$
    HexStr$ = Right$("00000000" & Hex$(CDTime), 8)
    Result.min_ = Val("&h00" & Mid$(HexStr$, 7, 2))
    Result.sec = Val("&h00" & Mid$(HexStr$, 5, 2))
    Result.Frame = Val("&h00" & Mid$(HexStr$, 3, 2))
    LongToMSF = Result
End Function

Public Function AddMSF(Time1 As typeMSF, Time2 As typeMSF) As typeMSF
    Dim Result As typeMSF, Carry
    Result.Frame = Time1.Frame + Time2.Frame
    Carry = Fix(Result.Frame) / 75
    Result.Frame = Result.Frame Mod 75
    Result.sec = Time1.sec + Time2.sec + Carry
    Carry = Fix(Result.sec) / 60
    Result.sec = Result.sec Mod 60
    Result.min_ = Time1.min_ + Time2.min_ + Carry
    AddMSF = Result
End Function

Public Function GetOffsetList() As String
    Dim t, OffsetList$
    For t = 1 To MainForm.MMControl1.Tracks
        OffsetList$ = OffsetList$ & Str$(FrameCount(CDTrackPositions(t)))
    Next t
    GetOffsetList = OffsetList
End Function

Public Function SecondsCount(CDTime As typeMSF) As Long
    Dim m&, s&
    m& = CDTime.min_
    s& = CDTime.sec
    SecondsCount = (60 * m) + s
End Function

Function cddb_sum(n As Integer) As Integer

    Dim ret As Integer

    '/* For backward compatibility this algorithm must not change */

    ret = 0
    'Debug.Print "Seconds:"; n;
    While n > 0
        ret = ret + (n Mod 10)
        n = Fix(n / 10)
    'Debug.Print " DigitTotal:" & ret;
    cddb_sum = ret
End Function

Public Function FrameCount(CDTime As typeMSF) As Long
    Dim m&, s&, f&
    m& = CDTime.min_
    s& = CDTime.sec
    f& = CDTime.Frame
    FrameCount = 75 * ((60 * m) + s) + f
End Function

Public Sub StartMCI()
    'MainForm.AlbumData.Recordset.Index = "RunTime"
    MainForm.MMControl1.Enabled = True
    MainForm.MMControl1.Notify = True
    MainForm.MMControl1.DeviceType = "CDAudio"
    MainForm.MMControl1.UpdateInterval = 1000
    'SetPlayerStatus PS_STARTING
    MainForm.MMControl1.Command = "Open"
    If MainForm.MMControl1.ErrorMessage <> "" Then
        MsgBox MainForm.MMControl1.ErrorMessage
    End If
    'CentralDebug "Started MCI:"
    'StartMCICmd.Enabled = False
    DoneAwaited = True

End Sub

See my PAQ on reading mp3 properties:

Private Type MP3ID3V1Tag
  Tag As String * 3           '-- 03 = "TAG"
  Title As String * 30        '-- 33
  Artist As String * 30       '-- 63
  Album As String * 30        '-- 93
  Year As String * 4          '-- 97
  Comment As String * 30      '-- 127
  Genre As Byte               '-- 128
End Type

Or if you have ID3v1.1 Use this code.  ID3v1.1 uses the last two bytes of the comment field to store the track number.

Private Type MP3ID3V1_1Tag
  Tag As String * 3           '-- 03 = "TAG"
  Title As String * 30        '-- 33
  Artist As String * 30       '-- 63
  Album As String * 30        '-- 93
  Year As String * 4          '-- 97
  Comment As String * 28      '-- 125
  Track As String * 2          '-- 127
  Genre As Byte               '-- 128
End Type

Then to get  the information use this code

dim MyTag as MP3ID3V1_1Tag                        ' dim as MP3ID3V1 if only using v1 instead of 1.1
Open FileName For Binary As #1                      'where filename is the full path of the mp3
        Get #1, LOF(1) - 127, TempTag               'gets the tag from the end of the file
Close #1

From http:Q_20905558.html
Shane Russell2nd Line Desktop SupportAuthor Commented:
That is great for mp3's but what about cd's as in audio cd's ?
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

Shane Russell2nd Line Desktop SupportAuthor Commented:
Is this too complicated for one question ??
The Microsoft Multimedia Control has a TrackCount property and will return TrackLengths.

The track names are not held on an Audio CD.
Shane Russell2nd Line Desktop SupportAuthor Commented:
I know its possible because winamp does it, I think it uses the grace note cddb or w/e it is to attain the track names and I basically wanted to add that functionality to my cd player :)
Shane Russell2nd Line Desktop SupportAuthor Commented:
Can you give me an example or post some URL's that give examples of how to use the microsoft multimedia control that comes with that feature ie to count the tracks and return track lengths :)
Shane Russell2nd Line Desktop SupportAuthor Commented:
Is there anyway to make it in "HH:MM:SS" format ie hours - minutes - seconds ??

BTW - Even if I do get all the tracks how do I populate the menu with them ? or is that already included in the code in the module you have ?
Shiju SasidharanAssoc Project ManagerCommented:
Shane Russell2nd Line Desktop SupportAuthor Commented:
kewl - thanks - I will try these out tonight and tommorow and will post back ASAP, thanks for all the help everyone. I will split points as all the info has been great. That mp3 one looks interesting though :)

Thanks bingie :)
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.