作者：未知 来源：月光软件站 加入时间：2005-5-13　月光软件站

音乐文件列表也是个不容忽视的问题，自己定个格式当然可以，但好在大家熟悉的M3U格式并不复杂，MediaPlayer或WinAmp都支持它，通用性也好，比起wpl要简易得多，所以我就来介绍一下M3U格式文件的制作与读写

M3U是文本文件，以#EXTM3U开头，每个音乐条目占1-2行，当存在扩展信息时，首行采用#EXTINF:开头，第二行才是文件名；当没有扩展信息时，只是简单的一行，就是文件名；文件名可包含路径，也可不包含，不包含时音乐文件应该是与M3U文件在同一目录下。

整个格式就这么简单，下面是读取函数，与保存函数，读取时返回的是一个M3U集合，每个集合项目为一首音乐信息的字符串，想获取这个串的具体内容， 可用GetM3UInfo函数返回MusicInfo结构。

保存函数不太完善，需传入一个M3U集合，因使用集合传递M3U字串信息，每个条目只能添加删除，不能直接修改。若有兴趣，可采取类封装MusicInfo结构，并提供修改功能。

Private Function LoadM3UFile(strFileName As String) As Collection
    Dim a() As String, s1 As String, s As String, i As Long, FileLine() As String
    Dim blnAddOK As Boolean, strFilePath As String, colTemp As Collection, LineNum As Long
    On Error GoTo fail
    Set colTemp = New Collection
    If Dir(strFileName) = vbNullString Then GoTo fail
    strFilePath = Left$(strFileName, InStrRev(strFileName, "\"))
    Open strFileName For Binary As #1
        s = Input(LOF(1), 1)
    Close
    If s = vbNullString Then GoTo fail
    i = InStr(1, s, "#EXTM3U", vbTextCompare)
    If i = 0 Then GoTo fail
    If i > 1 Then s = Mid$(s, i)
    s = Trim$(Replace$(s, vbCrLf & vbCrLf, vbCrLf))
    FileLine = Split(s, vbCrLf)
        Do While LineNum <= UBound(FileLine)
            s = Trim$(FileLine(LineNum))
            If s <> vbNullString Then
                blnAddOK = False
                If UCase$(Left$(s, 8)) <> "#EXTINF:" Then
                    If InStr(1, s, ":\") = 0 Then
                        s = strFilePath & s
                        If Dir(s, vbNormal Or vbHidden Or vbReadOnly Or vbSystem Or vbArchive) <> vbNullString Then blnAddOK = True
                    Else
                        If Dir(s, vbNormal Or vbHidden Or vbReadOnly Or vbSystem Or vbArchive) <> vbNullString Then
                            blnAddOK = True
                        Else
                            s = strFilePath & Mid$(s, InStrRev(s, "\") + 1)
                            If Dir(s, vbNormal Or vbHidden Or vbReadOnly Or vbSystem Or vbArchive) <> vbNullString Then blnAddOK = True
                        End If
                    End If
                    If blnAddOK Then
                        If GetMCIType(s) > 0 Then
                            colTemp.Add s, s
                        End If
                    End If
                Else
                    s = Mid$(s, 9)
                    LineNum = LineNum + 1
                    s1 = Trim$(FileLine(LineNum))
                    If s1 <> vbNullString Then
                        If InStr(1, s1, ":\") = 0 Then
                            s1 = strFilePath & s1
                            If Dir(s1, vbNormal Or vbHidden Or vbReadOnly Or vbSystem Or vbArchive) <> vbNullString Then blnAddOK = True
                        Else
                            If Dir(s1, vbNormal Or vbHidden Or vbReadOnly Or vbSystem Or vbArchive) <> vbNullString Then
                                blnAddOK = True
                            Else
                                s1 = strFilePath & Mid$(s1, InStrRev(s1, "\") + 1)
                                If Dir(s1, vbNormal Or vbHidden Or vbReadOnly Or vbSystem Or vbArchive) <> vbNullString Then blnAddOK = True
                            End If
                        End If
                        If blnAddOK Then
                            If GetMCIType(s1) > 0 Then
                                colTemp.Add s & vbCrLf & s1, s1
                            End If
                        End If
                    End If
                End If
            End If
            LineNum = LineNum + 1
        Loop
fail:
    Set LoadM3UFile = colTemp
End Function
Private Function SaveM3U(strFileName As String, colM3UList As Collection) As Boolean
    Dim FreeNo As Long, i As Long, a() As String
    On Error GoTo fail
    If colM3UListe.Count > 0 Then
        FreeNo = FreeFile
        Open strFileName For Output As #FreeNo
        Print #FreeNo, "#EXTM3U"
        For i = 1 To colM3UListe.Count
        a = Split(colM3UListe(i), vbCrLf)
        If UBound(a) > 0 Then
            Print #FreeNo, "#EXTINF:" & colM3UListe(i)
        Else
            Print #FreeNo, colM3UListe(i)
        End If
        Next
        Close #FreeNo
        SaveM3U = True
    End If
fail:
End Function
Private Function GetM3UInfo(M3UItem As String) As MusicInfo
    Dim a() As String, b() As String, tmpinfo As MusicInfo
    Dim i As Long, j As Long, k As Long, s As String
    If Trim(M3UItem) = vbNullString Then Exit Function
    a = Split(M3UItem, vbCrLf)
    If UBound(a) > 0 Then
        j = InStr(1, a(0), ",")
        k = InStr(1, a(0), "-")
        If j > 0 And k > 0 Then
            b = Split(a(0), ",")
            If Val(b(0)) > 0 Then tmpinfo.length = Val(b(0))
            b = Split(Trim$(b(1)), "-")
            If b(0) <> vbNullString Then tmpinfo.Artist = Trim$(b(0))
            If b(1) <> vbNullString Then
                tmpinfo.Title = Trim$(b(1))
            Else
                s = Trim$(a(1))
                i = InStrRev(s, "\")
                If i > 0 Then
                    tmpinfo.Title = Mid$(s, i + 1)
                Else
                    tmpinfo.Title = s
                End If
            End If
        End If
        tmpinfo.FileName = a(1)
    Else
        tmpinfo.FileName = a(0)
    End If
    GetM3UInfo = tmpinfo
End Function

Private Sub Command1_Click()
    Dim tmp As Collection, tmpinfo As MusicInfo, s As String
    Set tmp = LoadM3UFile(Text1.Text)
    If tmp.Count > 0 Then
        tmpinfo = GetM3UInfo(tmp(tmp.Count))
        s = "文件：" & tmpinfo.FileName
        s = s & vbCrLf & "歌名：" & tmpinfo.Title
        s = s & vbCrLf & "歌手：" & tmpinfo.Artist
        s = s & vbCrLf & "曲长：" & tmpinfo.length & "秒"
        MsgBox s
    End If
End Sub

这是一个与上篇相联系的代码，对于一些没定义的函数，可在前面的文章中找到
http://blog.csdn.net/homezj/archive/2005/04/15/349005.aspx

相关软件：