• Home
 · 
• Sound/MP3
 · 
• Interact with CD's without using the Microsoft Multimedia Control.

Interact with CD's without using the Microsoft Multimedia Control.

Interact with CD's without using the Microsoft Multimedia Control.

Rate Interact with CD's without using the Microsoft Multimedia Control.

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

' * Programmer Name  : Waty Thierry
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : [email protected]
' * Date             : 29/10/98
' * Time             : 14:31
' * Module Name      : class_CDAudio
' * Module Filename  : CDAudio.cls
' **********************************************************************
' * Comments         : This class allows you to interact with CD's
' *  without using the Microsoft Multimedia Control.
' *
' **********************************************************************

' Windows API Declarations
Private Type MCI_OPEN_PARMS
   dwCallback As Long
   wDeviceID As Long
   lpstrDeviceType As String
   lpstrElementName As String
   lpstrAlias As String
End Type

Private Type MCI_GENERIC_PARMS
   dwCallback As Long
End Type

Private Type MCI_SET_PARMS
   dwCallback As Long
   dwTimeFormat As Long
   dwAudio As Long
End Type

Private Type MCI_PLAY_PARMS
   dwCallback As Long
   dwFrom As Long
   dwTo As Long
End Type

Private Type MCI_STATUS_PARMS
   dwCallback As Long
   dwReturn As Long
   dwItem As Long
   dwTrack As Integer
End Type

Private mOpenParams As MCI_OPEN_PARMS
Private Const MCI_STATUS_NUMBER_OF_TRACKS = &H3&

Private Const MCI_CLOSE = &H804
Private Const MCI_WAIT = &H2&
Private Const MCI_OPEN = &H803
Private Const MCI_FORMAT_MILLISECONDS = 0
Private Const MCI_SET = &H80D
Private Const MCI_OPEN_ELEMENT = &H200&
Private Const MCI_SET_TIME_FORMAT = &H400&
Private Const MCI_STOP = &H808
Private Const MCI_SEEK = &H807
Private Const MCI_SEEK_TO_START = &H100&
Private Const MCI_PLAY = &H806
Private Const MCI_NOTIFY = &H1&
Private Const MCI_STATUS_POSITION = &H2&
Private Const MCI_STATUS = &H814
Private Const MCI_STATUS_ITEM = &H100&
Private Const MCI_OPEN_SHAREABLE = &H100&
Private Const MCI_OPEN_TYPE = &H2000&
Private Const MCI_SET_DOOR_OPEN = &H100&
Private Const MCI_FORMAT_TMSF = 10
Private Const MCI_STATUS_LENGTH = &H1&
Private Const MCI_TRACK = &H10&
Private Const MCI_TO = &H8
Private Const MCI_FROM = &H4

Private Declare Function mciSendCommand _
      Lib "winmm.dll" _
      Alias "mciSendCommandA" _
      (ByVal wDeviceID As Long, _
      ByVal uMessage As Long, _
      ByVal dwParam1 As Long, _
      dwParam2 As Any) _
      As Long

Private Declare Function mciGetErrorString _
      Lib "winmm.dll" _
      Alias "mciGetErrorStringA" _
      (ByVal dwError As Long, _
      ByVal lpstrBuffer As String, _
      ByVal uLength As Long) _
      As Long

Private mcolTracks As Collection
Private m_fPlaying As Boolean

Private Const cintErrorStringLen As Integer = 100

Private Sub Class_Initialize()
   ' Set initial values
   ' Source: Total VB SourceBook 5

   On Error GoTo PROC_ERR

   mOpenParams.dwCallback = 0
   mOpenParams.wDeviceID = 0
   mOpenParams.lpstrDeviceType = "cdaudio"
   mOpenParams.lpstrElementName = 0
   mOpenParams.lpstrAlias = 0

PROC_EXIT:
   Exit Sub

PROC_ERR:
   MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
         "Class_Initialize"
   Resume PROC_EXIT

End Sub

Private Sub Class_Terminate()
   ' Make sure the CD resource is closed
   ' Source: Total VB SourceBook 5

   On Error GoTo PROC_ERR

   CloseCD

PROC_EXIT:
   Exit Sub

