Export to iTunes library.xml

Download and get help for different MediaMonkey Addons.

Moderators: Peke, Gurus

Re: Export to iTunes library.xml

Postby PJ-014 » Fri Jan 24, 2014 10:57 pm

Apologies for bumping this so late. I am trying to export my MM library using the script, for use with Musicbee. I've installed the script fine and it seems to work, except only the playcounts of the initial few artists get exported (the play counts for all others remains at 0). It seems someone had the same problem on this thread (around page 3/4), and was recommended to remove the tracks from iTunes/delete the iTunes XML and ITL files. Since I am not using iTunes, I am not sure how to get around this. Any help on this would be greatly appreciated.
PJ-014
 

Re: Export to iTunes library.xml

Postby bambule » Tue Nov 07, 2017 2:41 pm

Hi all,

wonder if anyone is still using this great script?
I am still using it for sharing (a part of) my music collection to Traktor and I've recently updated Traktor to Version "2.11.1 28".
Since then, Traktor crashes when accessing the exported XML-File.

It took some investigation to find the problem:
Traktor crashes when finding masked out characters with ASCII-Code > 127, which is done here:
Code: Select all
if codepoint > 127 or currentchar = vbTab or currentchar = vbLf or currentchar = vbCr then
  replacement = "&#" + CStr(codepoint) + ";"
elseif codepoint < 32 then
  replacement = ""
end if


changed it to:

Code: Select all
if currentchar = vbTab or currentchar = vbLf or currentchar = vbCr then
  replacement = "&#" + CStr(codepoint) + ";"
elseif codepoint < 32 then
  replacement = ""
end if


But with that you will end up with non-ANSI-characters in an ANSI-Textfile, which just does not work.

You could cut out every character > 127, (as it is being done for characters < 32), but that will eat up all your special characters.

In order to have special characters show up in Traktor, the script has to be modified, so that it writes the XML-File UTF-8 encoded (without BOM!) instead of an ANSI file.

Here you are:
Code: Select all
option explicit     ' report undefined variables, ...

' Customize options below; then (re)start MM.
const ENABLE_TIMER = true ' change to false to prevent automatic exporting once per hour
const QUERY_FOLDER = false ' set tp true to be asked each time where to save the iTunes xml file

' End of options.

'  ------------------------------------------------------------------
const EXPORTING = "itunes_export_active"

' Returns the XML suitable escaped version of the srcstring parameter.
' This function is based on MapXML found in other MM scripts, e.g.
' Export.vbs, but fixes a unicode issue and is probably faster.
' Note that a bug in AscW still prevents the correct handling of unicode
' codepoints > 65535.
function escapeXML(srcstring)
  dim i, codepoint, currentchar, replacement
  i = 1
  while i <= Len(srcstring)
    currentchar = Mid(srcstring, i, 1)
    replacement = Null
    if currentchar = "&" then
      replacement = "&amp;"
    elseif currentchar = "<" then
      replacement = "&lt;"
    elseif currentchar = ">" then
      replacement = "&gt;"
    else
      codepoint = AscW(currentchar)
      if codepoint < 0 then ' adjust for negative (incorrect) values, see also http://support.microsoft.com/kb/272138
        codepoint = codepoint + 65536
      end if
     
      ' Important: reject control characters except tab, cr, lf. See also http://www.w3.org/TR/1998/REC-xml-19980210.html#NT-Char
      ' HINT: removed clause codepoint > 127, here. Non-ANSI characters are allowed in the output, since we generate UTF-8 encoded file... :-)
     if currentchar = vbTab or currentchar = vbLf or currentchar = vbCr then
        replacement = "&#" + CStr(codepoint) + ";"
      elseif codepoint < 32 then
        replacement = ""
      end if
    end if
   
    if not IsNull(replacement) then   
      srcstring = Mid(srcstring, 1, i - 1) + replacement + Mid(srcstring, i + 1, Len(srcstring))
      i = i + Len(replacement) - 1 ' 07.10.2010: no need to parse that #99999; stuff again although it does no harm
    end if
    i = i + 1
  wend
  escapeXML = srcstring
end function

' N must be numberic. Return value is N converted to a string, padded with
' a single "0" if N has only one digit.
function LdgZ(N)   
  if (N >= 0) and (N < 10) then
    LdgZ = "0" & N
  else
    LdgZ = "" & N 
  end if 
end function 

