音乐文件列表也是个不容忽视的问题,自己定个格式当然可以,但好在大家熟悉的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 
|