MediaMonkey: iTunes Import Script with Unicode Support

September 5th, 2010 by ben Leave a reply »

I have an Android phone, and nothing wants to sync with it. MediaMonkey isn’t perfect (it can’t transcode to aac… why?), but it kinda works. Now all that I needed was to get my iTunes playlists into MM. Easier said than done.

As I’m sure many others have experienced, it’s not possible. At least not without a helpful script provided by trixmoto of the MM forums called iPlaylistImporter. (Also helpful: iDate Added.)

Unfortunately, these scripts can’t read Unicode characters. A bummer for us Asians and J-Pop enthusiasts, as well as other types of Communists (Russians and their Cyrillic, etc). iTunes exports its XML files in UTF-8, a format that VBScript does not natively support (see people, this is why you don’t use Microsoft products). The original author of these scripts had an extremely difficult time trying to add Unicode support. I have devised a semi-solution to this problem, and a modified script.

First step: open your XML file in EmEditor or Notepad++ or whatever other brilliant program you use to change character encodings. We’re going to convert this UTF-8 file into UTF-16. Pick UTF-16, Little Endian, with BOM. Or, as some programs call it, UCS-2. Save it in UTF-16.

Now the script can read the file (after adding a flag to the file input function), but there’s another problem: Apple, in its infinite wisdom, encodes the location of your mp3 files in URL (percent) encoding, in, guess what? UTF-8, very good.

So I extended trixmoto’s percent-decoding function to allow for the decoding of three-byte UTF-8 characters, which is needed for Japanese and Chinese characters. Most of the genius is his. Here is the script:

'
' MediaMonkey Script
'
' NAME: iPlaylistImporter 1.6
'
' AUTHOR: trixmoto (http://trixmoto.net)
' 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
 dlg.ShowOpen
 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
 Else
 Call log.WriteLine("Import file: "&xml)
 End If
 End If

 'initialise
 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, -1)
 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
 Else
 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&")..."
 SDB.ProcessMessages           
 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"))
 Else
 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 '"
 Else
 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&"'..."
 SDB.ProcessMessages           
 Set dtn.Item((crep+fndp)&"p") = ply
 Else
 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
 Else
 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
 Loop
 txt.Close

 '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: ")
 Else
 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")
 itm.UpdateDB
 itm.UpdateArtist
 itm.UpdateAlbum             
 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&"'..."
 prog.Increase
 SDB.ProcessMessages
 Call ply.AddTrack(itm)
 tot = tot+1
 WEnd
 End If
 Next

 'finish off
 prog.Text = "iPlaylistImporter: Finalising..."
 prog.Value = prog.MaxValue
 SDB.ProcessMessages
 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
 log.Close
 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 thirdbytehex, thirdbytedec, thirdbytebin
 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)
 Else
 If (Mid(fixhex, i+6, 1) = "%") And (IsHex(Mid(fixhex, i+7, 2))) Then
 thirdbytehex = Mid(fixhex, i+7, 2)
 thirdbytedec = HexToDec(thirdbytehex)
 thirdbytebin = DecToBin(thirdbytedec)
'Call SDB.MessageBox("iPlaylistImport: threeinarow "&b1&" "&b2&" "&thirdbytebin,mtError,Array(mbOk))
 If (Left(b1, 4) = "1110") And (Left(b2, 2) = "10") And (Left(thirdbytebin, 2) = "10") Then
 b3 = Mid(b1, 5)&Mid(b2, 3)&Mid(thirdbytebin, 3)
 s2 = ChrW(BinToDec(b3))
 s3 = Mid(fixhex, i+9)
'Call SDB.MessageBox("iPlaylistImport: threebyte encountered. "&b1&b2&thirdbytebin&" result"&b3&"="&s2,mtError,Array(mbOk))
 Else
 's2 = Chr(d1)
 s2 = ChrW(d1)
 s3 = Mid(fixhex,i+3)
 End If
 Else
 's2 = Chr(d1)
 s2 = ChrW(d1)
 s3 = Mid(fixhex,i+3)
 End If
 End If
 Else
 's2 = Chr(d1)
 s2 = ChrW(d1)
 s3 = Mid(fixhex,i+3)
 End If
 fixhex = s1&s2&s3
 End If
 i = InStr(i+1,fixhex,"%")
 WEnd
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
 Next
 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)))
 Else
 HexToDec = 0
 Exit For
 End If
 Next
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"
 Else
 DecToBin = DecToBin&"0"
 End If
 e = e / 2
 Wend
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
 Next
 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
 Else
 gettag2 = Replace(gettag2,"&#38;","&")
 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"
 SDB.RefreshScriptItems
 End If
End Sub

Related Posts:

Advertisement

Leave a Reply

This site uses Akismet to reduce spam. Learn how your comment data is processed.