iDate Added 1.5 - Updated 23/01/2008
Posted: Sat Jan 05, 2008 3:23 pm
This script, as requested here, reads an XML database file exported from iTunes, matches up the filepaths with the tracks in MM and amends the added date.
By default new tracks are not created, only tracks which are found are updated. However, there is a variable (CreateTracks) at the top of the script which can be amended to create tracks which are not found.
As always, installation packages are available to download from my website. And here's the code...
By default new tracks are not created, only tracks which are found are updated. However, there is a variable (CreateTracks) at the top of the script which can be amended to create tracks which are not found.
As always, installation packages are available to download from my website. And here's the code...
Code: Select all
'
' MediaMonkey Script
'
' NAME: iDateAdded 1.5
'
' AUTHOR: trixmoto (http://trixmoto.net)
' DATE : 23/01/2008
'
' INSTALL: Copy to Scripts directory and add the following to Scripts.ini
' Don't forget to remove comments (') and set the order appropriately
'
' [iDateAdded]
' FileName=iDateAdded.vbs
' ProcName=iDateAdded
' Order=31
' DisplayName=iDate Added
' Description=Import XML metadata from iTunes
' Language=VBScript
' ScriptType=0
'
' FIXES: Fixed ampersand and percent characters not decoded properly
'
Option Explicit
Dim Debug : Debug = False
Dim CreateTracks : CreateTracks = False
Sub iDateAdded
'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 = "iDateAdded: Initialising..."
prog.Value = 0
prog.MaxValue = 1
'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%")&"\iDateAdded.log"
Dim log : Set log = fso.CreateTextFile(loc,True,True)
If log Is Nothing Then
Debug = False
Else
Call log.WriteLine("Import file: "&xml)
Call log.WriteBlankLines(1)
End If
End If
'initialise
Dim mode : mode = 0
Dim trid : trid = 0
Dim fndt : fndt = 0
Dim cret : cret = 0
Dim max : max = 0
Dim dic : Set dic = CreateObject("Scripting.Dictionary")
Dim dat : Set dat = CreateObject("Scripting.Dictionary")
Dim txt : Set txt = fso.OpenTextFile(xml,1,False)
'read file
Do While Not txt.AtEndOfStream
Dim str : str = Trim(txt.ReadLine)
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
Exit Do
Else
If key = "Track ID" Then
mode = 2
max = max + 1
trid = Int(gettag(str,"integer"))
Set dat = CreateObject("Scripting.Dictionary")
prog.Text = "iDateAdded: Reading XML file (Track ID = "&trid&")..."
SDB.ProcessMessages
If Debug Then Call log.WriteLine("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
Else
dat.Item(CStr(key)) = gettag2(str)
If Debug Then Call log.WriteLine(" "&key&"="&dat.Item(CStr(key)))
End If
Case Else
Call SDB.MessageBox("iDateAdded: Unknown mode '"&mode&"'.",mtError,Array(mbOk))
Exit Sub
End Select
If prog.Terminate Then
Exit Do
End If
Loop
txt.Close
If Debug Then
Call log.WriteBlankLines(1)
End If
'process tracks
prog.MaxValue = max
Dim arr : arr = dic.Keys
For trid = 0 To UBound(arr)
Set dat = dic.Item(CStr(arr(trid)))
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 sql : sql = "AND (Songs.SongPath = '"&pat&"')"
If Debug Then Call log.WriteLine("*"&sql)
Dim sit : Set sit = SDB.Database.QuerySongs(sql)
If sit.EOF Then
cret = cret+1
Set itm = SDB.NewSongData
upd = True
If Debug Then
If CreateTracks Then
Call log.Write("Creating track: ")
Else
Call log.Write("Skipping track: ")
End If
End If
Else
fndt = fndt+1
Set itm = sit.Item
upd = False
If Debug Then Call log.Write("Updating track: ")
End If
Set sit = Nothing
Dim dad : dad = fixdate(dat.Item("Date Added"))
If upd Then
If CreateTracks 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")
If Not (dad = "") Then
itm.DateAdded = dad
End If
itm.UpdateDB
itm.UpdateArtist
itm.UpdateAlbum
Dim list : Set list = SDB.NewSongList
Call list.Add(itm)
Call list.UpdateAll()
End If
Else
If Not (dad = "") Then
itm.DateAdded = dad
End If
itm.UpdateDB
End If
If Debug Then Call log.WriteLine(dat.Item("Name")&" ("&itm.ID&")")
prog.Text = "iDateAdded: Processing track '"&dat.Item("Name")&"'..."
prog.Increase
SDB.ProcessMessages
Next
'finish off
prog.Text = "iDateAdded: Finalising..."
prog.Value = prog.MaxValue
SDB.ProcessMessages
If Debug Then
Call log.WriteBlankLines(1)
If CreateTracks Then
Call log.WriteLine("Processed "&max&" tracks (found "&fndt&", created "&cret&")")
Else
Call log.WriteLine("Processed "&max&" tracks (found "&fndt&")")
End If
If prog.Terminate Then
Call log.WriteLine("**Cancelled by user")
End If
log.Close
End If
If Not prog.Terminate Then
Dim tmp : tmp = "iDateAdded: Processed "&max&" tracks (found "&fndt
If CreateTracks Then
tmp = tmp&", created "&cret
End If
Call SDB.MessageBox(tmp&").",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 = Chr(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 fixdate(str)
fixdate = ""
If Len(str) = 20 Then
Dim y : y = Int(Left(str,4))
Dim m : m = Int(Mid(str,6,2))
Dim d : d = Int(Mid(str,9,2))
Dim t : t = Mid(str,12,8)
Dim s : s = DateSerial(y,m,d)+TimeValue(t)
fixdate = FormatDateTime(s,0)
End If
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("iDateAdded","Filename") = "iDateAdded.vbs"
inif.StringValue("iDateAdded","Procname") = "iDateAdded"
inif.StringValue("iDateAdded","Order") = "31"
inif.StringValue("iDateAdded","DisplayName") = "iDate Added"
inif.StringValue("iDateAdded","Description") = "Import XML metadata from iTunes"
inif.StringValue("iDateAdded","Language") = "VBScript"
inif.StringValue("iDateAdded","ScriptType") = "0"
SDB.RefreshScriptItems
End If
End Sub