'http://www.vbarchiv.net/tipps/details.php?id=499

' Module MP3-Play and Stop via API
Option Explicit

'Multimedia Functions
Public Declare Function mciSendString Lib "winmm.dll" _
 Alias "mciSendStringA" ( _
 ByVal lpszCommand As String, _
 ByVal lpszReturnString As String, _
 ByVal cchReturn As Long, _
 ByVal hwndCallback As Long) As Long

'Multimedia Messages

'wFlags (MM_MCINOTIFY message) - Reason for the notification
Public Const MCI_NOTIFY_SUCCESSFUL = &H1        'Notification successful
Public Const MCI_NOTIFY_SUPERSEDED = &H2        'Notification superseded
Public Const MCI_NOTIFY_ABORTED = &H4           'Notification aborted
Public Const MCI_NOTIFY_FAILURE = &H8           'Notification failed

Public Const MM_MCINOTIFY = &H3B9
'

Public Function MP3_Play(ByVal sFile As String, _
 ByVal sAlias As String, ByVal sType As String, ByVal hwnd_cb As Long) As Boolean
 
  'sType="waveaudio" -to play WAV
  'sType="MPEGVideo" -to play mp3
 
  Dim bResult As Boolean
 
  ' Dateinamen in DOS 8.3 Format, da z.B. Sonderzeichen
  ' wie Leerzeichen Probleme machen
  Dim sBuffer As String
  Dim lResult As Long
 
  sBuffer = Space$(255)
  lResult = GetShortPathName(sFile, sBuffer, Len(sBuffer))

  If lResult <> 0 Then
    sFile = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)
 
    ' MCI &#246;ffnen
    lResult = mciSendString("open " & sFile & " type " & sType & " alias " & sAlias, 0, 0, 0)
 
    If lResult = 0 Then
      ' MP3 abspielen
      If mciSendString("play " & sAlias & " from 0 notify", 0, 0, hwnd_cb) = 0 Then
        bResult = True
      End If
    End If
  End If
 
  MP3_Play = bResult
End Function

Public Sub MP3_Stop(ByVal sAlias As String)
  mciSendString "stop " & sAlias, 0, 0, 0
  mciSendString "close " & sAlias, 0, 0, 0
End Sub

Public Function MP3_Play_only(ByVal sAlias As String, sPosition As String, ByVal hwnd_cb As Long) As Boolean
  If mciSendString("play " & sAlias & " from " & sPosition & " notify", 0, 0, hwnd_cb) = 0 Then
    MP3_Play_only = True
  End If
End Function

Public Function MP3_Stop_only(ByVal sAlias As String) As Boolean
  If mciSendString("stop " & sAlias, 0, 0, 0) = 0 Then
    MP3_Stop_only = True
  End If
End Function

Public Sub MP3_Close_only(ByVal sAlias As String)
  mciSendString "close " & sAlias, 0, 0, 0
End Sub

Public Function MP3_Open(ByVal sFile As String, _
 ByVal sAlias As String, ByVal sType As String) As Boolean
 
  Dim bResult As Boolean
 
  ' Dateinamen in DOS 8.3 Format, da z.B. Sonderzeichen
  ' wie Leerzeichen Probleme machen
  Dim sBuffer As String
  Dim lResult As Long
 
  sBuffer = Space$(255)
  lResult = GetShortPathName(sFile, sBuffer, Len(sBuffer))

  If lResult <> 0 Then
    sFile = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)
 
    ' MCI &#246;ffnen
    lResult = mciSendString("open " & sFile & " type " & sType & " alias " & sAlias, 0, 0, 0)
 
    If lResult = 0 Then
      bResult = True
    End If
  End If
 
  MP3_Open = bResult
End Function

Public Function MP3_length(ByVal sAlias As String) As Long

  Dim RetString As String * 256
  Dim strCommand As String
  Dim lResult As Long

  strCommand = "set " & sAlias & " time format milliseconds"
  mciSendString strCommand, vbNullString, 0, 0&
  strCommand = "status " & sAlias & " length"
  lResult = mciSendString(strCommand, RetString, Len(RetString), 0&)
  If lResult = 0 Then
    MP3_length = CLng(RetString)
  End If
End Function

Public Function MP3_position(ByVal sAlias As String) As Long

  Dim RetString As String * 256
  Dim strCommand As String
  Dim lResult As Long

  strCommand = "status " & sAlias & " position"
  lResult = mciSendString(strCommand, RetString, Len(RetString), 0&)
  If lResult <> 0 Then
    MP3_position = -1   'Not playing
  Else
    MP3_position = CLng(RetString)
  End If
End Function

Public Function MP3_seek(ByVal sAlias As String, ByVal sPosition As Long) As Boolean

  Dim RetString As String * 256
  Dim strCommand As String
  Dim lResult As Long

  strCommand = "seek " & sAlias & " to " & CStr(sPosition)
  lResult = mciSendString(strCommand, 0&, 0&, 0&)
  If lResult = 0 Then
    MP3_seek = True
  End If
End Function

'Pause the named media instance
Public Function MP3_pause(ByVal sAlias As String) As Boolean

  Dim strCommand As String
  Dim lResult As Long

  strCommand = "pause " & sAlias
  lResult = mciSendString(strCommand, 0&, 0&, 0&)

  'Get the error message if there is any else return current status
  If lResult = 0 Then
    MP3_pause = True
  End If
End Function

'Resume the named media instance
Public Function MP3_resume(ByVal sAlias As String) As Boolean

  Dim strCommand As String
  Dim lResult As Long

  strCommand = "resume " & sAlias
  lResult = mciSendString(strCommand, 0&, 0&, 0&)

  'Get the error message if there is any else return current status
  If lResult = 0 Then
    MP3_resume = True
  End If
End Function