Import M3U 3.3 - Updated 09/03/2010

[trixmoto]

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.

Code: Select all

'
' MediaMonkey Script
'
' NAME: ImportM3U 3.3
'
' AUTHOR: trixmoto (http://trixmoto.net)
' DATE : 09/03/2010
'
' 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: Added explicit transaction to fix commit errors
'

Option Explicit

Dim IgnoreExt : IgnoreExt = False
Dim IgnorePun : IgnorePun = False
Dim CreateNew : CreateNew = False
Dim CreateLog : CreateLog = False
Dim AppendNew : AppendNew = 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 res : res = ini.StringValue("Scripts","LastImportM3UDir")
  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 res = "" Then
    dlg.InitDir = SDB.MyMusicPath
  Else
    dlg.InitDir = res
  End If
  dlg.ShowOpen
  If Not dlg.Ok Then
    Exit Sub
  End If
  res = dlg.FileName
  ini.StringValue("Scripts","LastImportM3UDir") = Left(res,InStrRev(res,"\"))
 
  '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 Not (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 file
  Dim prog : Set prog = SDB.Progress
  prog.Text = "Opening: "&res
  prog.Value = 0
  prog.MaxValue = 10
  SDB.ProcessMessages
  Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
  If fso.FileExists(res) Then
    Dim file : Set file = fso.OpenTextFile(res,1,False)
    Dim name : name = fso.getFileName(res)
    name = Mid(name,1,InStrRev(name,".")-1)
    prog.Text = "Creating playlist: "&name
    SDB.ProcessMessages
    Dim total : total = 0
    Dim count : count = 0
    Dim found : found = 0
    Dim mess : mess = ""   
    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
    End If
   
    'add tracks
    Do While Not (file.AtEndOfStream)
      Dim line : line = file.ReadLine
      mess = line
      If Not (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
        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     
        SDB.Database.BeginTransaction
        Dim sql : sql = "AND (Songs.SongPath LIKE '%\"&line&"')"
        Dim trax : Set trax = SDB.Database.QuerySongs(sql)
        If trax.EOF Then
          If CreateLog Then
            Call debug("Not found: "&mess&VbCrLf&"**"&sql)
          End If
          If CreateNew Then
            Dim itm : Set itm = SDB.NewSongData
            itm.Path = mess
            itm.ReadTags
            itm.UpdateDB
            If itm.Title = "" Then
              itm.MetadataFromFilename
              itm.UpdateDB           
            End If
            itm.UpdateArtist
            itm.UpdateAlbum
            If AppendNew Then
              count = count + 1
              Call list.AddTrack(itm)
            End If
          End If
        Else
          found = found + 1
        End If
        While Not trax.EOF
          count = count + 1
          Call list.AddTrack(trax.Item)
          trax.Next
          SDB.ProcessMessages
          If prog.Terminate Then
            Call file.Close()
            SDB.Database.Commit
            Exit Sub
          End If         
        WEnd
        SDB.Database.Commit       
      End If
      SDB.ProcessMessages
      If prog.Terminate Then
        Call file.Close()
        Exit Sub
      End If
    Loop
   
    'close file
    prog.Text = "Closing: "&res
    SDB.ProcessMessages
    Call file.Close()
    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
   
    'show playlist
    On Error Resume Next
    Dim node : Set node = SDB.MainTree.Node_Playlists
    node.Expanded = True
    Set node = SDB.MainTree.FirstChildNode(node)
    While Not node.Caption = name
      Set node = SDB.MainTree.NextSiblingNode(node)
      If Not (Err.Number = 0) Then
        Exit Sub
      End If
    WEnd
    On Error Resume Next
    SDB.MainTree.CurrentNode = node
  Else
    Call SDB.MessageBox("This playlist could not be found",mtError,Array(mbOk))
  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 wsh : Set wsh = CreateObject("WScript.Shell")
  Dim loc : loc = wsh.ExpandEnvironmentStrings("%TEMP%")
  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)
  logf.WriteLine(txt)
  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

[trixmoto]

New version is hugely more efficient and no longer needs the tracks to be in the main window.

NEW CODE ABOVE

[trixmoto]

This version has a few bugs fixed. It has been pointed out that MM actually does a rather good job of this so this script is in fact pointless. So this will be the final version!

NEW VERSION ABOVE

[trixmoto]

New version (2.2) is now useful again! It can be downloaded from my website. Changes include...

- Now searches for filename in database, not full path
- Added open file dialog
- Added focus set to playlist after import

[wolfzell]

Thanx for the script. This is very useful.

Still I have two questions:

Is there also an export script to export all playlists in MM to m3u files?

And: Would it be possible for you to change the script in such a way that it ignores the file extension?

Because: I changed all my files to flac on my main system. On the road I have mp3 versions on the notebook to charge my iPod. It would be very handy if I could exchange the playlists without editing them every time.

The filenames are the same on both systems of course, just the extension is different.

bye
Wolfgang

[trixmoto]

1) Try "File, Export to Playlist" or Ctrl+W.

2) I will incorporate this in the next version.

