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