Option Explicit
 
' benötigte API-Deklarationen
Private 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
 
Private Declare Function GetShortPathName Lib "kernel32" _
  Alias "GetShortPathNameA" ( _
  ByVal lpszLongPath As String, _
  ByVal lpszShortPath As String, _
  ByVal cchBuffer As Long) As Long
 
Private Sub Form_Load()
    MusicTimer.Enabled = False
    MusicTimer.Interval = 100
End Sub
Public Sub OpenMP3(ByVal sFile As String)
  Dim sBuffer As String
  Dim lResult As Long
  Dim sReturn As String
 
  ' Da die mciSendString Funktion mit langen Dateinamen
  ' nicht korrekt arbeitet, muss zuvor der kurze
  ' 8.3 Dateiname der MP3-Datei ermittelt werden.
  sBuffer = Space$(255)
  lResult = GetShortPathName(sFile, sBuffer, Len(sBuffer))
 
  If lResult <> 0 Then
    sFile = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)
  End If
 
  ' MP3-Datei öffnen
  mciSendString "open " & sFile & " type MPEGVideo alias myMP3", 0, 0, 0
 
  SendCommand "play myMP3 from 0"
End Sub
 
' MP3-Datei schließen
Public Sub CloseMP3()
  mciSendString "close myMP3", 0, 0, 0
End Sub
 
' Kommando senden und "Ergebnis" zurückgeben
Private Function SendCommand(ByVal sCmd As String) As Long
  Dim lResult As Long
  Dim sReturn As String
 
  sReturn = Space$(256)
  lResult = mciSendString(sCmd, sReturn, Len(sReturn), 0&)
 
  SendCommand = Val(sReturn)
End Function
 
Private Sub MusicTimer_Timer()
   ' Status abfragen und ggf. Abspielvorgang von
  ' vorne beginnen
  Dim lCurPos As Long
  Dim lLength As Long
 
  ' aktuelle Position
  lCurPos = SendCommand("status myMP3 position")
 
  ' Gesamtspielzeit
  lLength = SendCommand("status myMP3 length")
 
  ' Prüfen, ob am Ende angelangt und ggf.
  ' Abspielvorgang von vorne beginnen
  If lCurPos >= lLength Then
    SendCommand ("play myMP3 from 0")
  End If
End Sub