PROC_ERR:
   MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
         "Class_Terminate"
   Resume PROC_EXIT

End Sub

Public Property Get Minutes() As Integer
   ' Returns: the current minute position
   ' Source: Total VB SourceBook 5

   Minutes = MCI_TMSF_MINUTE(GetPosition)

End Property

Public Property Let Minutes(ByVal intValue As Integer)
   ' intValue: Set the current minute position
   ' Source: Total VB SourceBook 5

   SetPosition Track, intValue, Seconds

End Property

Public Property Let Seconds(ByVal intValue As Integer)
   ' intValue: Set the current second position
   ' Source: Total VB SourceBook 5

   SetPosition Track, Minutes, intValue

End Property

Public Property Get Seconds() As Integer
   ' Returns: the current seconds position
   ' Source: Total VB SourceBook 5

   Seconds = MCI_TMSF_SECOND(GetPosition)

End Property

Public Property Let Track(ByVal intValue As Integer)
   ' intValue: Set the current track position
   ' Source: Total VB SourceBook 5

   SetPosition intValue, Minutes, Seconds

End Property

Public Property Get Track() As Integer
   ' Returns: the current track
   ' Source: Total VB SourceBook 5

   Track = MCI_TMSF_TRACK(GetPosition)

End Property

Public Property Get Tracks() As Collection
   ' Returns: the tracks collection
   ' Source: Total VB SourceBook 5

   On Error GoTo PROC_ERR

   Set Tracks = mcolTracks

PROC_EXIT:
   Exit Property

PROC_ERR:
   MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
         "Tracks"
   Resume PROC_EXIT

End Property

Public Sub CloseCD()
   ' Comments  : Closes the CD resource
   ' Parameters: None
   ' Returns   : Nothing
   ' Source    : Total VB SourceBook 5
   '
   Dim gp As MCI_GENERIC_PARMS
   Dim lngResult As Long

   On Error GoTo PROC_ERR

   If mOpenParams.wDeviceID <> 0 Then
      ' The CD is open
      ' Stop it if it is playing
      StopCD
      ' close the CD device
      lngResult = mciSendCommand(mOpenParams.wDeviceID, MCI_CLOSE, MCI_WAIT, gp)
      mOpenParams.wDeviceID = 0
   End If

PROC_EXIT:
   Exit Sub

PROC_ERR:
   MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
         "CloseCd"
   Resume PROC_EXIT

End Sub

Public Sub Eject()
   ' Comments  : Ejects the CD from the drive
   ' Parameters: None
   ' Returns   : Nothing
   ' Source    : Total VB SourceBook 5
   '
   Dim mciSet As MCI_SET_PARMS
   Dim lngFlags As Long
   Dim lngResult As Long
   Dim strErrorDescription As String

   On Error GoTo PROC_ERR

   ' Open the cd door
   lngFlags = MCI_SET_DOOR_OPEN
   lngResult = mciSendCommand(mOpenParams.wDeviceID, MCI_SET, lngFlags, mciSet)

   ' Throw an error if one occured
   If lngResult <> 0 Then
      strErrorDescription = Space$(cintErrorStringLen)
      mciGetErrorString lngResult, strErrorDescription, cintErrorStringLen
      Err.Raise lngResult, , strErrorDescription
   End If

PROC_EXIT:
   Exit Sub

PROC_ERR:
   MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
         "Eject"
   Resume PROC_EXIT
End Sub

Public Sub OpenCD()
   ' Comments  : Opens the CD resource
   ' Parameters: None
   ' Returns   : Nothing
   ' Source    : Total VB SourceBook 5
   '
   Const cstrDeviceName As String = "cdaudio"
   Dim lngResult As Long
   Dim strErrorDescription As String
   Dim mciSet As MCI_SET_PARMS

   On Error GoTo PROC_ERR

   ' Close the CD if it is open
   If mOpenParams.wDeviceID <> 0 Then
      CloseCD
   End If

   mOpenParams.lpstrDeviceType = cstrDeviceName
   lngResult = mciSendCommand(0, MCI_OPEN, MCI_WAIT Or MCI_OPEN_SHAREABLE Or _
         MCI_OPEN_TYPE, mOpenParams)

   ' Throw an error if one occured
   If lngResult <> 0 Then
      strErrorDescription = Space$(cintErrorStringLen)
      mciGetErrorString lngResult, strErrorDescription, cintErrorStringLen
      Err.Raise lngResult, , strErrorDescription
   End If

   ' Set the time format
   mciSet.dwTimeFormat = MCI_FORMAT_TMSF

   lngResult = mciSendCommand(mOpenParams.wDeviceID, MCI_SET, MCI_WAIT Or _
         MCI_SET_TIME_FORMAT, mciSet)

   ' Throw an error if one occured
   If lngResult <> 0 Then
      strErrorDescription = Space$(cintErrorStringLen)
      mciGetErrorString lngResult, strErrorDescription, cintErrorStringLen
      Err.Raise lngResult, , strErrorDescription
   End If

   ' Enumerate the tracks on the CD
   EnumTracks

