'mdlPlayMP3.bas
 
Option Explicit
Private Dateiname_kurz As String 'Der DOS-Format Dateiname der Mp3 Datei.
Private Slash As String 'Falls das Programm direkt auf einem Laufwerk 
' ausgeführt wird.
Private RetVal As Variant
Private Temp As String * 255
 
Public Declare Function GetShortPathName Lib "kernel32" Alias _
  "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As _
  String, ByVal cchBuffer As Long) As Long
    'Diese API wandelt Lange Dateinamen (Windows-Format) in kurze
    '(DOS-Format) um.
 
Public 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
    'Diese API ist im stande Mp3 Dateien abzuspielen.
 
Public Sub play_MP3(ByVal aktion As Integer)
    Select Case aktion
        Case 1
            RetVal = mciSendString("open " & Dateiname_kurz & " type MPEGVideo" & _
              "Alias Mp3", "", 0, 0)
            RetVal = mciSendString("play Mp3", "", 0, 0)
        Case 2
            RetVal = mciSendString("open " & Dateiname_kurz & " type MPEGVideo" & _
              "Alias Mp3", "", 0, 0)
            RetVal = mciSendString("play Mp3 repeat", "", 0, 0)
        Case 3
            RetVal = mciSendString("stop Mp3", "", 0, 0)
        Case 4
            RetVal = mciSendString("close Mp3", "", 0, 0)
        Case Else
            MsgBox ("Falscher Übergabewert in SUB play_MP3")
    End Select
End Sub
 
Public Sub set_MP3(ByVal dateiname As String)
    RetVal = GetShortPathName(dateiname, Temp, 255)
    Dateiname_kurz = Left(Temp, RetVal)
End Sub
 
Public Function check_Mp3(ByVal aktion As Integer) As Variant
   Dim sreturn As String
 
   sreturn = Space$(256)
   Select Case aktion
        Case 1
            RetVal = mciSendString("status Mp3 position", sreturn, Len( _
              sreturn), 0)
            check_Mp3 = Val(sreturn)
        Case 2
            RetVal = mciSendString("status Mp3 length", sreturn, Len(sreturn), _
              0)
            check_Mp3 = Val(sreturn)
        Case Else
            MsgBox ("Falscher Übergabewert in SUB check_MP3")
   End Select
End Function

Private Sub Command1_Click()
  play_MP3 (1)
End Sub

Private Sub Command1_Click()
Dim file as String
 
  With CommonDialog1
    .CancelError = True
    .Filter = "Mp3 Dateien (*.mp3)|*.mp3"
    .ShowOpen
    If Err = 0 Then
      file = .filename
    End If
  End With  
 
  play_MP3 (4)
  set_MP3 (file)
  play_MP3 (1)
End Sub

. semper fidelis