iDate Added 1.5 - Updated 23/01/2008

Download and get help for different MediaMonkey Addons.

Moderators: Peke, Gurus

iDate Added 1.5 - Updated 23/01/2008

Postby trixmoto » 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...

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 trixmoto.net. If you're interested, check out my Uniface blog.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.

Image Image
trixmoto
 
Posts: 9907
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK

Postby trixmoto » Thu Jan 10, 2008 5:27 pm

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 trixmoto.net. If you're interested, check out my Uniface blog.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.

Image Image
trixmoto
 
Posts: 9907
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK

Postby Tictac » Fri Jan 11, 2008 2:39 pm

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 :)
Tictac
 
Posts: 4
Joined: Mon Jan 07, 2008 4:11 pm

Postby trixmoto » Sat Jan 12, 2008 10:13 am

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 trixmoto.net. If you're interested, check out my Uniface blog.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.

Image Image
trixmoto
 
Posts: 9907
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK

Postby Tictac » Wed Jan 16, 2008 4:43 pm

Where is the logfile that is produced?

Sorry for being stupid
Tictac
 
Posts: 4
Joined: Mon Jan 07, 2008 4:11 pm

Postby trixmoto » Wed Jan 16, 2008 5:17 pm

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 trixmoto.net. If you're interested, check out my Uniface blog.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.

Image Image
trixmoto
 
Posts: 9907
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK

Postby Tictac » Wed Jan 16, 2008 6:42 pm

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
Tictac
 
Posts: 4
Joined: Mon Jan 07, 2008 4:11 pm

Postby trixmoto » Wed Jan 16, 2008 6:52 pm

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 trixmoto.net. If you're interested, check out my Uniface blog.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.

Image Image
trixmoto
 
Posts: 9907
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK

Postby Onweerwolf » Thu Jan 17, 2008 10:16 am

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
Onweerwolf
 
Posts: 562
Joined: Tue Dec 12, 2006 5:32 pm
Location: The Netherlands

Postby trixmoto » Thu Jan 17, 2008 11:53 am

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 trixmoto.net. If you're interested, check out my Uniface blog.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.

Image Image
trixmoto
 
Posts: 9907
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK

Postby Onweerwolf » Thu Jan 17, 2008 12:29 pm

Done!
Image
Onweerwolf
 
Posts: 562
Joined: Tue Dec 12, 2006 5:32 pm
Location: The Netherlands

Postby trixmoto » Thu Jan 17, 2008 3:15 pm

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 trixmoto.net. If you're interested, check out my Uniface blog.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.

Image Image
trixmoto
 
Posts: 9907
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK

Postby trixmoto » Mon Jan 21, 2008 5:04 am

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 trixmoto.net. If you're interested, check out my Uniface blog.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.

Image Image
trixmoto
 
Posts: 9907
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK

Postby trixmoto » Tue Jan 22, 2008 11:42 am

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 trixmoto.net. If you're interested, check out my Uniface blog.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.

Image Image
trixmoto
 
Posts: 9907
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK

Postby Onweerwolf » Tue Jan 22, 2008 6:18 pm

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
Onweerwolf
 
Posts: 562
Joined: Tue Dec 12, 2006 5:32 pm
Location: The Netherlands

Next

Return to Need Help with Addons?

Who is online

Users browsing this forum: No registered users and 23 guests