VB 5/6-Tipp 0584: m3u-Playlists auslesen

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
' Die Komponente 'Microsoft Common Dialog Control 6.0 (SP3) (COMDLG32.OCX)' wird benötigt.
' Die Komponente 'Microsoft Windows Common Controls 6.0 (SP6) (MsComCtl.ocx)' wird benötigt.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Listenanzeigesteuerungselement "ListView1"
' Steuerelement: Standarddialog-Steuerelement "CommonDialog1"
' Steuerelement: Schaltfläche "Command1"
'Hauptfunktion zum Auslesen udn einfügen in die ListView
Private Function ReadM3U(ByVal sFilename As String, LV_Playlist _
    As ListView) As Boolean
    
  Dim Textzeile As String
  Dim Zeile As Long
  Dim Wrong As Boolean
  Dim LastZeile As String
  Dim strLVText As String
  Dim stred As Long
  Dim Laenge As String
  Dim Laenge_Text As String
  Dim FileTitle As String
  Dim FileExt As String
  Dim Laenge_tmp
  Dim F As Integer
    
    On Error Goto ErrHandler
    With LV_Playlist
      ' ListView-Spalten erstellen
      .Sorted = False
      .View = lvwReport
      .ColumnHeaders.Clear
      .ColumnHeaders.Add , , "Titel / Dateiname", .Width - 1600
      .ColumnHeaders.Add , , "Länge", 1000, 1
      
      ' ListView-Einträge löschen
      .ListItems.Clear
      
      ' Playlist auslesen
      Zeile = 0
      F = FreeFile
      Open sFilename For Input As #F
      
      ' Schleife bis Dateiende
      Do While Not EOF(F)
        Zeile = Zeile + 1
        
        ' Zeile in Variable einlesen.
        Line Input #F, Textzeile
        If Zeile = 1 And Textzeile <> "#EXTM3U" Then
          Wrong = True
        End If
        
        If Left$(LastZeile, 8) = "#EXTINF:" Then
          ' zusätzliche Infos der zuletzt eingelesenen
          ' Zeile auswerten
          strLVText = Right$(LastZeile, Len(LastZeile) - 8)
          
          ' Länge (Spieldauer) ermitteln
          stred = InStr(strLVText, ",")
          If stred > 0 Then
            Laenge = Left$(strLVText, stred - 1)
            Laenge_Text = Format(Laenge / 60, "00.00")
            Laenge_Text = ReplaceM(Laenge_Text, ",", ":", ".", _
                ":")
            strLVText = Right$(strLVText, Len(strLVText) - stred)
            Laenge_tmp = ""
             stred = 0
            
            stred = InStr(Laenge_Text, ":")
            If stred > 0 Then
              Laenge_tmp = Right$(Laenge_Text, Len(Laenge_Text) _
                  - stred)
              Laenge_tmp = Format((Laenge_tmp / 99) * 60, "0")
              Laenge_tmp = Format(Laenge_tmp, "00")
              Laenge_Text = Left$(Laenge_Text, stred - 1) & ":" _
                  & Laenge_tmp
            End If
          End If
          
          ' Titel
          FileTitle = GetFileFromPath(Textzeile)
          FileExt = GetFileExt(FileTitle)
          If FileExt <> "" Then
            FileExt = "." & FileExt
          End If
          FileTitle = Left$(FileTitle, Len(FileTitle) - _
              Len(FileExt))
          
          ' Aktuellen Titel im ListView anzeigen
          If FileTitle <> strLVText Then
            .ListItems.Add , , strLVText & " - [" & Textzeile & _
                "]"
          Else
            .ListItems.Add , , strLVText
          End If
          .ListItems(.ListItems.Count).SubItems(1) = Laenge_Text
        End If
        LastZeile = Textzeile
      Loop
      
      ' Datei schließen.
      Close #F
    End With
    
ErrHandler:
    If Err > 0 Then
      Wrong = True
    End If
    ReadM3U = (Wrong = False)
End Function

' String-Ersetzen
Function ReplaceM(ByVal FromStr As String, ParamArray _
    varReplacements() As Variant) As String
    
  Dim intMacro As Integer
  Dim strResString As String
  Dim nFrom As Integer
  Dim nTo As Integer
  Dim strMacro As String
  Dim strValue As String
    
    On Error Resume Next
    strResString = FromStr
    
    ' Für jedes übergebene Makro/Wert-Paar...
    nFrom = LBound(varReplacements)
    nTo = UBound(varReplacements)
    For intMacro = nFrom To nTo Step 2
      strMacro = varReplacements(intMacro)
      strValue = varReplacements(intMacro + 1)
      On Error Goto 0
      
      ' Ersetzen aller vorkommenden strMacro
      ' durch strValue
  Dim intPos As Integer
      Do
        intPos = InStr(strResString, strMacro)
        If intPos > 0 Then
          strResString = Left$(strResString, intPos - 1) & _
              strValue & Right$(strResString, Len(strResString) _
              - Len(strMacro) - intPos + 1)
        End If
      Loop Until intPos = 0
    Next intMacro
    
    ReplaceM = strResString
    On Error Goto 0
    Exit Function
End Function
' Ermittelt die Dateierweiterung eines Dateinamens
Function GetFileExt(Pfadname As String)
  Dim Dateinamen As String
  Dim Länge As Integer
  Dim n As Integer
  Dim Position As Integer
    
    Länge = Len(Pfadname)
    Do
      n = InStr(n + 1, Pfadname, ".")
      If n = 0 Then
        Exit Do
      End If
      Position = n
    Loop
    
    If Position <> 0 Then
      GetFileExt = StrConv(Right$(Pfadname, Länge - Position), _
          vbUpperCase)
    End If
End Function
' Filtert Playlist namen
Function GetFileFromPath(Pfadname As String)
  Dim Dateinamen As String
  Dim Länge As Integer
  Dim n As Integer
  Dim Position As Integer
    
    Länge = Len(Pfadname)
    Do
      n = InStr(n + 1, Pfadname, "\")
      If n = 0 Then
        Exit Do
      End If
      Position = n
    Loop
    
    GetFileFromPath = Right$(Pfadname, Länge - Position)
End Function

Private Sub Command1_Click()
    On Error Resume Next
    ' wenn ma der User nix auswählt ;)
    'Commondialog Initialisieren
    With CommonDialog1
      .DialogTitle = "Playlist Öffnen"
      .Filter = "Playlists|*.m3u"
      .InitDir = "C:\"
      .ShowOpen
    End With
    
    'Playlist Laden
    ReadM3U CommonDialog1.FileName, ListView1
    
End Sub

'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------