MediaMonkey forum

Code: Select all

' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' This file can be replaced  in one of the future versions,
' so please if you want to modify it, make  a copy, do your
' modifications  in that copy and  change Scripts.ini  file 
' appropriately. 
' If you do not do this, you will lose  all your changes in
' this script when you install a new version of MediaMonkey
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Option Explicit     ' report undefined variables, ...

' function for quoting strings
Function QStr( astr)
  QStr = chr(34) & astr & chr(34)
End Function

' function for quoting strings converted to plain ASCII
Function QAStr( astr)
  QAStr = chr(34) & SDB.toASCII(astr) & chr(34)
End Function

Dim list      ' list of songs to be exported
Dim res       ' results of dialogs calls
Dim fullfile  ' fully specified output file name
Dim fso       ' FileSystemObject

' SDB variable is connected to MediaMonkey application object

Sub InitExport( ext, filter, iniDirValue)
  fullfile = ""

  ' Get a list of songs to be exported
  Set list = SDB.CurrentSongList

  If list.count=0 Then
    res = SDB.MessageBox( SDB.Localize("Select tracks to be exported, please."), mtError, Array(mbOk))
    Exit Sub
  End If

  ' Open inifile and get last used directory
  Dim iniF
  Set iniF = SDB.IniFile

  ' Create common dialog and ask where to save the file
  Dim dlg
  Set dlg = SDB.CommonDialog
  dlg.DefaultExt=ext
  dlg.Filter=filter
  dlg.Flags=cdlOFNOverwritePrompt + cdlOFNHideReadOnly + cdlOFNNoChangeDir
  dlg.InitDir = iniF.StringValue( "Scripts", iniDirValue)
  dlg.ShowSave

  if Not dlg.Ok Then
    Exit Sub   ' if cancel was pressed, exit
  End If

  ' Get the selected filename
  fullfile = dlg.FileName

  ' Connect to the FileSystemObject
  Set fso = SDB.Tools.FileSystem

  ' Write selected directory to the ini file
  iniF.StringValue( "Scripts", iniDirValue) = fullfile
End Sub

Sub FinishExport( ok)
  On Error Resume Next

  ' remove the output file if terminated
  if not Ok then
    fso.DeleteFile( fullfile)
  end if
End Sub

Sub ExportCSV
  ' initialize export
  Call InitExport (".csv", "CSV (*.csv)|*.csv|All files (*.*)|*.*", _
      "LastExportCSVDir")
  if fullfile="" then
    Exit Sub
  end if

  ' Create the output file
  Dim fout
  Set fout = fso.CreateTextFile( fullfile, True)

  ' Write header line
  fout.WriteLine Join(Array(SDB.Localize("Artist"),SDB.Localize("Title"), _
    SDB.Localize("Album"),SDB.Localize("Length"),SDB.Localize("Year"), _
    SDB.Localize("Genre"),SDB.Localize("Rating"),SDB.Localize("Bitrate"), _
    SDB.Localize("Path"),SDB.Localize("Media"), SDB.Localize("LastPlayed"), _ 
	SDB.Localize("PlayCounter"), SDB.Localize("Rating")),",")
 
  ' Use progress to notify user about the current action
  Dim Progress
  Set Progress = SDB.Progress
  Progress.Text = SDB.Localize("Exporting...")

  ' Iterate through the list and export all songs
  Progress.MaxValue = list.count
  Dim i, itm
  for i=0 to list.count-1
    Set itm = list.Item(i)
    Dim bitrate
    bitrate = itm.bitrate
    if bitrate>0 then
      bitrate = CStr(Round( bitrate/1000))
    else
      bitrate = ""
    end if
    fout.WriteLine Join( Array( QAStr(itm.ArtistName), QAStr(itm.title), QAStr(itm.AlbumName), _
      QAStr(itm.SongLengthString), CStr(itm.Year), QAStr(itm.Genre), CStr(itm.Rating), CStr(bitrate), _
      QAStr(itm.Path), QAStr(itm.MediaLabel), QAStr(itm.LastPlayed), QAStr.Localize(itm.PlayCounter)),",")
    Progress.Value = i+1
    if Progress.Terminate then
      Exit For
    end if
  next

  ' Close the output file and finish
  fout.Close

  ' Was it successfull?
  Dim ok
  if Progress.Terminate then
    ok = False
  else
    ok = True
  end if

  ' hide progress
  Set Progress = Nothing

  Call FinishExport( ok)
