Page 1 of 9

iPlaylist Importer 1.6 - Updated 25/05/2008

Posted: Mon Nov 26, 2007 7:17 am
by trixmoto
This script imports XML playlists from iTunes and creates the playlists in the MM playlists node. Just run the script, select the XML file and then check out the playlists node. Any tracks which are not in your library will be created using the metadata from the XML file.

Code: Select all

' MediaMonkey Script
' NAME: iPlaylistImporter 1.6
' AUTHOR: trixmoto (
' DATE : 25/05/2008
' INSTALL: Copy to Scripts directory and add the following to Scripts.ini 
'          Don't forget to remove comments (') and set the order appropriately
' [iPlaylistImporter]
' FileName=iPlaylistImporter.vbs
' ProcName=iPlaylistImporter
' Order=30
' DisplayName=iPlaylist Importer
' Description=Import XML playlists from iTunes
' Language=VBScript
' ScriptType=0
' FIXES: Fixed trim function doesn't work with tabs

Option Explicit
Dim Debug : Debug = False

Sub iPlaylistImporter
  'get filename
  Dim dlg : Set dlg = SDB.CommonDialog
  dlg.Filter = "Playlist (XML)|*.xml"
  dlg.Flags = cdlOFNOverwritePrompt + cdlOFNHideReadOnly + cdlOFNNoChangeDir
  dlg.InitDir = SDB.MyMusicPath
  If Not dlg.Ok Then 
    Exit Sub 
  End If
  Dim xml : xml = dlg.FileName
  'create progress bar
  Dim prog : Set prog = SDB.Progress
  prog.Text = "iPlaylistImporter: Initialising..."
  prog.Value = 0
  prog.MaxValue = 1
  'create parent playlist
  Dim ply : Set ply = Nothing
  Dim par : Set par = SDB.PlaylistByTitle("iPlaylists")
  If par.Title = "" Then
    Set par = SDB.PlaylistByTitle("").CreateChildPlaylist("iPlaylists")
  End If
  If par Is Nothing Then
    Call SDB.MessageBox("iPlaylistImporter: Could not find or create 'iPlaylists' parent playlist.",mtError,Array(mbOk))
    Exit Sub
  End If
  'create logfile
  Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
  If Debug Then
    Dim wsh : Set wsh = CreateObject("WScript.Shell")
    Dim loc : loc = wsh.ExpandEnvironmentStrings("%TEMP%")&"\iPlaylistImporter.log"  
    Dim log : Set log = fso.CreateTextFile(loc,True)
    If log Is Nothing Then
      Debug = False
      Call log.WriteLine("Import file: "&xml)
    End If
  End If

  Dim mode : mode = 0
  Dim trid : trid = 0
  Dim fndt : fndt = 0
  Dim cret : cret = 0
  Dim fndp : fndp = 0
  Dim crep : crep = 0
  Dim dic : Set dic = CreateObject("Scripting.Dictionary")
  Dim dat : Set dat = CreateObject("Scripting.Dictionary")
  Dim dtn : Set dtn = CreateObject("Scripting.Dictionary")
  Dim txt : Set txt = fso.OpenTextFile(xml,1,False)
  Dim prg : prg = ""
  Dim tot : tot = 0
  Dim gtot : gtot = 0
  'read file
  Do While Not txt.AtEndOfStream
    Dim str : str = txt.ReadLine
    If InStr(str,"<") > 0 Then
      str = Mid(str,InStr(str,"<"))
    End If
    Dim key : key = gettag(str,"key")
    Select Case mode
      Case 0 'reading header
        If key = "Tracks" Then
          mode = 1
          trid = 0
        End If
      Case 1 'reading tracks
        If key = "Playlists" Then
          mode = 3
          trid = 0
          If key = "Track ID" Then
            mode = 2          
            trid = Int(gettag(str,"integer"))
            Set dat = CreateObject("Scripting.Dictionary")
            prog.Text = "iPlaylistImporter: Reading XML file (Track ID = "&trid&")..."
            If Debug Then Call log.Write("Reading track: "&CStr(trid))
          End If
        End If
      Case 2 'reading track data
        If key = "" Then
          Set dic.Item(CStr(trid)) = dat
          mode = 1
          trid = 0
          If Debug Then Call log.WriteLine(": "&dat.Item("Name"))
          dat.Item(CStr(key)) = gettag2(str)
        End If
      Case 3 'reading playlists
        If key = "Name" Then
          mode = 4
          tot = 0
          Dim nam : nam = Replace(gettag(str,"string"),"&","&")
          Set ply = SDB.PlaylistByTitle(nam)
          If Not (ply.Title = "") Then
            trid = SDB.MessageBox("iPlaylistImporter: Do you wish to overwrite playlist '"&nam&"'?",mtConfirmation,Array(mbYes,mbNo))
            If trid = mrNo Then
              mode = 3
            End If
          End If
          If mode = 4 Then
            If ply.Title = "" Then
              crep = crep+1
              Set ply = par.CreateChildPlaylist(nam)
              If Debug Then Call log.WriteLine("**Creating playlist: "&ply.Title)
              prg = "iPlaylistImporter: Creating playlist '"
              fndp = fndp+1
              Call ply.Clear()
              If Debug Then Call log.WriteLine("**Updating playlist: "&ply.Title)
              prg = "iPlaylistImporter: Updating playlist '"
            End If
            prog.Text = prg&ply.Title&"'..."
            Set dtn.Item((crep+fndp)&"p") = ply
            Set ply = Nothing
          End If
        End If         
      Case 4 'reading playlist data
        If key = "Track ID" Then
          trid = gettag(str,"integer")
          If dic.Exists(CStr(trid)) Then
            Set dat = dic.Item(CStr(trid))
            tot = tot+1
            gtot = gtot+1
            Set dtn.Item((crep+fndp)&"d"&tot) = dat
          End If
          If str = "</array>" Then
            mode = 3
          End If
        End If 
      Case Else
        Call SDB.MessageBox("iPlaylistImport: Unknown mode '"&mode&"'.",mtError,Array(mbOk))
        Exit Sub
    End Select
    If prog.Terminate Then
      Exit Do
    End If
  'create playlists
  prog.MaxValue = gtot
  Dim max : max = crep+fndp
  For trid = 1 To max
    If dtn.Exists(trid&"p") Then
      Set ply = dtn.Item(trid&"p")
      tot = 1
      While (dtn.Exists(trid&"d"&tot))
        Set dat = dtn.Item(trid&"d"&tot)
        Dim fil : fil = fixhex(dat.Item("Location"))
        If Left(fil,7) = "file://" Then
          fil = Mid(fil,8)
        End If
        If InStr(fil,":") > 0 Then
          fil = Mid(fil,InStr(fil,":")-1)
        End If
        fil = Replace(fil,"/","\")
        Dim upd : upd = False
        Dim itm : Set itm = Nothing
        Dim pat : pat = Replace(Mid(fil,2),"'","''")
        Dim sit : Set sit = SDB.Database.QuerySongs("AND (Songs.SongPath = '"&pat&"')")
        If sit.EOF Then 
          cret = cret+1
          Set itm = SDB.NewSongData
          upd = True      
          If Debug Then Call log.Write("****Creating track: ")
          fndt = fndt+1
          Set itm = sit.Item
          upd = False
          If Debug Then Call log.Write("****Updating track: ")
        End If
        Set sit = Nothing
        If upd Then
          itm.Path = fil
          itm.AlbumName = dat.Item("Album")
          itm.ArtistName = dat.Item("Artist")
          itm.Year = dat.Item("Year")
          itm.Genre = dat.Item("Genre")
          itm.Title = dat.Item("Name")
          itm.TrackOrder = dat.Item("Track Number")
          Dim list : Set list = SDB.NewSongList
          Call list.Add(itm)
          Call list.UpdateAll()
        End If
        If Debug Then Call log.WriteLine(itm.Title&" ("&itm.ID&")")
        prog.Text = "iPlaylistImporter: Adding track '"&itm.Title&"'..."
        Call ply.AddTrack(itm)
        tot = tot+1
    End If
  'finish off
  prog.Text = "iPlaylistImporter: Finalising..."
  prog.Value = prog.MaxValue
  If Debug Then
    Call log.WriteBlankLines(1)
    Call log.WriteLine((fndt+cret)&" tracks (found "&fndt&", created "&cret&")")
    Call log.WriteLine((fndp+crep)&" playlists (found "&fndp&", created "&crep&")")
    If prog.Terminate Then
      Call log.WriteLine("**Cancelled by user")
    End If
  End If
  If Not prog.Terminate Then
    Call SDB.MessageBox("iPlaylistImporter: "&(fndt+cret)&" tracks (found "&fndt&", created "&cret&") added to "&max&" playlists (found "&fndp&", created "&crep&").",mtInformation,Array(mbOk))
  End If
End Sub 

Function fixhex(str)
  fixhex = str
  Dim s1,s2,s3,d1,d2,b1,b2,b3
  Dim i : i = InStr(fixhex,"%")
  While (i > 0)
    s1 = Mid(fixhex,i+1,2)
    If IsHex(s1) Then
      d1 = HexToDec(s1)
      s1 = Left(fixhex,i-1)
      s2 = Mid(fixhex,i+4,2)
      If (Mid(fixhex,i+3,1) = "%") And (IsHex(s2)) Then
        d2 = HexToDec(s2)
        b1 = DecToBin(d1)
        b2 = DecToBin(d2)
        If (Left(b1,3) = "110") And (Left(b2,2) = "10") Then
          b3 = Mid(b1,4)&Mid(b2,3)
          s2 = ChrW(BinToDec(b3))
          s3 = Mid(fixhex,i+6)
          s2 = Chr(d1)
          s3 = Mid(fixhex,i+3)
        End If
        s2 = Chr(d1)
        s3 = Mid(fixhex,i+3)
      End If
      fixhex = s1&s2&s3
    End If
    i = InStr(i+1,fixhex,"%")
End Function

Function IsHex(h)
  IsHex = False
  Dim i : i = 0
  For i = 1 To Len(h)
    If Instr("0123456789ABCDEF",UCase(Mid(h,i,1))) = 0 Then
      Exit Function
    End If
  IsHex = True
End Function

Function HexToDec(h)
  HexToDec = 0
  Dim i : i = 0
  For i = Len(h) To 1 Step -1
    Dim d : d = Mid(h,i,1)
    d = Instr("0123456789ABCDEF",UCase(d))-1
    If d >= 0 Then
      HexToDec = HexToDec+(d*(16^(Len(h)-i)))
      HexToDec = 0
      Exit For
    End If
End Function

Function DecToBin(intDec)
  DecToBin = ""
  Dim d : d = intDec
  Dim e : e = 128
  While e >= 1
    If d >= e Then
      d = d - e
      DecToBin = DecToBin&"1"
      DecToBin = DecToBin&"0"
    End If
    e = e / 2
End Function

Function BinToDec(strBin)
  Dim d : d = 0
  Dim i : i = 0
  For i = Len(strBin) To 1 Step -1
    Select Case Mid(strBin,i,1)
      Case "0"
        'do nothing
      Case "1"
        d = d + (2^(Len(strBin)-i))
      Case Else
        d = 0
        Exit For
    End Select
  BinToDec = d
End Function

Function gettag(str,tag)
  gettag = ""
  Dim p1 : p1 = InStr(str,"<"&tag&">")
  If p1 > 0 Then
    Dim p2 : p2 = InStr(str,"</"&tag&">")
    If p2 > 0 And p2 > p1 Then
      p1 = p1+Len(tag)+2
      gettag = Mid(str,p1,p2-p1)
    End If
  End If
End Function

Function gettag2(str)
  gettag2 = gettag(str,"string")
  If gettag2 = "" Then
    gettag2 = gettag(str,"integer")
    If gettag2 = "" Then
      gettag2 = gettag(str,"date")
    End If
    gettag2 = Replace(gettag2,"&","&")
  End If
End Function

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("iPlaylistImporter","Filename") = "iPlaylistImporter.vbs"
    inif.StringValue("iPlaylistImporter","Procname") = "iPlaylistImporter"
    inif.StringValue("iPlaylistImporter","Order") = "30"
    inif.StringValue("iPlaylistImporter","DisplayName") = "iPlaylist Importer"
    inif.StringValue("iPlaylistImporter","Description") = "Import XML playlists from iTunes"
    inif.StringValue("iPlaylistImporter","Language") = "VBScript"
    inif.StringValue("iPlaylistImporter","ScriptType") = "0"
  End If
End Sub


Posted: Thu Dec 06, 2007 8:52 pm
by odumrf
Trixmoto: I tried your new script and it is so slick. Thanks. This is the easiest process for getting an itunes playlist into media monkey. Just use itunes to export the playlist to your desktop in xml format and in Media Monkey Tools direct the script to the location and it'll import the playlist into Media Monkey. Wow

Posted: Thu Dec 06, 2007 9:49 pm
by kcbeersnob
Brilliant script! I manage my playlists on a server running iTunes to serve a couple of Rokus in my house. I run MediaMonkey on my main PC and now can finally maintain my playlists in one application and easily import to the other. Thanks!

On a side note, I'd likely scrap iTunes altogether if MediaMonkey could function as a UPnP server.

Posted: Sat Dec 08, 2007 8:41 am
by trixmoto
New version (1.1) is now available to download from my website. I've fixed slashes were sometimes in the wrong direction, so "/" is now turned into "\". :)

Posted: Thu Jan 17, 2008 12:57 pm
by Onweerwolf
I am having a few problems with this script when importing playlists that contain songs with characters like '[' , 'ö' or '&' and probably others too, though i haven't tested them all.

Is there anyway to fix this?

Posted: Thu Jan 17, 2008 3:20 pm
by trixmoto
Do you get any errors at all? Maybe you could email me an example?

Posted: Thu Jan 17, 2008 4:26 pm
by chs
Same problem here. no error message, however songs with filenames/tags containing special characters are faded grey within imported playlists and are can't be located by MM.
I had some trouble with MM not properly recognising filesnames containing special characters during "Add/Re-scan" - so this could be related. I'm sending you an example xml playlist...

Posted: Thu Jan 17, 2008 5:24 pm
by Onweerwolf
As an example:

I have a track with the title: "Völkerwanderung"

After running the script this track is not recognized and the script creates a grey track with this track title: "Völkerwanderung"

Posted: Mon Jan 21, 2008 5:11 am
by trixmoto
New version (1.2) is now available to download from my website. The strings (which are UTF encoded) are now fully decoded. :)

Posted: Mon Jan 21, 2008 3:24 pm
by chs
Thanks alot, much appreciated!
While importing the xml playlist seems to work correctly, MM still seems to have problems with converting and showing certain strings in tags and filenames, but thats a general problem of itunes export (generating the xml or m3u files) and Mediamonkey's UTF support I guess.

Posted: Mon Jan 21, 2008 5:59 pm
by trixmoto
I'm working with a couple of people to hopefully try and get the last of the encoding issues sorted. Watch this space! :)

Posted: Tue Jan 22, 2008 1:54 pm
by trixmoto
New version (1.3) is now available to download from my website. This time I'm sure that I've got the special character decoding sorted out! :D

Posted: Tue Jan 22, 2008 2:07 pm
by chs
Brilliant! Works like a charm and I'm sure all listeners of French, Swedish, German or any other non-standard English language music will be forever thankful, at least I'am ;)

Posted: Tue Jan 22, 2008 4:04 pm
by trixmoto
I'm just glad it's working properly now! :)

Posted: Tue Jan 22, 2008 8:45 pm
by cut-copy-paste
great to have!
although what would be reaaally awesome.. is if when i exported my entire library from itunes, it would find all the playlists in that library when imported the xml file (i thought that's what it was going to do at first)..

also i just ran the plugin and had an error..
"Error executing *SELECT songs.*
FROM Songs
Where (Songs.SongPath = ':MP3\Rock-Pop...etc"

When I click 'retry', it goes on to tell me
"Error #-2147418113-
File: "...PlaylistImporter.vbs", Line: 191, Column 18"

and then
Error happened during script execution: Catastrophic Failure

also.. ampersands and apostrophes etc were all messing up..

I downloaded the 1.3 installer from your website ... is it up to date?