音乐文件列表也是个不容忽视的问题，自己定个格式当然可以，但好在大家熟悉的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
本文地址：http://com.8s8s.com/it/it41199.htm