[trixmoto]

New version (2.3) has the option to ignore file extensions. You'll need to edit the variable in the scriptfile.

[wolfzell]

1) Try "File, Export to Playlist" or Ctrl+W.

Maybe I am stupid, but I don't quite get it. If I have about 50 playlists in MediaMonkey that I want to export to my notebook, how can I export all playlists at once this way?

2) I will incorporate this in the next version.

Yeehaw! Thank you *SO* much!

bye
Wolfgang

[trixmoto]

There is a script that is shipped with MM called "ExportM3Us" - use that to do many at once.

Have you tried the new version? Does it work for you?

[grmbrand]

Hey there--
I installed your script, but when I run it, I see the following:

Error
There was a problem querying the database:
22018:[Microsoft][ODBC Microsoft Access Driver] Invalid pattern string

I hit the cancel button on that alert and then I see:

Error
Error #-2147418113 - SongsDB.SDBDatabase
22018:[Microsoft][ODBC Microsoft Access Driver] Invalid pattern string
File: "C:\Program Files\MediaMonkey\Scripts\ImportM3U.vbs", Line: 65, Column:19

I hit the OK button and then I see:

Error
Error happened during script execution:
22018:[Microsoft][ODBC Microsoft Access Driver] Invalid pattern string

I hit the OK button again and then I am back in MediaMonkey.

Any ideas? Do I need to update something?

Thanks,
Grmbrand

[trixmoto]

Can you open the script file in a text editor and insert this line...

Code: Select all

Call debug(sql)

...before line 65, which is...

Code: Select all

Dim trax : Set trax = SDB.Database.QuerySongs(sql)

This will create a logfile called "ImportM3U.vbs.log" in the same folder - could you email me this logfile?

[grmbrand]

I've sent it along, but for the history books, the log file is:

Code: Select all

AND (Songs.SongPath LIKE '%\E:/Media/Music/Compilations/Chosen_ Absolutely Kosher Records Sample/04 Riot Act.mp3')
AND (Songs.SongPath LIKE '%\E:/Media/Music/Röyksopp/Melody A.M_/01 So Easy.mp3')
AND (Songs.SongPath LIKE '%\E:/Media/Music/Love and Rockets/Seventh Dream of Teenage Heaven/07 Saudade.mp3')
AND (Songs.SongPath LIKE '%\E:/Media/Music/Divination/Ambient Dub, Vol. 2 - Dead Slow/05 Dream Light.mp3')
AND (Songs.SongPath LIKE '%\E:/Media/Music/The Alan Parsons Project/Eye in the Sky/02 Eye in the Sky.mp3')
AND (Songs.SongPath LIKE '%\E:/Media/Music/Incubus/Make Yourself/08 Drive.mp3')
AND (Songs.SongPath LIKE '%\E:/Media/Music/Fila Brazillia/Brazilification/1-08 Freedom (feat. Dj Food).mp3')
AND (Songs.SongPath LIKE '%\E:/Media/Music/Pendulum/Hold Your Colour/03 Plasticworld (feat. Fats & TC).mp3')
AND (Songs.SongPath LIKE '%\E:/Media/Music/Matisyahu/Shake Off the Dust... ARISE/04 King Without A Crown.mp3')
AND (Songs.SongPath LIKE '%\E:/Media/Music/Compilations/Hed Kandi_ Serve Chilled, Vol. 2 [Disc 1/1- 07 Eyes on You [4Hero Mix].mp3')

I'm guessing that some character in the last line wasn't properly escaped? I'm not a VB coder, so I'm not sure how it handles some of these special characters.

[bbrodka]

This is an outstanding script! Well done

One request, something easy (I hope)
Could you create a log for files that were NOT matched fir later review with a text editor?
It would be nice to see which songs did not get imported properly from long m3u playlists

Keep up the great work, us non-programers apreciate your work

[wolfzell]

There is a script that is shipped with MM called "ExportM3Us" - use that to do many at once.

Oh my, I never noticed it, so thank you for telling me. I *never* would have searched for such a function under "Create Reports"...

Have you tried the new version? Does it work for you?

Not yet. My external harddisk with the MP3s is in my other appartment and I won't be there before monday. You are a lot faster dishing out those scripts than I am testing them.

I will give you a note when I have tested it.

Thanks once more for your help.

bye
Wolfgang

[trixmoto]

New version (2.4) is now available from my website. The problem with some filenames causing SQL errors has been fixed, and any files not found are reported in the logfile. Please note this file is continuous, it does not clear itself between runs.

Thanks all for your kind words, always greatly recieved!