PROC_EXIT:
   Exit Sub

PROC_ERR:
   MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
         "OpenCD"
   Resume PROC_EXIT

End Sub

Public Sub Pause()
   ' Comments  : Pauses CD Play
   ' Parameters: None
   ' Returns   : Nothing
   ' Source    : Total VB SourceBook 5
   '
   Dim lngResult As Long

   On Error GoTo PROC_ERR

   ' Tell the CD device to pause
   lngResult = mciSendCommand(mOpenParams.wDeviceID, MCI_STOP, MCI_WAIT, 0)
   m_fPlaying = False

PROC_EXIT:
   Exit Sub

PROC_ERR:
   MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
         "Pause"
   Resume PROC_EXIT

End Sub

Public Sub Play()
   ' Comments  : Plays the CD
   ' Parameters: None
   ' Returns   : Nothing
   ' Source    : Total VB SourceBook 5
   '
   Dim lngResult As Long
   Dim strErrorDescription As String
   Dim mciPlay As MCI_PLAY_PARMS

   On Error GoTo PROC_ERR

   ' Tell the CD device to begin playing
   lngResult = mciSendCommand(mOpenParams.wDeviceID, MCI_PLAY, MCI_NOTIFY, _
         mciPlay)

   ' Throw an error if one occured
   If lngResult <> 0 Then
      strErrorDescription = Space$(cintErrorStringLen)
      mciGetErrorString lngResult, strErrorDescription, cintErrorStringLen
      Err.Raise lngResult, , strErrorDescription
   End If

   'Set the playing flag to True
   m_fPlaying = True

PROC_EXIT:
   Exit Sub

PROC_ERR:
   MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
         "Play"
   Resume PROC_EXIT

End Sub

Public Sub StopCD()
   ' Comments  : Stops the CD
   ' Parameters: None
   ' Returns   : Nothing
   ' Source    : Total VB SourceBook 5
   '
   Dim lngResult As Long

   On Error GoTo PROC_ERR

   ' Tell the cd device to stop
   lngResult = mciSendCommand(mOpenParams.wDeviceID, MCI_STOP, MCI_WAIT, 0)
   ' Reset play position
   m_fPlaying = False
   SetPosition 1, 0, 0

PROC_EXIT:
   Exit Sub

PROC_ERR:
   MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
         "StopCD"
   Resume PROC_EXIT
End Sub

Private Function dblToLong(ByVal dblNumber As Double) As Long
   ' Comments  : This routine does an unsigned conversion from a double Value
   '             to a long Value. This procedure correctly handles any double
   '             value
   ' Parameters: dblNumber - the double value to convert to a long
   ' Returns   : long
   ' Source    : Total VB SourceBook 5
   '
   Dim dblDivisor As Double
   Dim dblTemp As Double

   On Error GoTo PROC_ERR

   ' Visual basic does not allow you enter the value &H100000000 directly,
   ' so we enter &H7FFFFFFF, double it and add two to create it.
   dblDivisor = &H7FFFFFFF
   dblDivisor = (dblDivisor * 2) + 2

   'if the number is larger than a long can store, then truncate it
   If dblNumber > dblDivisor Or dblNumber < 0 Then
      dblTemp = dblNumber - (Int(dblNumber / dblDivisor) * dblDivisor)
   Else
      dblTemp = dblNumber
   End If

   ' if the number is greater than a signed long, convert it to a
   ' negative
   If dblTemp > &H7FFFFFFF Then
      dblToLong = dblTemp - dblDivisor
   ElseIf dblTemp < 0 Then
      ' If the number is negative
      dblToLong = dblDivisor + dblTemp
   Else
      dblToLong = dblTemp
   End If

