by Brian (11 Submissions)
Category: Internet/HTML
Compatability: Visual Basic 3.0
Difficulty: Unknown Difficulty
Date Added: Wed 3rd February 2021
Rating: 
(18 Votes)
This code reads a CD's Identification Number and then access the CDDB for a list of Tracks and information about the CD.
Code Returns
CDDB Information
Side Effects
Works best with VB6 and could cause VB5 to crash (But it very rarely does that)
API Declarations'Put the following code in a CLASS MODULE named CCD
Option Explicit
' *********************************************************
' Various types needed for use by mciSendCommand() function
' *********************************************************
' Structure needed for opening the CDROM device
Private Type MCI_OPEN_PARMS
dwCallback As Long
wDeviceID As Long
lpstrDeviceType As String
lpstrElementName As String
lpstrAlias As String
End Type
' This structure is used when setting time format to be returned
Private Type MCI_SET_PARMS
dwCallback As Long
dwTimeFormat As Long
dwAudio As Long
End Type
' This structure is used when accessing various status information
Private Type MCI_STATUS_PARMS
dwCallback As Long
dwReturn As Long
dwItem As Long
dwTrack As Integer
End Type
' The actual API function used when accessing the CD drive
Private Declare Function mciSendCommand Lib "winmm.dll" Alias "mciSendCommandA" _
(ByVal wDeviceID As Long, ByVal uMessage As Long, ByVal dwParam1 As Long, ByRef dwParam2 As Any) As Long
' Error codes
Private Const MMSYSERR_NOERROR = 0
' Constants used together with mciSendCommand
Private Const MCI_CLOSE = &H804
Private Const MCI_FORMAT_MSF = 2
Private Const MCI_OPEN = &H803
Private Const MCI_OPEN_ELEMENT = &H200&
Private Const MCI_OPEN_TYPE = &H2000&
Private Const MCI_SET = &H80D
Private Const MCI_SET_TIME_FORMAT = &H400&
Private Const MCI_STATUS_ITEM = &H100&
Private Const MCI_STATUS_LENGTH = &H1&
Private Const MCI_STATUS_NUMBER_OF_TRACKS = &H3&
Private Const MCI_STATUS_POSITION = &H2&
Private Const MCI_TRACK = &H10&
Private Const MCI_STATUS = &H814
' Some instances of the structures declared above
Private mciOpenParms As MCI_OPEN_PARMS
Private mciSetParms As MCI_SET_PARMS
Private mciStatusParms As MCI_STATUS_PARMS
' Some own types needed
Private Type TTrackInfo
Minutes As Long
Seconds As Long
Frames As Long
End Type
' Private storage
Private m_Error As Long ' Error code from API call
Private m_CID As String ' Computed disc id
Private m_Drive As String ' Drive letter
Private m_DeviceID As Long ' Device Id
Private m_NTracks As Integer ' Number of tracks in CD
Private m_Length As Long ' Length of CD in seconds
Private m_Tracks() As TTrackInfo ' Track info for each and every track on the CD
' Zero based. Last index used for storing lead-out
' position information.
' ******************************************************************
' Initialize the class
' ******************************************************************
Private Sub Class_Initialize()
m_CID = "(unavailable)"
m_Drive = ""
m_Error = 0
m_DeviceID = -1
m_NTracks = 0
End Sub
' ******************************************************************
' DiscID
' ******************************************************************
Public Property Get DiscID() As String
DiscID = m_CID
End Property
' ******************************************************************
' ErrorCode
' ******************************************************************
Public Property Get ErrorCode() As Long
Error = m_Error
End Property
' ******************************************************************
' Init - Initialize the new object. This will open the device
' and retrieve the information we want
' ******************************************************************
Public Sub Init(sDrive As String)
Dim p1 As Integer
m_Error = MMSYSERR_NOERROR
m_Drive = sDrive
' Open the CD
If OpenCD Then
Call LoadCDInfo
CloseCD
End If
End Sub
' ******************************************************************
' Class_Terminate
' ******************************************************************
Private Sub Class_Terminate()
If m_DeviceID <> -1 Then
CloseCD
End If
End Sub
' *************************************************************************
' OpenCD - Open the CD Driver for use, we also set the time format
' Returns device id for the opened CD
' *************************************************************************
Private Function OpenCD() As Bool
VBcoders'Add 2 command buttons to your form (Call them btnCalc and btnExit
'Add a Combobox called cboDrives and a Textbox called txtID
Option Explicit
Private Sub btnCalc_Click()
Dim MyCD As New CCD
MyCD.Init cboDrives.Text
txtID.Text = MyCD.DiscID
End Sub
Private Sub btnExit_Click()
Unload Me
End Sub
Private Sub Form_Load()
cboDrives.AddItem "D:"
cboDrives.AddItem "E:"
cboDrives.AddItem "F:"
cboDrives.AddItem "G:"
cboDrives.AddItem "H:"
cboDrives.AddItem "I:"
cboDrives.ListIndex = 0
End Sub