End Sub

 ' escape XML string
Function MapXML( srcstring)
  srcstring = Replace( srcstring, "&", "&")
  srcstring = Replace( srcstring, "<", "<")
  srcstring = Replace( srcstring, ">", ">")
  Dim i
  i=1
  While i<=Len(srcstring)
    If (AscW(Mid(srcstring, i, 1))>127) Then
      srcstring = Mid( srcstring, 1, i-1)+"&#"+CStr( AscW( Mid( srcstring, i, 1)))+";"+Mid( srcstring, i+1, Len(srcstring))
    End If
    i=i+1
  WEnd
  MapXML = srcstring
End Function


Sub ExportHTML 
  ' initialize export 
  Call InitExport( ".htm", "HTML (*.htm)|*.htm|All files (*.*)|*.*", _ 
  "LastExportHTMLDir") 
  if fullfile="" then 
  Exit Sub 
  end if 

  ' Create the output file 
  Dim fout 
  Set fout = fso.CreateTextFile( fullfile, True) 

  ' Write header line 
  fout.WriteLine "<html>" 
  fout.WriteLine "<head><title>" & SDB.Localize("MediaMonkey Track List") & "</title>" 

  ' Code to format the document 
  fout.WriteLine "<style type=text/css>" 
  fout.WriteLine "body{font-family:'Verdana',sans-serif; background-color:#FFFFFF; font-size:9pt; color:#000000;}" 
  fout.WriteLine "H1{font-family:'Verdana',sans-serif; font-size:13pt; font-weight:bold; color:#AAAAAA; text-aligh:left}" 
  fout.WriteLine "P{font-family:'Verdana',sans-serif; font-size:9pt; color:#000000;}" 
  fout.WriteLine "TH{font-family:'Verdana',sans-serif; font-size:10pt; font-weight:bold; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:3px;}" 
  fout.WriteLine "TD{font-family:'Verdana',sans-serif; font-size:9pt; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:1px;}" 
  fout.Writeline "TD.dark{background-color:#EEEEEE}" 
  fout.WriteLine "</style>" 

  fout.WriteLine "</head><body>" 
  fout.WriteLine "<a href='http://www.mediamonkey.com'><h1>" & SDB.Localize("MediaMonkey Track List")&"</h1></a>" 

  ' Headers of table 
  fout.WriteLine "<table cellpadding=4 cellspacing=0>" 
  fout.WriteLine "<tr align=left>" 
  fout.WriteLine " <th id=dark>#</th>" 
  fout.WriteLine " <th>" & SDB.Localize("Artist") & "</th>" 
  fout.WriteLine " <th id=dark>" & SDB.Localize("Title") & "</th>" 
  fout.WriteLine " <th>" & SDB.Localize("Length") & "</th>" 
  fout.WriteLine " <th id=dark>" & SDB.Localize("Album") & "</th>" 
  fout.WriteLine " <th>" & SDB.Localize("Track #") & "</th>" 
  fout.WriteLine " <th id=dark>" & SDB.Localize("Year") & "</th>" 
  fout.WriteLine " <th>" & SDB.Localize("Genre") & "</th>" 
  fout.WriteLine " <th id=dark>" & SDB.Localize("Rating") & "</th>" 
  fout.WriteLine " <th>" & SDB.Localize("Bitrate") & "</th>" 
  fout.WriteLine " <th id=dark>" & SDB.Localize("Media") & "</th>" 
  fout.WriteLine "</tr>" 

  ' Use progress to notify user about the current action 
  Dim Progress 
  Set Progress = SDB.Progress 
  Progress.Text = SDB.Localize("Exporting...")

  ' Iterate through the list and export all songs 
  Progress.MaxValue = list.count 
  Dim i, itm 
  for i=0 to list.count-1 
    Set itm = list.Item(i) 
    Dim bitrate 
    bitrate = itm.bitrate 
    if bitrate>0 then 
      bitrate = CStr(Round( bitrate/1000)) 
    else 
      bitrate = "&nbsp;" 
    end if 
    Dim year 
    year = itm.year 
    if year<=0 then 
      year = "&nbsp;" 
    else 
      year = CStr( year) 
    end if 

    ' Add space to empty fields, so table is displayed correctly (Cell borders do not show up for empty cells) 
    Dim artistname 
    artistname = MapXML(itm.ArtistName)
    if artistname="" then 
      artistname = "&nbsp;" 
    end if 

    Dim songtitle 
    songtitle = MapXML(itm.title)
    if songtitle="" then 
      songtitle = "&nbsp;" 
    end if 

    Dim albumname 
    albumname = MapXML(itm.AlbumName)
    if albumname="" then 
      albumname = "&nbsp;" 
    end if 

    Dim songlength 
    songlength = itm.SongLengthString 
    if songlength="" then 
      songlength = "&nbsp;" 
    end if 

    Dim songgenre 
    songgenre = MapXML(itm.Genre)
    if songgenre="" then 
      songgenre = "&nbsp;" 
    end if 

    Dim trackorder 
    trackorder = itm.TrackOrder 
    if trackorder="" then 
      trackorder = "&nbsp;" 
    elseif trackorder = "0" then 
      trackorder = "&nbsp;" 
    end if 

    ' These are added to get some decent display, all the others haven't, this script is just to demonstrate all the available options 

    Dim rating 
    Dim ratingCal
    rating = itm.Rating 
    
    Select Case rating
  Case ""
    ratingCal = "&nbsp;"
  Case -1
    ratingCal = "&nbsp;"
  Case 100
    ratingCal = 5
  Case 90
    ratingCal = 4.5
  Case 80
    ratingCal = 4
  Case 70
    ratingCal = 3.5
  Case 60
    ratingCal = 3
  Case 50
    ratingCal = 2.5
  Case 40
    ratingCal = 2
  Case 30
    ratingCal = 1.5
  Case 20
    ratingCal = 1
  Case 10
    ratingCal = 0.5
  Case 0
    ratingCal = 0
  Case Else
    ratingCal = "&nbsp;"
    End Select
  
    Dim medialabel
    medialabel = MapXML(itm.MediaLabel)
    if medialabel="" then 
      medialabel = "&nbsp;" 
    end if

    ' Body of the table 
    fout.WriteLine "<tr><td align=right class=dark>"&i+1&"</td><td>"&artistname&"</td><td class=dark>"&songtitle _ 
    &"</td><td align=right>"&songlength&"</td><td class=dark>"&albumname _ 
    &"</td><td align=right>"&trackorder&"</td><td align=right class=dark>"&Year _ 
    &"</td><td>"&songgenre&"</td><td class=Dark>"&ratingCal&"</td><td align=right>"&bitrate _ 
    &"</td><td align=right class=Dark>"&medialabel&"</td></tr>" 
    Progress.Value = i+1 
    if Progress.Terminate then 
      Exit For 
    end if 
  next 

  ' Write some code to finish html document 
  fout.WriteLine "</table><p/><table width=100%><tr>"
  fout.WriteLine "<td style='border-bottom-width:0px'><b>"&SDB.Localize("Total Tracks:")&" </b>"&i&"</td> <td align=right style='border-bottom-width:0px'>Generated by <a href='http://www.mediamonkey.com'>MediaMonkey</a></td>"
  fout.WriteLine "</tr></table></body></html>"

  ' Close the output file and finish 
  fout.Close 

  ' Was it successfull? 
  Dim ok 
  if Progress.Terminate then 
    ok = False 
  else 
    ok = True 
  end if 

  ' hide progress 
  Set Progress = Nothing 

  FinishExport( ok) 