PROC_EXIT:
   Exit Function

PROC_ERR:
   MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
         "dblToLong"
   Resume PROC_EXIT

End Function

Private Sub EnumTracks()
   ' Comments  : Enumerates the tracks on a cd
   ' Parameters: None
   ' Returns   : Nothing
   ' Source    : Total VB SourceBook 5
   '

   Dim status As MCI_STATUS_PARMS
   Dim mciSet As MCI_SET_PARMS
   Dim lngFlags As Long
   Dim strErrorDescription As String

   Dim lngResult As Long
   Dim intCounter As Integer
   Dim intTrackCount As Integer

   On Error GoTo PROC_ERR

   ' Set the time format
   mciSet.dwTimeFormat = MCI_FORMAT_TMSF
   lngFlags = MCI_SET_TIME_FORMAT
   lngResult = mciSendCommand(mOpenParams.wDeviceID, MCI_SET, lngFlags, mciSet)

   ' Throw an error if one occured
   If lngResult <> 0 Then
      strErrorDescription = Space$(cintErrorStringLen)
      mciGetErrorString lngResult, strErrorDescription, cintErrorStringLen
      Err.Raise lngResult, , strErrorDescription
   End If

   ' Get the number of tracks
   lngFlags = MCI_STATUS_ITEM
   status.dwItem = MCI_STATUS_NUMBER_OF_TRACKS
   lngResult = mciSendCommand(mOpenParams.wDeviceID, MCI_STATUS, lngFlags, _
         status)

   ' Throw an error if one occured
   If lngResult <> 0 Then
      strErrorDescription = Space$(cintErrorStringLen)
      mciGetErrorString lngResult, strErrorDescription, cintErrorStringLen
      Err.Raise lngResult, , strErrorDescription

   End If

   ' Set up the tracks collection
   intTrackCount = status.dwReturn
   Set mcolTracks = New Collection
   For intCounter = 0 To intTrackCount - 1
      status.dwItem = MCI_STATUS_LENGTH
      status.dwTrack = intCounter + 1
      mciSendCommand mOpenParams.wDeviceID, MCI_STATUS, MCI_TRACK Or _
            MCI_STATUS_ITEM, status
      ' Convert from the length returned from MCI to the length in seconds,
      ' then add it to the collection
      mcolTracks.Add (60 * (((status.dwReturn And &H7FFF)) And 255)) + _
            (((status.dwReturn And &H7FFF) / 256) And 255)
   Next intCounter

PROC_EXIT:
   Exit Sub

PROC_ERR:
   MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
         "EnumTracks"
   Resume PROC_EXIT
End Sub

Private Function GetPosition() As Long
   ' Comments  : This function returns the current of the playback of the MCI
   '             device
   ' Parameters: None
   ' Returns   : The current position in Track/Minute/Second format
   ' Source    : Total VB SourceBook 5
   '
   Dim status As MCI_STATUS_PARMS
   Dim mciSet As MCI_SET_PARMS
   Dim lngFlags As Long
   Dim lngResult As Long
   Dim strErrorDescription As String

   On Error GoTo PROC_ERR

   ' Set the time format
   mciSet.dwTimeFormat = MCI_FORMAT_TMSF
   lngFlags = MCI_SET_TIME_FORMAT
   lngResult = mciSendCommand(mOpenParams.wDeviceID, MCI_SET, lngFlags, mciSet)

   ' Throw an error if one occured
   If lngResult <> 0 Then
      strErrorDescription = Space$(cintErrorStringLen)
      mciGetErrorString lngResult, strErrorDescription, cintErrorStringLen
      Err.Raise lngResult, , strErrorDescription
   End If

   ' Get the position
   lngFlags = MCI_STATUS_ITEM
   status.dwItem = MCI_STATUS_POSITION
   lngResult = mciSendCommand(mOpenParams.wDeviceID, MCI_STATUS, lngFlags, _
         status)

   ' Throw an error if one occured
   If lngResult <> 0 Then
      strErrorDescription = Space$(cintErrorStringLen)
      mciGetErrorString lngResult, strErrorDescription, cintErrorStringLen
      Err.Raise lngResult, , strErrorDescription
   End If

   ' Return the position
   GetPosition = status.dwReturn

