No external controls make multimedia player (d)

Source: Internet
Author: User
Tags count goto split trim
Controls | media
Music file list is also a problem that can not be ignored, I set a format of course, but fortunately we are familiar with the M3U format is not complex, MediaPlayer or Winamp support it, versatility is better than WPL, so I would like to introduce the M3U format file production and read-write

M3U is a text file, beginning with #extm3u, each music entry takes up 1-2 lines, and when there is extended information, the first line takes #extinf: The second line is the filename; when there is no extended information, it is simply a row, the file name can contain a path, or it may not be included. Not included when the music file should be in the same directory as the m3u file.

The whole format is so simple, the following is the read function, and the Save function, read the return is a m3u set, each collection item for a music message string, want to get the specific content of this string, can be Getm3uinfo function to return musicinfo structure.

The Save function is not perfect, you need to pass in a m3u collection, because using the collection to pass M3U string information, each entry can only add delete, cannot be directly modified. If you are interested, you can take a class package musicinfo structure and provide modification functionality.

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) <> vbarchive vbnullstring Then = True
Else
If Dir (S1, vbnormal or Vbhidden or vbreadonly or vbsystem) <> vbarchive vbnullstring
Blnaddok = True
Else
S1 = strFilePath & mid$ (S1, InStrRev (S1, "\") + 1)
If Dir (S1, vbnormal or Vbhidden or vbreadonly or vbsystem) <> vbarchive vbnullstring Then = 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 = "file:" & Tmpinfo. FileName
s = S & vbCrLf & "song name:" & Tmpinfo. Title
s = S & vbCrLf & "singer:" & Tmpinfo. Artist
s = S & vbCrLf & "Chichang:" & tmpinfo.length & "SEC"
MsgBox s
End If
End Sub

This is a code associated with the previous article, for some undefined functions, can be found in the previous article
Http://blog.csdn.net/homezj/archive/2005/04/15/349005.aspx


Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.