' Adds a simple key/value pair to the XML accessible via textfile fout.
sub addKey(fout, key, val, keytype)
  if keytype = "string" then
    if val = "" then ' nested if because there is no shortcut boolean eval
      exit sub
    end if
  end if
 
  if keytype = "integer" then
    if val = 0 then ' nested if because there is no shortcut boolean eval
      exit sub
    end if
  end if
 
  if keytype = "date" then ' convert date into ISO-8601 format
    val = Year(val) & "-" & LdgZ(Month(val)) & "-" & LdgZ(Day(val)) _
      & "T" & LdgZ(Hour(val)) &  ":" & LdgZ(Minute(val)) & ":" & LdgZ(Second(val))
  end if
 
  fout.WriteText "         <key>" & key & "</key><" & keytype & ">" & val & "</" & keytype & ">" & vbCrLf
end sub

' Return the full path of the file to export to. The file will be located
' in the same folder as the database because this folder is writable and user
' specific. For maximum compatibility we will use the original iTunes name
' which is "iTunes Music Library.xml".
' 29.03.2009: if the new option QUERY_FOLDER is set to true this function
' will query for the folder to save to instead.
function getExportFilename()
  dim path
  if QUERY_FOLDER then
    dim inif
    set inif = SDB.IniFile
    path = inif.StringValue("Scripts", "LastExportITunesXMLDir")
    path = SDB.SelectFolder(path, SDB.Localize("Select where to export the iTunes XML file to."))
    if path = "" then
      exit function
    end if
    if right(path, 1) <> "\" then
      path = path & "\"
    end if
    inif.StringValue("Scripts", "LastExportITunesXMLDir") = path
    set inif = Nothing 
  else
    dim dbpath : dbpath = SDB.Database.Path
    dim parts : parts = split(dbpath, "\")
    dim dbfilename : dbfilename = parts(UBound(parts))
    path = Mid(dbpath, 1, Len(dbpath) - Len(dbfilename))
  end if
  getExportFilename = path + "iTunes Music Library.xml"
end function

' Exports the full MM library and playlists into an iTunes compatible
' library.xml. This is not intended to make MM's database available to
' iTunes itself but to provide a bridge to other applications which are
' able to read the iTunes library xml.
sub export
  if SDB.Objects(EXPORTING) is nothing then
    SDB.Objects(EXPORTING) = SDB
  else
    MsgBox SDB.Localize("iTunes export is already in progress."), 64, "iTunes Export Script"
    exit sub
  end if

  dim filename, iter, songCount, fout, progress, song, playlistCount
  dim progressText, i, j, tracks, playlist
 
  filename = getExportFilename()
  if filename = "" then
    SDB.Objects(EXPORTING) = nothing
    exit sub
  end if

  Set fout = CreateObject("ADODB.Stream")
  fout.CharSet = "utf-8"
  fout.Open

  set iter = SDB.Database.OpenSQL("select count(*) from SONGS")
  songCount = Int(iter.ValueByIndex(0)) ' needed for progress
  set iter = SDB.Database.OpenSQL("select count(*) from PLAYLISTS")
  playlistCount = CInt(iter.ValueByIndex(0))

  set progress = SDB.Progress
  progressText = SDB.Localize("Exporting to iTunes library.xml...")
  Progress.Text = progressText
  Progress.MaxValue = songCount + playlistCount * 50

  fout.WriteText "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbCrLf
  fout.WriteText "<!DOCTYPE plist PUBLIC ""-//Apple Computer//DTD PLIST 1.0//EN"" ""http://www.apple.com/DTDs/PropertyList-1.0.dtd"">" & vbCrLf
  fout.WriteText "<plist version=""1.0"">" & vbCrLf
  fout.WriteText "<dict>" & vbCrLf
  fout.WriteText "   <key>Major Version</key><integer>1</integer>" & vbCrLf
  fout.WriteText "   <key>Minor Version</key><integer>1</integer>" & vbCrLf
  fout.WriteText "   <key>Application Version</key><string>7.6</string>" & vbCrLf
  fout.WriteText "   <key>Features</key><integer>5</integer>" ' whatever that means & vbCrLf
  fout.WriteText "   <key>Show Content Ratings</key><true/>" & vbCrLf
  ' Fields not available in MM:
  ' fout.WriteText "   <key>Music Folder</key><string>file://localhost/C:/....../iTunes/iTunes%20Music/</string>" & vbCrLf
  ' fout.WriteText "   <key>Library Persistent ID</key><string>4A9134D6F642512F</string>" & vbCrLf

  ' Songs
  '
  ' For each song write available tag values to the library.xml. At this time
  ' this does not include artwork, volume leveling and album rating.
  if songCount > 0 then
    fout.WriteText "   <key>Tracks</key>" & vbCrLf
    fout.WriteText "   <dict>" & vbCrLf
    i = 0
    set iter = SDB.Database.QuerySongs("")
    while not iter.EOF and not Progress.Terminate and not Script.Terminate
      set song = iter.Item
      iter.next

      ' %d always inserts 0, don't know why
      i = i + 1
      progress.Text = progressText & " " & SDB.LocalizedFormat("%s / %s songs", CStr(i), CStr(songCount), 0)
      if i mod 50 = 0 then
        SDB.ProcessMessages
      end if

      fout.WriteText "      <key>" & Song.id & "</key>" & vbCrLf
      fout.WriteText "      <dict>   " & vbCrLf
      addKey fout, "Track ID", Song.id, "integer"
      addKey fout, "Name", escapeXML(Song.Title), "string"
      addKey fout, "Artist", escapeXML(Song.ArtistName), "string"
      addKey fout, "Composer", escapeXML(Song.MusicComposer), "string"
      addKey fout, "Album Artist", escapeXML(Song.AlbumArtistName), "string"
      addKey fout, "Album", escapeXML(Song.AlbumName), "string"
      addKey fout, "Kind", escapeXML("MPEG audio file"), "string"
      addKey fout, "Size", Song.FileLength, "integer"
      addKey fout, "Genre", escapeXML(Song.Genre), "string"
      addKey fout, "Total Time", Song.SongLength, "integer"
      addKey fout, "Track Number", Song.TrackOrder, "integer" ' potential type problem with TrackOrderStr
      addKey fout, "Disc Number", Song.DiscNumber, "integer" ' potential type problem with DiscNumberStr
      addKey fout, "Play Count", Song.PlayCounter, "integer"
      if Song.Rating >= 0 and Song.Rating <= 100 then
        addKey fout, "Rating", Song.Rating, "integer" ' rating seems to be compatible in range (although not stored in same id3 tag)
      end if
      addKey fout, "Year", Song.Year, "integer"
      addKey fout, "Date Modified", Song.FileModified, "date"
      addKey fout, "Date Added", Song.DateAdded, "date"
      addKey fout, "Bit Rate", Int(Song.Bitrate / 1000), "integer"
      addKey fout, "Sample Rate", Song.SampleRate, "integer"
      addKey fout, "Track Type", escapeXML("File"), "string"
      addKey fout, "File Folder Count", -1, "integer"
      addKey fout, "Library Folder Count", -1, "integer"
      addKey fout, "Comments", escapeXML(Song.Comment), "string"
      addKey fout, "Location", "file://localhost/" & Replace(Replace(Escape(Song.Path), "%5C", "/"), "%3A", ":"), "string"

      ' TODO artwork?
      ' addKey fout, "Artwork Count", 0, "integer"
      ' TODO convert to iTunes rating range. MM: -99999...?. iTunes: -255 (silent) .. 255
      ' fout.WriteText "         <key>Volume Adjustment</key><integer>" & escapeXML(Song.Leveling) & "</integer>"  & vbCrLf

      ' Fields not available in MM:
      ' fout.WriteText "         <key>Disc Count</key><integer>" & escapeXML(Song.?) & "</integer>" & vbCrLf
      ' fout.WriteText "         <key>Album Rating</key><integer>" & escapeXML(Song.?) & "</integer>" & vbCrLf
      ' fout.WriteText "         <key>Persistent ID</key><string>5282DFDE369975A8</string>" & vbCrLf

      fout.WriteText "      </dict>" & vbCrLf

      Progress.Increase
    wend
    fout.WriteText "   </dict>" & vbCrLf
  end if
  SDB.ProcessMessages
 
  ' Playlists
  '
  ' This part differs at least with the following items from an original iTunes
  ' library.xml:
  ' - iTunes includes a playlist named "Library" with all songs, we don't
  ' - every iTunes playlist has a "Playlist Persistent ID", e.g. "4A9134D6F6425130"
  '   We don't have that data.
  '
  ' Also note: auto-playlists are evaluated once and are exported like that. They
  ' are not converted into iTunes auto-playlists. A consequence of this is that
  ' e.g. randomized or size-limited playlists will contain a static snapshot taken
  ' at export time.
  if playlistCount > 0 and not Progress.Terminate and not Script.Terminate then
    fout.WriteText "   <key>Playlists</key>" & vbCrLf
    fout.WriteText "   <array>" & vbCrLf
   
    ' Get playlists and store them into an array. Make sure that we do not have
    ' an open query while playlist.Tracks is evaluated because that will fail
    ' (it wants to start a db transaction but can't because a query is still open)
    dim playlists()
    set iter = SDB.Database.OpenSQL("select PlaylistName from PLAYLISTS")
    i = 0
    while not iter.EOF
      set playlist = SDB.PlaylistByTitle(iter.StringByIndex(0))
      if playlist.Title <> "Accessible Tracks" then ' this would correspond to iTunes' "Library" playlist
        redim preserve playlists(i)
        set playlists(i) = playlist
        i = i + 1
      end if
      iter.next
    wend     
    set iter = nothing

    for each playlist in playlists
      set tracks = playlist.Tracks
      ' %d always inserts 0, don't know why
      i = i + 1
      progress.Text = progressText & " " & SDB.LocalizedFormat("playlist ""%s"" (%s songs)", playlist.Title, CStr(tracks.Count), 0)
      SDB.ProcessMessages

      fout.WriteText "      <dict>" & vbCrLf
      addKey fout, "Name", escapeXML(playlist.Title), "string"
      ' Apparently only used for "Library" playlist:
      ' addKey fout, "Master", Nothing, "true"
      ' addKey fout, "Visible", Nothing, "empty"
      addKey fout, "Playlist ID", playlist.ID, "integer"
      ' No MM field for this:
      ' addKey fout, "Playlist Persistent ID", "4A9134D6F6425130", "string"
      fout.WriteText "         <key>All Items</key><true/>" & vbCrLf
      if tracks.Count > 0 then     
        fout.WriteText "         <key>Playlist Items</key>" & vbCrLf
        fout.WriteText "         <array>" & vbCrLf
        for j = 0 to tracks.Count - 1
          fout.WriteText "            <dict>" & vbCrLf
          fout.WriteText "               <key>Track ID</key><integer>" & tracks.Item(j).ID & "</integer>" & vbCrLf
          fout.WriteText "            </dict>" & vbCrLf
        next
        fout.WriteText "         </array>" & vbCrLf
      end if
      fout.WriteText "      </dict>" & vbCrLf
           
      progress.Value = progress.Value + 50
      if Progress.Terminate or Script.Terminate then
        exit for
      end if
    next
    fout.WriteText "   </array>" & vbCrLf
  end if
 
  fout.WriteText "</dict>" & vbCrLf
  fout.WriteText "</plist>" & vbCrLf
 
  ' writing fout to the file will cause BOM in output file - we need to get rid of it, otherwise it will not work in Traktor...
  Dim BinaryStream
  Set BinaryStream = CreateObject("ADODB.Stream")
  BinaryStream.Type = 1 'binary
  BinaryStream.Mode = 3 'r/w
  BinaryStream.Open
 
  fout.Position = 3 'skip BOM
  fout.CopyTo BinaryStream
 
  BinaryStream.SaveToFile filename, 2
  BinaryStream.Flush
  BinaryStream.Close
 
  fout.Close

  dim ok : ok = not Progress.Terminate and not Script.Terminate
  set Progress = Nothing
  on error resume next
  if not ok then
    fso.DeleteFile(filename) ' remove the output file if terminated
  end if
  SDB.Objects(EXPORTING) = nothing
end sub

sub timedExport(exportTimer)
  if SDB.Objects(EXPORTING) is nothing then
    export
  end if
end sub

' Called when MM starts up, installs a timer to export the data
' frequently to the iTunes library.xml.
sub OnStartup
  if ENABLE_TIMER then
    dim exportTimer : set exportTimer = SDB.CreateTimer(3600000) ' export every 60 minutes
    Script.RegisterEvent exportTimer, "OnTimer", "timedExport"
  end if
end sub


Best,
-ba-
bambule
 
Posts: 1
Joined: Tue Nov 07, 2017 2:08 pm

Previous

Return to Need Help with Addons?

Who is online

Users browsing this forum: No registered users and 13 guests