PROC_EXIT:
   Exit Function

PROC_ERR:
   MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
         "GetPosition"
   Resume PROC_EXIT
End Function

Private Function IntToByte(ByVal intNumber As Integer) As Byte
   ' Comments  : This routine does an unsigned conversion from an integer value
   '             to a byte value. This procedure correctly handles any integer
   '             value
   ' Parameters: intNumber - the integer value to convert to a byte
   ' Returns   : Byte
   ' Source    : Total VB SourceBook 5
   '
   On Error GoTo PROC_ERR

   IntToByte = intNumber And &HFF&

PROC_EXIT:
   Exit Function

PROC_ERR:
   MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
         "IntToByte"
   Resume PROC_EXIT

End Function

Private Function IntToLong(ByVal intNumber As Integer) As Long
   ' Comments  : This routine converts an integer value to a long value,
   '             treating the integer as unsigned
   ' Parameters: intNumber - the integer to convert to long
   ' Returns   : long
   ' Source    : Total VB SourceBook 5
   '
   On Error GoTo PROC_ERR

   ' This routine converts an integer value to a long value
   If intNumber < 0 Then
      IntToLong = intNumber + &H10000
   Else
      IntToLong = intNumber
   End If

PROC_EXIT:
   Exit Function

PROC_ERR:
   MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
         "IntToLong"
   Resume PROC_EXIT

End Function

Private Function LongToDbl(ByVal lngNumber As Long) As Double
   ' Comments  : This routine converts a long Value to a double Value,
   '             treating the long as unsigned
   ' Parameters: lngNumber - the long to convert to double
   ' Returns   : double
   ' Source    : Total VB SourceBook 5
   '
   Dim dblDivisor As Double

   On Error GoTo PROC_ERR

   ' Visual basic does not allow you enter the value &H100000000 directly,
   ' so we enter &H7FFFFFFF, double it and add two to create it.
   dblDivisor = &H7FFFFFFF
   dblDivisor = (dblDivisor * 2) + 2

   If lngNumber < 0 Then
      LongToDbl = lngNumber + dblDivisor
   Else
      LongToDbl = lngNumber
   End If

PROC_EXIT:
   Exit Function

PROC_ERR:
   MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
         "LongToDbl"
   Resume PROC_EXIT

End Function

Private Function LongToInt(ByVal lngNumber As Long) As Integer
   ' Comments  : This routine does an unsigned conversion from a long value
   '             to an integer value. This procedure correctly handles any
   '             long value
   ' Parameters: lngNumber - the long value to convert to an integer
   ' Returns   : Integer
   ' Source    : Total VB SourceBook 5
   '
   On Error GoTo PROC_ERR

   ' This routine converts a long value to an integer
   lngNumber = lngNumber And &HFFFF&
   If lngNumber > &H7FFF Then
      LongToInt = lngNumber - &H10000
   Else
      LongToInt = lngNumber
   End If

PROC_EXIT:
   Exit Function

PROC_ERR:
   MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
         "LongToInt"
   Resume PROC_EXIT

End Function

Private Function MCI_MAKE_TMSF( _
         intTrack As Integer, _
         intMinute As Integer, _
         intSecond As Integer) _
         As Long
   ' Comments  : This function converts from Tracks/Minute/Seconds to a position
   '             usable by MCI
   ' Parameters: intTrack - The track position
   '             intMinute - The minute position
   '             intSecond - The seconds position
   ' Returns   : The converted position
   ' Source    : Total VB SourceBook 5
   '

   On Error GoTo PROC_ERR

   MCI_MAKE_TMSF = CLng(intTrack) Or CLng(Shli(intMinute, 8)) Or _
         CLng(Shll(intSecond, 16))

PROC_EXIT:
   Exit Function

PROC_ERR:
   MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
         "MCI_MAKE_TMSF"
   Resume PROC_EXIT
End Function

