Export to iTunes library.xml

PJ-014 · Post by **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.

bambule · Post by **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 = "&"
    elseif currentchar = "<" then
      replacement = "<"
    elseif currentchar = ">" then
      replacement = ">"
    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-

VariableFlame · Post by **VariableFlame** » Sun Jan 07, 2018 5:10 pm

Hi guys,

I recently wanted to make the switch to MusicBee and I stumbled upon this great script. However, it was having some problems with number signs (#) in the URI string, so I fixed that. And also, I wanted to migrate the "Last Played" field, so I added that too:

Code: Select all

' This script exports the complete MediaMonkey database (songs and playlist) into
' the iTunes xml format. Some caveats apply, for details and the latest version
' see the MediaMonkey forum thread at
' http://www.mediamonkey.com/forum/viewtopic.php?f=2&t=31680
'
' Change history:
' 1.0   initial version
' 1.1   options added for disabling timer and showing a file selection dialog
' 1.2   fixed: unicode characters (e.g. Chinese) were encoded different than iTunes does
' 1.3   fixed: handling of & and # in URI encoding, added Last Played

option explicit     ' report undefined variables, ...

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

' End of options.

'  ------------------------------------------------------------------
const EXPORTING = "itunes_export_active"
dim scriptControl ' : scriptControl = CreateObject("ScriptControl")

' Returns encoded URI for provided location string. 
function encodeLocation(location)
  ' 10.10.2010: need jscript engine to access its encodeURI function which is not 
  ' available in vbscript
  if isEmpty(scriptControl) then
    set scriptControl = CreateObject("ScriptControl")
    scriptControl.Language = "JScript"
  end if

  location = replace(location, "\", "/")
  location = replace(location, "&", "&")
  encodeLocation = scriptControl.Run("encodeURI", location)
  encodeLocation = replace(encodeLocation, "#", "%23")
end function

' Returns UTF8 equivalent string of the provided Unicode codepoint c.
' For the argument AscW should be used to get the Unicode codepoint
' (not Asc).
' Function by "Arnout", copied from this stackoverflow question:
' http://stackoverflow.com/questions/378850/utf-8-file-appending-in-vbscript-classicasp-can-it-be-done
function Utf8(ByVal c)
  dim b1, b2, b3
  if c < 128 then
    Utf8 = chr(c)
  elseif c < 2048 then
    b1 = c mod 64
    b2 = (c - b1) / 64
    Utf8 = chr(&hc0 + b2) & chr(&h80 + b1)
  elseif c < 65536 then
    b1 = c mod 64
    b2 = ((c - b1) / 64) mod 64
    b3 = (c - b1 - (64 * b2)) / 4096
    Utf8 = chr(&he0 + b3) & chr(&h80 + b2) & chr(&h80 + b1)
  end if
end function

' 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 = "&"
    elseif currentchar = "<" then
      replacement = "<"
    elseif currentchar = ">" then
      replacement = ">"
    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
      if codepoint > 127 or currentchar = vbTab or currentchar = vbLf or currentchar = vbCr then
        ' replacement = "&#" + CStr(codepoint) + ";"
        replacement = Utf8(codepoint)
      elseif codepoint < 32 then
        replacement = ""
      end if
    end if
    
    if not IsNull(replacement) then ' otherwise we keep the original srcstring character (common case)
      srcstring = mid(srcstring, 1, i - 1) + replacement + Mid(srcstring, i + 1, Len(srcstring))
      i = i + len(replacement)
    else
      i = i + 1
    end if
  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.WriteLine "            <key>" & key & "</key><" & keytype & ">" & val & "</" & keytype & ">"
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, fso, 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 fso = SDB.Tools.FileSystem
  set fout = fso.CreateTextFile(filename, true)

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

  ' 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.WriteLine "    <key>Tracks</key>"
    fout.WriteLine "    <dict>"
    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.WriteLine "        <key>" & Song.id & "</key>"
      fout.WriteLine "        <dict>   "
      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, "Play Date UTC", Song.LastPlayed, "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"
      
      ' 10.10.2010: fixed: location was not correctly URI encoded before
      ' addKey fout, "Location", "file://localhost/" & Replace(Replace(Escape(Song.Path), "%5C", "/"), "%3A", ":"), "string"
      addKey fout, "Location", encodeLocation("file://localhost/" & Song.Path), "string"

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

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

      fout.WriteLine "        </dict>"

      Progress.Increase
    wend
    fout.WriteLine "    </dict>"
  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.WriteLine "    <key>Playlists</key>"
    fout.WriteLine "    <array>"
    
    ' 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.WriteLine "        <dict>"
      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.WriteLine "            <key>All Items</key><true/>"
      if tracks.Count > 0 then      
        fout.WriteLine "            <key>Playlist Items</key>"
        fout.WriteLine "            <array>"
        for j = 0 to tracks.Count - 1
          fout.WriteLine "                <dict>"
          fout.WriteLine "                    <key>Track ID</key><integer>" & tracks.Item(j).ID & "</integer>"
          fout.WriteLine "                </dict>"
        next 
        fout.WriteLine "            </array>"
      end if
      fout.WriteLine "        </dict>"
            
      progress.Value = progress.Value + 50
      if Progress.Terminate or Script.Terminate then
        exit for
      end if
    next 
    fout.WriteLine "    </array>"
  end if
  
  fout.WriteLine "</dict>"
  fout.WriteLine "</plist>"
  fout.Close ' Close the output file and finish

  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

Cheers :)

x1x2x3 · Post by **x1x2x3** » Fri Feb 02, 2018 4:19 pm

Do you have an installer for this please?

VariableFlame wrote:Hi guys,

I recently wanted to make the switch to MusicBee and I stumbled upon this great script. However, it was having some problems with number signs (#) in the URI string, so I fixed that. And also, I wanted to migrate the "Last Played" field, so I added that too:

Code: Select all

' This script exports the complete MediaMonkey database (songs and playlist) into
' the iTunes xml format. Some caveats apply, for details and the latest version
' see the MediaMonkey forum thread at
' http://www.mediamonkey.com/forum/viewtopic.php?f=2&t=31680
'
' Change history:
' 1.0   initial version
' 1.1   options added for disabling timer and showing a file selection dialog
' 1.2   fixed: unicode characters (e.g. Chinese) were encoded different than iTunes does
' 1.3   fixed: handling of & and # in URI encoding, added Last Played

option explicit     ' report undefined variables, ...

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

' End of options.

'  ------------------------------------------------------------------
const EXPORTING = "itunes_export_active"
dim scriptControl ' : scriptControl = CreateObject("ScriptControl")

' Returns encoded URI for provided location string. 
function encodeLocation(location)
  ' 10.10.2010: need jscript engine to access its encodeURI function which is not 
  ' available in vbscript
  if isEmpty(scriptControl) then
    set scriptControl = CreateObject("ScriptControl")
    scriptControl.Language = "JScript"
  end if

  location = replace(location, "\", "/")
  location = replace(location, "&", "&")
  encodeLocation = scriptControl.Run("encodeURI", location)
  encodeLocation = replace(encodeLocation, "#", "%23")
end function

' Returns UTF8 equivalent string of the provided Unicode codepoint c.
' For the argument AscW should be used to get the Unicode codepoint
' (not Asc).
' Function by "Arnout", copied from this stackoverflow question:
' http://stackoverflow.com/questions/378850/utf-8-file-appending-in-vbscript-classicasp-can-it-be-done
function Utf8(ByVal c)
  dim b1, b2, b3
  if c < 128 then
    Utf8 = chr(c)
  elseif c < 2048 then
    b1 = c mod 64
    b2 = (c - b1) / 64
    Utf8 = chr(&hc0 + b2) & chr(&h80 + b1)
  elseif c < 65536 then
    b1 = c mod 64
    b2 = ((c - b1) / 64) mod 64
    b3 = (c - b1 - (64 * b2)) / 4096
    Utf8 = chr(&he0 + b3) & chr(&h80 + b2) & chr(&h80 + b1)
  end if
end function

' 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 = "&"
    elseif currentchar = "<" then
      replacement = "<"
    elseif currentchar = ">" then
      replacement = ">"
    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
      if codepoint > 127 or currentchar = vbTab or currentchar = vbLf or currentchar = vbCr then
        ' replacement = "&#" + CStr(codepoint) + ";"
        replacement = Utf8(codepoint)
      elseif codepoint < 32 then
        replacement = ""
      end if
    end if
    
    if not IsNull(replacement) then ' otherwise we keep the original srcstring character (common case)
      srcstring = mid(srcstring, 1, i - 1) + replacement + Mid(srcstring, i + 1, Len(srcstring))
      i = i + len(replacement)
    else
      i = i + 1
    end if
  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.WriteLine "            <key>" & key & "</key><" & keytype & ">" & val & "</" & keytype & ">"
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, fso, 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 fso = SDB.Tools.FileSystem
  set fout = fso.CreateTextFile(filename, true)

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

  ' 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.WriteLine "    <key>Tracks</key>"
    fout.WriteLine "    <dict>"
    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.WriteLine "        <key>" & Song.id & "</key>"
      fout.WriteLine "        <dict>   "
      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, "Play Date UTC", Song.LastPlayed, "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"
      
      ' 10.10.2010: fixed: location was not correctly URI encoded before
      ' addKey fout, "Location", "file://localhost/" & Replace(Replace(Escape(Song.Path), "%5C", "/"), "%3A", ":"), "string"
      addKey fout, "Location", encodeLocation("file://localhost/" & Song.Path), "string"

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

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

      fout.WriteLine "        </dict>"

      Progress.Increase
    wend
    fout.WriteLine "    </dict>"
  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.WriteLine "    <key>Playlists</key>"
    fout.WriteLine "    <array>"
    
    ' 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.WriteLine "        <dict>"
      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.WriteLine "            <key>All Items</key><true/>"
      if tracks.Count > 0 then      
        fout.WriteLine "            <key>Playlist Items</key>"
        fout.WriteLine "            <array>"
        for j = 0 to tracks.Count - 1
          fout.WriteLine "                <dict>"
          fout.WriteLine "                    <key>Track ID</key><integer>" & tracks.Item(j).ID & "</integer>"
          fout.WriteLine "                </dict>"
        next 
        fout.WriteLine "            </array>"
      end if
      fout.WriteLine "        </dict>"
            
      progress.Value = progress.Value + 50
      if Progress.Terminate or Script.Terminate then
        exit for
      end if
    next 
    fout.WriteLine "    </array>"
  end if
  
  fout.WriteLine "</dict>"
  fout.WriteLine "</plist>"
  fout.Close ' Close the output file and finish

  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

Cheers

Post by **Peke** » Fri Feb 02, 2018 4:26 pm

Hi,
From what I see you save it as "Export to iTunes library.vbs" in Scripts\Auto folder and it is executed on startup and set scheduled exports.

MagGyver · Post by **MagGyver** » Mon Feb 26, 2018 4:36 pm

Hi, thank you for working on this. I too have been having crashes when loading iTunes after updating to 2.11.2. I copied your amended code as listed under "Here you are" but now when I close MM, it no longer launches the script, even though I have it placed in the Scripts\Auto folder. Was I supposed to replace the previous contents of the VBS file, or amend it somehow? Sorry if this is ignorant but it feels like I'm just one step away from making this work again...

bambule wrote: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 = "&"
    elseif currentchar = "<" then
      replacement = "<"
    elseif currentchar = ">" then
      replacement = ">"
    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-

Post by **Peke** » Tue Feb 27, 2018 12:59 pm

Have you tried to use http://www.mediamonkey.com/wiki/index.php/SDBTools and UTF Masked char format that is intended for WEB or even ascii chars conversion.

Also to better understand is it possible that you manually make/correct XML file with one or two tracks eg. with one that works in Traktor and one that do not work? I just want to follow.

MagGyver · Post by **MagGyver** » Tue Feb 27, 2018 1:51 pm

Hi Pavle, I'm assuming you're directing this at bambule, the user who provided the workaround code. If you were directing this at me, as the most recent poster on this thread, I'll need some further explanation as I don't understand this level of tech.

If not, is there anything you can suggest for me to get this amended code to launch automatically since it's already placed in the Scripts\Auto folder?

Peke wrote:Have you tried to use http://www.mediamonkey.com/wiki/index.php/SDBTools and UTF Masked char format that is intended for WEB or even ascii chars conversion.

Also to better understand is it possible that you manually make/correct XML file with one or two tracks eg. with one that works in Traktor and one that do not work? I just want to follow.

Post by **Peke** » Tue Feb 27, 2018 8:40 pm

Hi,
You are right I'm mainly replying to bambule, but as you touched it I was assuming you can and want to do some cleaning.

Unfortunately this 10 year old Script needs overhaul and update using latest features. I have not dived deep into script, but like I said brute force comparing od two XMLs with one or two tracks manually corrected should help to determine what changes are needed.

MagGyver · Post by **MagGyver** » Tue Feb 27, 2018 9:11 pm

Peke wrote: brute force comparing od two XMLs with one or two tracks manually corrected should help to determine what changes are needed.

Sigh...I am still clueless about how to implement this suggestion. I've actually contracted a VB coder on Fiverr to take a look at the 2 scripts and see if he can figure out what's missing. I don't know what else to do. If I don't get the playlists exported soon I'll not have enough time to prepare for my first DJ set of the month this Sunday...

bambule · Post by **bambule** » Sun Mar 18, 2018 10:32 am

Hey,

sorry for my late response, but I totally missed your posts.

@MagGyver:
I' ve just modified the original script posted by DC to that code I've posted before.
My export either runs every 60 minutes or when started manually from File/Create Reports/Tracks and Playlists (Itunes library.xml)...
Have you adapted the scripts.ini as well, as it has been mentioned before in this thread? (http://www.mediamonkey.com/forum/viewto ... 15#p168587)
Make sure that the filename of your script matches what you got in scripts.ini.
Good Luck.

@Peke:
What I've learned while figuring out what is happening:
- (original Apple) UTF-8 file works
- ANSI file works (as long there are no special characters, see below)
- ANSI file with special characters makes Traktor crash (for example title contains "&#228")
- As far i can remember (but I am not sure at that point), UTF-8 file with characters written in ASCII code ("&#228" instead of "ä"), made Traktor also crash.

What I understand is, that Native Instruments has overworked Traktor with that version massively, and something has been changed at that Itunes import part, which broke the import of ASCII-coded characters.
Because Apple has exported the xml always in UTF-8 format (which makes possible to have "ä" in the file), NI will not have noticed a bug here.

I am no VB specialist (in fact it was the first time modifiying a VBA script), but I was simply comparing the original Itunes.xml from Apple with that what we write and noticed that Apple writes UTF-8 / without BOM and we ANSI.
With two changes (with help by Dr. Google) the script worked again for me:
- Dont use ASCII-code number for special characters (write "ä" instead of "&#228")
- Write UTF-8 file

Best regards,
bambule

MagGyver · Post by **MagGyver** » Wed Mar 28, 2018 8:56 pm

Hi, I'll take a look again when I have a moment. In the meantime, I reverted back to an earlier version of Traktor which does not have the issue so that I could prepare for my sets in time. The next time I have a few weeks of down time between gigs, I'll play around with it again. Thanks!!

bambule wrote:Hey,

sorry for my late response, but I totally missed your posts.

@MagGyver:
I' ve just modified the original script posted by DC to that code I've posted before.
My export either runs every 60 minutes or when started manually from File/Create Reports/Tracks and Playlists (Itunes library.xml)...
Have you adapted the scripts.ini as well, as it has been mentioned before in this thread? (http://www.mediamonkey.com/forum/viewto ... 15#p168587)
Make sure that the filename of your script matches what you got in scripts.ini.
Good Luck.

Best regards,
bambule

fvdpol · Post by **fvdpol** » Fri Jul 06, 2018 9:16 am

Thanks for providing this great script as this allows for managing my library in Media Monkey instead of in Native Instruments Traktor. I found that the script was creating XML files that Traktor was not able to open due to some illegal characters. Updated the latest (?) version of DC's script with the modifications by VariableFlame to make it work (again?) with Traktor.

New version 1.4 successfully tested with Traktor DJ 2.11.3 17 on both Windows and MacOS.

To keep a better track on changes to this script I created a repository in GitHub to keep track of changes:
https://github.com/fvdpol/MM-ExportITunesLibraryXml

PS: I noticed some other modifications/changes in this forum topic; my intent is to also include these in future release.

fvdpol · Post by **fvdpol** » Sun Jul 15, 2018 4:23 pm

Quick update on my progress;

Integrated the various updates/changes I could find in this forum
created an mmip package for this script --> no need anymore to fiddle with the various vbs/ini files
removed the menu entry; export can be triggered from the scripts menu or using the new toolbar button

to-do:

settings for the various options

a pre-release of the new installer is available in the 'mmip-package' branch on github: https://github.com/fvdpol/MM-ExportITun ... esXML.MMIP

fvdpol wrote: ↑Fri Jul 06, 2018 9:16 am Thanks for providing this great script as this allows for managing my library in Media Monkey instead of in Native Instruments Traktor. I found that the script was creating XML files that Traktor was not able to open due to some illegal characters. Updated the latest (?) version of DC's script with the modifications by VariableFlame to make it work (again?) with Traktor.

New version 1.4 successfully tested with Traktor DJ 2.11.3 17 on both Windows and MacOS.

To keep a better track on changes to this script I created a repository in GitHub to keep track of changes:
https://github.com/fvdpol/MM-ExportITunesLibraryXml

PS: I noticed some other modifications/changes in this forum topic; my intent is to also include these in future release.

MagGyver · Post by **MagGyver** » Thu Jul 19, 2018 12:41 pm

Thanks for this! I'm so tickled that there are others out there with this same need who are proficient at coding

Has anyone else tried this out yet? I'd love to know. I went through so much hassle when I had to downgrade my Traktor version for compatibility that I'm probably a little gunshy about giving this a go...

fvdpol wrote: ↑Sun Jul 15, 2018 4:23 pm Quick update on my progress;

Integrated the various updates/changes I could find in this forum

created an mmip package for this script --> no need anymore to fiddle with the various vbs/ini files

removed the menu entry; export can be triggered from the scripts menu or using the new toolbar button

to-do:
settings for the various options

a pre-release of the new installer is available in the 'mmip-package' branch on github: https://github.com/fvdpol/MM-ExportITun ... esXML.MMIP

fvdpol wrote: ↑Fri Jul 06, 2018 9:16 am Thanks for providing this great script as this allows for managing my library in Media Monkey instead of in Native Instruments Traktor. I found that the script was creating XML files that Traktor was not able to open due to some illegal characters. Updated the latest (?) version of DC's script with the modifications by VariableFlame to make it work (again?) with Traktor.

New version 1.4 successfully tested with Traktor DJ 2.11.3 17 on both Windows and MacOS.

To keep a better track on changes to this script I created a repository in GitHub to keep track of changes:
https://github.com/fvdpol/MM-ExportITunesLibraryXml

PS: I noticed some other modifications/changes in this forum topic; my intent is to also include these in future release.

Export to iTunes library.xml

Re: Export to iTunes library.xml

Re: Export to iTunes library.xml

Re: Export to iTunes library.xml

Re: Export to iTunes library.xml

Re: Export to iTunes library.xml

Re: Export to iTunes library.xml

Re: Export to iTunes library.xml

Re: Export to iTunes library.xml

Re: Export to iTunes library.xml

Re: Export to iTunes library.xml

Re: Export to iTunes library.xml

Re: Export to iTunes library.xml

Re: Export to iTunes library.xml

Re: Export to iTunes library.xml

Re: Export to iTunes library.xml