End Sub 


Sub ExportXLS
  ' initialize export
  Call InitExport( ".xls", "Excel sheet (*.xls)|*.xls|All files (*.*)|*.*", _
        "LastExportExcelDir")
  if fullfile="" then
    Exit Sub
  end if

  if fso.FileExists( fullfile) then
    fso.DeleteFile( fullfile)
  end if

  On Error Resume Next

  ' Connect to Excel
  Dim Excel, WB, WS
  Set Excel = CreateObject("Excel.application")

  If Err.Number<>0 then
    MsgBox "Microsoft Excel could not be found, please install it and try again."
    Err.Clear
    Exit Sub
  End If
  On Error GoTo 0

  ' Create a new workbook and get its worksheet
  Set WB = Excel.WorkBooks.Add
  Set WS = WB.Sheets(1)

  ' Use progress to notify user about the current action
  Dim Progress
  Set Progress = SDB.Progress
  Progress.Text = SDB.Localize("Exporting...")

  ' Create a header
  WS.Cells(1,1).Value = SDB.Localize("Artist")
  WS.Cells(1,2).Value = SDB.Localize("Album")
  WS.Cells(1,3).Value = SDB.Localize("Title")
  WS.Cells(1,4).Value = SDB.Localize("Length")
  WS.Cells(1,5).Value = SDB.Localize("Year")
  WS.Cells(1,6).Value = SDB.Localize("Genre")
  WS.Cells(1,7).Value = SDB.Localize("Bitrate")
  WS.Cells(1,8).Value = SDB.Localize("Media")

  WS.Rows("1:1").Font.Bold = True

  Dim ms2Day
  ms2Day = 24*60*60*1000

  ' Iterate through the list and export all songs
  Progress.MaxValue = list.count
  Dim i, itm
  for i=0 to list.count-1
    Set itm = list.Item(i)
    Dim bitrate
    bitrate = itm.bitrate
    if bitrate>0 then
      bitrate = CStr(Round( bitrate/1000))
    else
      bitrate = ""
    end if
    Dim year
    year = itm.year
    if year<=0 then
      year = ""
    else
      year = CStr( year)
    end if

    WS.Cells(i+2,1).Value = itm.ArtistName
    WS.Cells(i+2,2).Value = itm.AlbumName
    WS.Cells(i+2,3).Value = itm.title
    WS.Cells(i+2,4).NumberFormat = "mm:ss"
    If itm.SongLength>=0 Then
      WS.Cells(i+2,4).Value = itm.SongLength / ms2Day
    End If
    WS.Cells(i+2,5).Value = year
    WS.Cells(i+2,6).Value = itm.Genre
    WS.Cells(i+2,7).Value = bitrate
    WS.Cells(i+2,8).Value = itm.MediaLabel

    Progress.Value = i+1
    if Progress.Terminate then
      Exit For
    end if
  next

  ' Was it successfull?
  Dim ok
  if Progress.Terminate then
    ok = False
  else
    ok = True
    WB.SaveAs fullfile
  end if

  WB.Close false

  ' hide progress
  Set Progress = Nothing

  FinishExport( ok)
