Import M3U 3.8 - Updated 26/10/2013
Posted: Mon Nov 28, 2005 7:26 am
As requested, here is a script that imports M3U playlists, creating a playlist named the same as the filename (minus extension).
An installer for this script can be found on my website.
An installer for this script can be found on my website.
Code: Select all
'
' MediaMonkey Script
'
' NAME: ImportM3U 3.8
'
' AUTHOR: trixmoto (http://trixmoto.net)
' DATE : 26/10/2013
'
' INSTALL: Copy to Scripts directory and add the following to Scripts.ini
' Don't forget to remove comments (') and set the order appropriately
'
' [ImportM3U]
' FileName=ImportM3U.vbs
' ProcName=ImportM3U
' Order=10
' DisplayName=ImportM3U
' Description=Import M3U playlist
' Language=VBScript
' ScriptType=0
'
' FIXES: Fixed WriteLock/ReadLock errors
' Fixed fuzzy matching of filenames
' Added additional debug messaging
'
Option Explicit
Dim IgnoreExt : IgnoreExt = False
Dim IgnorePun : IgnorePun = False
Dim CreateNew : CreateNew = False
Dim CreateLog : CreateLog = False
Dim AppendNew : AppendNew = False
Dim ImportDir : ImportDir = False
Sub ImportM3U
Dim ini : Set ini = SDB.IniFile
If ini.ValueExists("ImportM3U","IgnoreExt") Then
IgnoreExt = ini.BoolValue("ImportM3U","IgnoreExt")
Else
ini.BoolValue("ImportM3U","IgnoreExt") = IgnoreExt
End If
If ini.ValueExists("ImportM3U","IgnorePun") Then
IgnorePun = ini.BoolValue("ImportM3U","IgnorePun")
Else
ini.BoolValue("ImportM3U","IgnorePun") = IgnorePun
End If
If ini.ValueExists("ImportM3U","CreateNew") Then
CreateNew = ini.BoolValue("ImportM3U","CreateNew")
Else
ini.BoolValue("ImportM3U","CreateNew") = CreateNew
End If
If ini.ValueExists("ImportM3U","CreateLog") Then
CreateLog = ini.BoolValue("ImportM3U","CreateLog")
Else
ini.BoolValue("ImportM3U","CreateLog") = CreateLog
End If
If ini.ValueExists("ImportM3U","AppendNew") Then
AppendNew = ini.BoolValue("ImportM3U","AppendNew")
Else
ini.BoolValue("ImportM3U","AppendNew") = AppendNew
End If
'get filename
Dim dir : dir = ini.StringValue("Scripts","LastImportM3UDir")
Dim res : res = SDB.SelectFolder(dir,"Select folder of playlists:")
If res = "" Then
ImportDir = False
Dim dlg : Set dlg = SDB.CommonDialog
dlg.DefaultExt = ".m3u"
dlg.Filter = "Playlists (*.m3u)|*.m3u|Unicode playlists (*.m3u8)|*.m3u8|All files (*.*)|*.*"
dlg.Flags = cdlOFNOverwritePrompt+cdlOFNHideReadOnly+cdlOFNNoChangeDir
If dir = "" Then
dlg.InitDir = SDB.MyMusicPath
Else
dlg.InitDir = dir
End If
dlg.ShowOpen
If Not dlg.Ok Then
Exit Sub
End If
res = dlg.FileName
ini.StringValue("Scripts","LastImportM3UDir") = Left(res,InStrRev(res,"\"))
Else
ImportDir = True
If Right(res,1) <> "\" Then
res = res&"\"
End If
ini.StringValue("Scripts","LastImportM3UDir") = res
End If
'confirmation
'show confirmation screen
Dim Form : Set Form = SDB.UI.NewForm
Form.Common.SetRect 100, 100, 270, 210
Form.BorderStyle = 3 ' Non-Resizable
Form.FormPosition = 4 ' Screen Center
Form.SavePositionName = "ImportM3UPos"
Form.Caption = "Import M3U"
Dim ChkIgnoreExt : Set ChkIgnoreExt = SDB.UI.NewCheckbox(Form)
ChkIgnoreExt.Common.Left = 10
ChkIgnoreExt.Common.Top = 10
ChkIgnoreExt.Common.Width = 265
ChkIgnoreExt.Caption = "Ignore track extension?"
ChkIgnoreExt.Checked = IgnoreExt
Dim ChkIgnorePun : Set ChkIgnorePun = SDB.UI.NewCheckbox(Form)
ChkIgnorePun.Common.Left = 10
ChkIgnorePun.Common.Top = ChkIgnoreExt.Common.Top +25
ChkIgnorePun.Common.Width = 265
ChkIgnorePun.Caption = "Ignore punctuation in filename?"
ChkIgnorePun.Checked = IgnorePun
Dim ChkCreateNew : Set ChkCreateNew = SDB.UI.NewCheckbox(Form)
ChkCreateNew.Common.Left = 10
ChkCreateNew.Common.Top = ChkIgnorePun.Common.Top +25
ChkCreateNew.Common.Width = 265
ChkCreateNew.Caption = "Create tracks not found in library?"
ChkCreateNew.Checked = CreateNew
Dim ChkAppendNew : Set ChkAppendNew = SDB.UI.NewCheckbox(Form)
ChkAppendNew.Common.Left = 10
ChkAppendNew.Common.Top = ChkCreateNew.Common.Top +25
ChkAppendNew.Common.Width = 265
ChkAppendNew.Caption = "Include created tracks in playlist?"
ChkAppendNew.Checked = AppendNew
Dim ChkCreateLog : Set ChkCreateLog = SDB.UI.NewCheckbox(Form)
ChkCreateLog.Common.Left = 10
ChkCreateLog.Common.Top = ChkAppendNew.Common.Top +25
ChkCreateLog.Common.Width = 265
ChkCreateLog.Caption = "Create logfile in temporary directory?"
ChkCreateLog.Checked = CreateLog
Dim BtnCancel : Set BtnCancel = SDB.UI.NewButton(Form)
BtnCancel.Caption = "&Cancel"
BtnCancel.Cancel = True
BtnCancel.ModalResult = 2
BtnCancel.Common.Left = Form.Common.Width - BtnCancel.Common.Width -20
BtnCancel.Common.Top = ChkCreateLog.Common.Top +30
Dim BtnOk : Set BtnOk = SDB.UI.NewButton(Form)
BtnOk.Caption = "&Ok"
BtnOk.Default = True
BtnOk.ModalResult = 1
BtnOk.Common.Left = BtnCancel.Common.Left - BtnOk.Common.Width -10
BtnOk.Common.Top = BtnCancel.Common.Top
'show form
If Form.ShowModal <> 1 Then
Exit Sub
End If
'save settings
IgnoreExt = ChkIgnoreExt.Checked
IgnorePun = ChkIgnorePun.Checked
CreateNew = ChkCreateNew.Checked
AppendNew = ChkAppendNew.Checked
CreateLog = ChkCreateLog.Checked
ini.BoolValue("ImportM3U","IgnoreExt") = IgnoreExt
ini.BoolValue("ImportM3U","IgnorePun") = IgnorePun
ini.BoolValue("ImportM3U","CreateNew") = CreateNew
ini.BoolValue("ImportM3U","AppendNew") = AppendNew
ini.BoolValue("ImportM3U","CreateLog") = CreateLog
'read folder
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim dic : Set dic = CreateObject("Scripting.Dictionary")
Dim dat : Set dat = Nothing
Dim prog : Set prog = SDB.Progress
Dim name : name = ""
Dim i : i = 1
Dim j : j = 0
Dim k : k = 0
If ImportDir Then
Dim f : Set f = fso.GetFolder(res)
Dim fs : Set fs = f.Files
For Each f In fs
Dim n : n = UCase(f.Name)
If (Right(n,4) = ".M3U") Or (Right(n,5) = ".M3U8") Then
j = j+1
dic.Item("#"&j) = res&f.Name
End If
Next
Else
j = 1
End If
'read file
For i = 1 To j
If j = 1 Then
If ImportDir Then
res = dic.Item("#1")
End If
prog.Text = "Opening file: "&res
Else
res = dic.Item("#"&i)
prog.Text = "Opening file "&i&" of "&j&": "&res
End If
prog.Value = 0
prog.MaxValue = 10
SDB.ProcessMessages
If fso.FileExists(res) Then
If CreateLog Then debug("(Open)"&res)
Dim file : Set file = fso.OpenTextFile(res,1,False)
name = fso.getFileName(res)
name = Mid(name,1,InStrRev(name,".")-1)
prog.Text = "Creating playlist: "&name
SDB.ProcessMessages
'check playlist name
Dim total : total = 0
Dim count : count = 0
Dim found : found = 0
Dim mess : mess = ""
Dim indx : Set indx = SDB.NewStringList
Dim list : Set list = SDB.PlaylistByTitle("").CreateChildPlaylist(name)
If list.Tracks.Count > 0 Then
mess = "Playlist '"&name&"' already exists with "&list.Tracks.Count&" tracks, do you wish to overwrite this playlist?"
mess = mess&Chr(13)&Chr(13)&"Click 'Yes' to overwrite and 'No' to append."
Select Case SDB.MessageBox(mess,mtConfirmation,Array(mbYes,mbNo,mbCancel))
Case mrYes
Call list.Clear()
Case mrNo
'do nothing
Case Else
Exit Sub
End Select
If CreateLog Then Call debug("Updating playlist: "&list.ID)
Else
If CreateLog Then Call debug("Creating playlist: "&list.ID)
End If
'add tracks
Do While Not (file.AtEndOfStream)
Dim line : line = file.ReadLine
mess = line
If Left(line,1) <> "#" Then
prog.Value = total
total = total+1
If total > prog.MaxValue Then
prog.MaxValue = total
End If
prog.Text = "Processing track "&total&" (found: "&found&") - "&mess
SDB.ProcessMessages
'process line
line = Mid(line,InStrRev(line,"\")+1)
If IgnoreExt Then
If InStr(line,".") > 0 Then
line = Left(line,InStrRev(line,"."))&"%"
End If
End If
If IgnorePun Then
line = RemovePunctuation(line)
Else
line = Replace(line,"'","''")
End If
Dim boo : boo = False
If Left(line,1) = "%" Then
line = Mid(line,2)
End If
If Right(line,1) = "%" Then
line = Left(line,Len(line)-1)
End If
line = Replace(line,"%","%' AND SongPath LIKE '%")
Dim sql : sql = "AND (Songs.SongPath LIKE '%"&line&"%')"
Dim tid : tid = -1
'check library
Set dat = SDB.Database
If CreateLog Then Call debug("#BEGINTRANSACTION")
Call dat.BeginTransaction()
If CreateLog Then Call debug("#"&sql)
Dim trax : Set trax = dat.QuerySongs(sql)
If trax.EOF Then
If CreateLog Then Call debug("Not found: "&mess)
boo = True
Else
found = found+1
While Not trax.EOF 'loop through library tracks
count = count+1
tid = CStr(trax.Item.ID)
If CreateLog Then Call debug("Found: "&tid)
Call indx.Add(tid) 'add track to playlist
trax.Next
SDB.ProcessMessages
If prog.Terminate Then
Set trax = Nothing
If CreateLog Then Call debug("#COMMIT")
Call dat.Commit()
If CreateLog Then debug("(Close)"&res)
Call file.Close()
Exit Sub
End If
WEnd
End If
Set trax = Nothing
If CreateLog Then Call debug("#COMMIT")
Call dat.Commit()
Set dat = Nothing
'add track not in library
If boo And CreateNew Then
Set dat = SDB.Database
If CreateLog Then Call debug("#BEGINTRANSACTION")
Call dat.BeginTransaction()
Dim itm : Set itm = SDB.NewSongData
itm.Path = mess
Call itm.ReadTags()
If CreateLog Then Call debug("#UPDATEDB")
Call itm.UpdateDB()
If itm.Title = "" Then
Call itm.MetadataFromFilename()
If CreateLog Then Call debug("#UPDATEDB")
Call itm.UpdateDB()
End If
Call itm.UpdateArtist()
Call itm.UpdateAlbum()
If CreateLog Then Call debug("#COMMIT")
Call dat.Commit()
Set dat = Nothing
tid = CStr(itm.ID)
If CreateLog Then Call debug("Created: "&tid)
'add track to playlist
If AppendNew Then
count = count+1
Call indx.Add(tid)
End If
End If
End If
SDB.ProcessMessages
If prog.Terminate Then
If CreateLog Then debug("(Close)"&res)
Call file.Close()
Exit Sub
End If
Loop
'close file
If j = 1 Then
prog.Text = "Closing file: "&res
Else
prog.Text = "Closing file "&i&" of "&j&": "&res
End If
SDB.ProcessMessages
If CreateLog Then debug("(Close)"&res)
Call file.Close()
'update playlist
If indx.Count > 0 Then
For k = 0 To indx.Count-1
Dim t : t = CLng(indx.Item(k))
If CreateLog Then Call debug("Adding to playlist: "&t)
Call list.AddTrackById(t)
Next
End If
If CreateLog Then Call debug("Finished")
'show message
If j = 1 Then
If count = total Then
If count = 0 Then
Call SDB.MessageBox("No tracks were imported.",mtError,Array(mbOk))
Else
Call SDB.MessageBox("Playlist successfully imported.",mtInformation,Array(mbOk))
End If
Else
If count < total Then
Call SDB.MessageBox("Some tracks are missing in this playlist.",mtError,Array(mbOk))
Else
Call SDB.MessageBox("Some tracks appear more than once in this playlist.",mtError,Array(mbOk))
End If
End If
End If
Else
If j = 1 Then
Call SDB.MessageBox("Playlist could not be found",mtError,Array(mbOk))
End If
End If
Next
'show playlist
If name <> "" Then
On Error Resume Next
Dim tree : Set tree = SDB.MainTree
Dim node : Set node = tree.Node_Playlists
node.Expanded = True
Set node = tree.FirstChildNode(node)
While node.Caption <> name
Set node = tree.NextSiblingNode(node)
If Err.Number <> 0 Then
Exit Sub
End If
WEnd
tree.CurrentNode = node
On Error Resume Next
End If
End Sub
Function RemovePunctuation(str)
Dim i : i = 0
For i = 1 To Len(str)
Dim pos : pos = Mid(str,i,1)
If InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789ÅÄÂÃÁÀÆËÊÉÈÏÎÍÌÖÔÕÓÒØÜÛÚÙÝÇÐÑß",UCase(pos)) = 0 Then
pos = "%"
End If
RemovePunctuation = RemovePunctuation&pos
Next
While (InStr(RemovePunctuation,"%%") > 0)
RemovePunctuation = Replace(RemovePunctuation,"%%","%")
WEnd
End Function
Sub debug(txt)
Dim loc : loc = SDB.TemporaryFolder
If Right(loc,1) = "\" Then
loc = loc&"ImportM3U.log"
Else
loc = loc&"\ImportM3U.log"
End If
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim logf : Set logf = fso.OpenTextFile(loc,8,True)
Call logf.WriteLine(txt)
Call logf.Close()
End Sub
Sub Install()
Dim inip : inip = SDB.ApplicationPath&"Scripts\Scripts.ini"
Dim inif : Set inif = SDB.Tools.IniFileByPath(inip)
If Not (inif Is Nothing) Then
inif.StringValue("ImportM3U","Filename") = "ImportM3U.vbs"
inif.StringValue("ImportM3U","Procname") = "ImportM3U"
inif.StringValue("ImportM3U","Order") = "10"
inif.StringValue("ImportM3U","DisplayName") = "Import M3U"
inif.StringValue("ImportM3U","Description") = "Import M3U playlist"
inif.StringValue("ImportM3U","Language") = "VBScript"
inif.StringValue("ImportM3U","ScriptType") = "0"
SDB.RefreshScriptItems
End If
End Sub