iPlaylist Importer 1.6 - Updated 25/05/2008
Posted: Mon Nov 26, 2007 7:17 am
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 (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)
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 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
s2 = Chr(d1)
s3 = Mid(fixhex,i+3)
End If
Else
s2 = Chr(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,"&","&")
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