End Sub

Sub ExportXML
  ' initialize export
  Call InitExport (".xml", "XML (*.xml)|*.xml|All files (*.*)|*.*", _
      "LastExportXMLDir")
  if fullfile="" then
    Exit Sub
  end if

  ' Create the output file
  Dim fout
  Set fout = fso.CreateTextFile( fullfile, True)

  ' Use progress to notify user about the current action
  Dim Progress
  Set Progress = SDB.Progress
  Dim ProgressString
  ProgressString = SDB.Localize("Exporting...")

  Dim i
  Dim Artists, Artist
  Set Artists = list.Artists
  Dim Albums, Album
  Set Albums = list.Albums

  fout.WriteLine "<?xml version='1.0'?>"
  fout.WriteLine "<MusicDatabase>"

  Progress.MaxValue = list.count + Artists.Count + Albums.Count

  Progress.Text = ProgressString & " (artists)"
  fout.WriteLine "  <Artists>"
  for i=0 to Artists.count-1
    Set Artist = Artists.Item(i)
    fout.WriteLine "    <Artist id=""Artist_"&Artist.id&""">"
    fout.WriteLine "       <Name>" & MapXML(Artist.Name) & "</Name>"
    fout.WriteLine "    </Artist>"
    Progress.Increase
    if Progress.Terminate then
      Exit For
    end if
  next
  fout.WriteLine "  </Artists>"

  Progress.Text = ProgressString & " (albums)"
  fout.WriteLine "  <Albums>"
  for i=0 to Albums.count-1
    Set Album = Albums.Item(i)
    fout.WriteLine "    <Album id=""Album_"&Album.id&""">"
    fout.WriteLine "       <PerformingArtist id="""& Album.Artist.id & """>" & MapXML(Album.Artist.Name) & "</PerformingArtist>"
    fout.WriteLine "       <Name>" & MapXML(Album.Name) & "</Name>"
    fout.WriteLine "    </Album>"
    Progress.Increase
    if Progress.Terminate then
      Exit For
    end if
  next
  fout.WriteLine "  </Albums>"

  ' Iterate through the list and export all songs
  Progress.Text = ProgressString & " (songs)"
  fout.WriteLine "  <Songs>"
  Progress.MaxValue = list.count
  Dim Song, Media
  for i=0 to list.count-1
    Set Song = list.Item(i)
    fout.WriteLine "    <Song id=""Song_"&Song.id&""">"
    fout.WriteLine "       <Title>" & MapXML(Song.Title) & "</Title>"
    fout.WriteLine "       <PerformingArtist id=""Artist_"& Song.Artist.id & """>" & MapXML(Song.ArtistName) & "</PerformingArtist>"
    fout.WriteLine "       <ContainedInAlbum id=""Album_"& Song.Album.id & """>" & MapXML(Song.AlbumName) & "</ContainedInAlbum>"
    fout.WriteLine "       <SongLength ms="""& Song.SongLength &""">" & MapXML(Song.SongLengthString) & "</SongLength>"
    if Song.Year>0 then
      fout.WriteLine "       <Year value="""& MapXML(Song.Year) &"""/>"
    end if
    if Song.Genre<>"" then
      fout.WriteLine "       <Genre>"& MapXML(Song.Genre) &"</Genre>"
    end if
    fout.WriteLine "       <Bitrate>"& MapXML(Song.Bitrate) &"</Bitrate>"

    fout.WriteLine "       <Location>"
    Set Media = Song.Media
    If Not IsNull( Media) And Not IsEmpty( Media) And IsObject( Media) Then
      fout.WriteLine "         <Media id=""Media_"&Media.id&""" sn=""" & _
        Media.SerialNumber & """>"& MapXML(Media.MediaLabel) &"</Media>"
    End If

    fout.WriteLine "         <Path>"& MapXML(Song.Path) &"</Path>"
    fout.WriteLine "       </Location>"

    fout.WriteLine "    </Song>"
    Progress.Increase
    if Progress.Terminate then
      Exit For
    end if
  next
  fout.WriteLine "  </Songs>"

  fout.WriteLine "</MusicDatabase>"

  ' Close the output file and finish
  fout.Close

  ' Was it successfull?
  Dim ok
  if Progress.Terminate then
    ok = False
  else
    ok = True
  end if

  ' hide progress
  Set Progress = Nothing

  Call FinishExport( ok)
End Sub

Code: Select all

QAStr(itm.Path), QAStr(itm.MediaLabel), QAStr(itm.LastPlayed), QAStr.Localize(itm.PlayCounter)),",")

Code: Select all

QAStr(itm.Path), QAStr(itm.MediaLabel), QAStr(itm.LastPlayed), QAStr(itm.PlayCounter)),",")