iDate Added 1.5 - Updated 23/01/2008

Download and get help for different MediaMonkey for Windows 4 Addons.

Moderators: Peke, Gurus

trixmoto
Posts: 10024
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK
Contact:

iDate Added 1.5 - Updated 23/01/2008

Post by trixmoto »

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...

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
Last edited by trixmoto on Wed Jan 23, 2008 3:30 pm, edited 4 times in total.
Download my scripts at my own MediaMonkey fansite.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.
trixmoto
Posts: 10024
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK
Contact:

Post by trixmoto »

New version (1.1) is now available to download from my website. I've fixed the errors produced when the debug mode is disabled.
Download my scripts at my own MediaMonkey fansite.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.
Tictac
Posts: 4
Joined: Mon Jan 07, 2008 4:11 pm

Post by Tictac »

Ooh, this would be very useful for me.

When I run it though, it claims to have processed 917 files but found 0 - hence none of my Added Dates change.

I've checked with my Itunes though and the file paths seem to be exactly the same as my Mediamonkey ones. The Itunes 'Date added' are definitely different as well.

Do you know of anything obvious that I might be missing?

Thanks :)
trixmoto
Posts: 10024
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK
Contact:

Post by trixmoto »

At the top of the script is a variable called "Debug" - try setting this to "True" and run the script again. Hopefully the logfile produced will help you figure out why it's not working. You can email it to me if it doesn't help you. :)
Download my scripts at my own MediaMonkey fansite.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.
Tictac
Posts: 4
Joined: Mon Jan 07, 2008 4:11 pm

Post by Tictac »

Where is the logfile that is produced?

Sorry for being stupid
trixmoto
Posts: 10024
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK
Contact:

Post by trixmoto »

It's stored in "%TEMP%\iDateAdded.log" - this is your windows temporary directly. If you go to the Run command prompt and enter "%temp%" this will take you to the right folder. :)
Download my scripts at my own MediaMonkey fansite.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.
Tictac
Posts: 4
Joined: Mon Jan 07, 2008 4:11 pm

Post by Tictac »

yay I've got it. Here's the log file -

------------------------------------------------------------------------------------

Import file: G:\My Documents\My Music\iTunes\iTunes Music Library.xml

Reading track: 483: Rubber Band [Single]
***snipped 918 tracks - all say "Reading track"***
Reading track: 1468: Nobody's Fault But Mine

Skipping track: Rubber Band [Single] (-1)
***snipped 918 tracks - all say "Skipping track" with a "(-1)" on the end***
Skipping track: Nobody's Fault But Mine (-1)

Processed 919 tracks (found 0)""

-------------------------------------------------------------------------------------

Maybe something is wrong with my database? (maybe when I upgraded from MM2.5 to 3...)

Thanks
trixmoto
Posts: 10024
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK
Contact:

Post by trixmoto »

Well the filenames in your iTunes database must be different from the filenames in your MediaMonkey database. This script assumes they are the same.
Download my scripts at my own MediaMonkey fansite.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.
Onweerwolf
Posts: 705
Joined: Tue Dec 12, 2006 5:32 pm
Location: The Netherlands

Post by Onweerwolf »

trixmoto wrote:Well the filenames in your iTunes database must be different from the filenames in your MediaMonkey database. This script assumes they are the same.
Could it be so that the filenames in the MM database are 'encrypted' or just written in a different way?

In my case I am 100% positive that the files and paths have stayed the same. I don't use folder managers in both programs and I haven't moved a file.
Image
trixmoto
Posts: 10024
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK
Contact:

Post by trixmoto »

No, they are not encrypted, they are just plain text. Could you please open the script file in a text editor and find line 131...

Code: Select all

Dim sit : Set sit = SDB.Database.QuerySongs("AND (Songs.SongPath = '"&fixsql(Mid(fil,2))&"')")
...and replace this with...

Code: Select all

Dim sql : sql = "AND (Songs.SongPath = '"&fixsql(Mid(fil,2))&"')"
If Debug Then Call log.WriteLine("*"&sql)
Dim sit : Set sit = SDB.Database.QuerySongs(sql)
...and make sure the Debug variable is still true, then run again and email me the logfile?
Download my scripts at my own MediaMonkey fansite.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.
Onweerwolf
Posts: 705
Joined: Tue Dec 12, 2006 5:32 pm
Location: The Netherlands

Post by Onweerwolf »

Done!
Image
trixmoto
Posts: 10024
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK
Contact:

Post by trixmoto »

New version (1.2) is now available to download from my website. Hopefully I've fixed the problem of the location blanking out! :)
Download my scripts at my own MediaMonkey fansite.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.
trixmoto
Posts: 10024
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK
Contact:

Post by trixmoto »

New version (1.3) is now available to download from my website. The strings (which are UTF encoded) are now fully decoded. :)
Download my scripts at my own MediaMonkey fansite.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.
trixmoto
Posts: 10024
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK
Contact:

Post by trixmoto »

New version (1.4) is now available to download from my website. This time I'm sure the special characters are decoded as well! :D
Download my scripts at my own MediaMonkey fansite.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.
Onweerwolf
Posts: 705
Joined: Tue Dec 12, 2006 5:32 pm
Location: The Netherlands

Post by Onweerwolf »

trixmoto wrote:New version (1.4) is now available to download from my website. This time I'm sure the special characters are decoded as well! :D
We're getting real close now.

I've ran the new version and this time, as far as I can see, every track was recognized except for the ones that have '&' in the title or artist.
Image
Post Reply