Extract CD Audio Information

[gknuth]

Hello,

Is it possible, with VB or an API, to extract the serial number, track information, and so on, from a CD?

Thanks,
Gabe

[chrisjk]

check out the mciSendString API. This gets the number of tracks on a CD...

Paste this into a module

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
Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long

Place a command button on a form and paste this into the declarations section of that form

Dim fCDLoaded As Boolean
Dim numTracks As Integer
Private Function SendMCIString(cmd As String, fShowError As Boolean) As Boolean
 
Static rc As Long
Static errStr As String * 200
 
rc = mciSendString(cmd, 0, 0, hWnd)
 
If (fShowError And rc <> 0) Then
    mciGetErrorString rc, errStr, Len(errStr)
    MsgBox errStr
End If
 
SendMCIString = (rc = 0)
 
End Function
 
 
Private Sub Command1_Click()
 
Static s As String * 30
 
' Check if CD is in the player
mciSendString "status cd media present", s, Len(s), 0
If (CBool(s)) Then
    ' Enable all the controls, get CD information
    If (fCDLoaded = False) Then
        mciSendString "status cd number of tracks wait", s, Len(s), 0
        numTracks = CInt(Mid$(s, 1, 2))
        ' If CD only has 1 track, then it's probably a data CD
        If (numTracks = 1) Then
            Exit Sub
        Else
            MsgBox "There are " & numTracks & " tracks on this CD.", vbInformation
        End If
    End If
End If
 
End Sub
 
 
Private Sub Form_Load()
 
' If the cd is being used, then quit
If (SendMCIString("open cdaudio alias cd wait shareable", True) = False) Then
    End
End If
 
SendMCIString "set cd time format tmsf wait", True
 
End Sub
 
 
Private Sub Form_Unload(Cancel As Integer)
 
'Close all MCI devices opened by this program
'Sndfx "Sound1.snd"
SendMCIString "close all", False
 
End Sub