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