Private Function MCI_TMSF_MINUTE(lngTime As Long) As Byte
   ' Comments  : This function converts a position returned from MCI to
   '             a minute values
   ' Parameters: lngTime - The position value returned from MCI
   ' Returns   : The minute
   ' Source    : Total VB SourceBook 5
   '
   On Error GoTo PROC_ERR

   MCI_TMSF_MINUTE = IntToByte(Shri(LongToInt(lngTime), 8))

PROC_EXIT:
   Exit Function

PROC_ERR:
   MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
         "MCI_TMSF_MINUTE"
   Resume PROC_EXIT

End Function

Private Function MCI_TMSF_SECOND(lngTime As Long) As Byte
   ' Comments  : This function converts a position returned from MCI to
   '             a seconds values
   ' Parameters: lngTime - The position value returned from MCI
   ' Returns   : The seconds
   ' Source    : Total VB SourceBook 5
   '
   On Error GoTo PROC_ERR

   MCI_TMSF_SECOND = IntToByte(LongToInt(Shrl(lngTime, 16)))

PROC_EXIT:
   Exit Function

PROC_ERR:
   MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
         "MCI_TMSF_SECOND"
   Resume PROC_EXIT

End Function

Private Function MCI_TMSF_TRACK(lngTime As Long) As Byte
   ' Comments  : This function converts a position returned from MCI to
   '             a track values
   ' Parameters: lngTime - The position value returned from MCI
   ' Returns   : The track
   ' Source    : Total VB SourceBook 5
   '
   On Error GoTo PROC_ERR

   MCI_TMSF_TRACK = IntToByte(LongToInt(lngTime))

PROC_EXIT:
   Exit Function

PROC_ERR:
   MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
         "MCI_TMSF_TRACK"
   Resume PROC_EXIT

End Function

Private Sub SetPosition( _
         intTrack As Integer, _
         intMinute As Integer, _
         intSecond As Integer)
   ' Comments  : This procedure set the current position of the MCI playback
   ' Parameters: intTrack - The track position
   '             intMinute - The minute position
   '             intSecond - The seconds position
   ' Returns   : Nothing
   ' Source    : Total VB SourceBook 5
   '
   Dim mciPlay As MCI_PLAY_PARMS
   Dim mciSet As MCI_SET_PARMS
   Dim lngFlags As Long
   Dim lngResult As Long
   Dim strErrorDescription As String

   On Error GoTo PROC_ERR

   ' Set the time format
   mciSet.dwTimeFormat = MCI_FORMAT_TMSF
   lngFlags = MCI_SET_TIME_FORMAT
   lngResult = mciSendCommand(mOpenParams.wDeviceID, MCI_SET, lngFlags, mciSet)

   ' Throw an error if one occured
   If lngResult <> 0 Then
      strErrorDescription = Space$(cintErrorStringLen)
      mciGetErrorString lngResult, strErrorDescription, cintErrorStringLen
      Err.Raise lngResult, , strErrorDescription
   End If

   lngFlags = MCI_TO Or MCI_WAIT

   If (m_fPlaying) Then
      ' If we are already playing, tell the cd to play from the new position
      mciPlay.dwFrom = MCI_MAKE_TMSF(intTrack, intMinute, intSecond)
      lngResult = mciSendCommand(mOpenParams.wDeviceID, MCI_PLAY, MCI_FROM, _
            mciPlay)
   Else

      ' If the cd is stopped or paused, set the play from and to parameters to
      ' the same value. This will keep the cd from playing
      mciPlay.dwTo = MCI_MAKE_TMSF(intTrack, intMinute, intSecond)
      mciPlay.dwFrom = MCI_MAKE_TMSF(intTrack, intMinute, intSecond)
      lngResult = mciSendCommand(mOpenParams.wDeviceID, MCI_PLAY, MCI_FROM Or _
            MCI_TO, mciPlay)

   End If

   ' Throw an error if one occured
   If lngResult <> 0 Then
      strErrorDescription = Space$(cintErrorStringLen)
      mciGetErrorString lngResult, strErrorDescription, cintErrorStringLen
      Err.Raise lngResult, , strErrorDescription
   End If

PROC_EXIT:
   Exit Sub

PROC_ERR:
   MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
         "SetPosition"