無外部控制項製作多媒體播放器(四)

來源:互聯網
上載者:User
控制項|媒體
音樂檔案清單也是個不容忽視的問題,自己定個格式當然可以,但好在大家熟悉的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


相關文章

E-Commerce Solutions

Leverage the same tools powering the Alibaba Ecosystem

Learn more >

Apsara Conference 2019

The Rise of Data Intelligence, September 25th - 27th, Hangzhou, China

Learn more >

Alibaba Cloud Free Trial

Learn and experience the power of Alibaba Cloud with a free trial worth $300-1200 USD

Learn more >

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。