' ==============
' EmbediTunesArt
' ==============
' Version 1.0.0.1 - September 18th 2020
' Copyright © Steve MacGuire 2010-2020
' http://samsoft.org.uk/iTunes/EmbediTunesArt.vbs
' Please visit http://samsoft.org.uk/iTunes/scripts.asp for updates

' =======
' Licence
' =======

' This program is free software: you can redistribute it and/or modify it under the terms
' of the GNU General Public License as published by the Free Software Foundation, either
' version 3 of the License, or (at your option) any later version.

' This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; 
' without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
' See the GNU General Public License for more details.

' Please visit http://www.gnu.org/licenses/gpl-3.0-standalone.html to view the GNU GPLv3 licence.


' ===========
' Description
' ===========
' Creates a cache of iTunes downloaded or embedded artwork, then embeds art into any track that doesn't have embedded art

' Related scripts: CleanDeadArt, CreateFolderArt, EmbedFolderArt, EmbediTunesArt


' =========
' ChangeLog
' =========
' Version 1.0.0.1 - Initial version


' ==========
' To-do List
' ==========
' Add things to do


' =============================
' Declare constants & variables
' =============================
' Core values for reusable code
' Modified 2014-04-06
Option Explicit	        ' Declare all variables before use
Const Kimo=False        ' True if script expects "Keep iTunes Media folder organised" to be disabled
Const Min=1             ' Minimum number of tracks this script should work with
Const Max=0             ' Maximum number of tracks this script should work with, 0 for no limit
Const Warn=500          ' Warning level, require confirmation for processing above this level
Dim Intro,Outro,Check   ' Manage confirmation dialogs
Dim PB,Prog,Debug       ' Control the progress bar
Dim Clock,T1,T2,Timing  ' The secret of great comedy
Dim Named,Source        ' Control use on named playlist
Dim Playlist,List       ' Name for any generated playlist, and the object itself
Dim iTunes              ' Handle to iTunes application
Dim Tracks              ' A collection of track objects
Dim Count               ' The number of tracks
Dim D,M,P,S,U,V         ' Counters
Dim nl,tab              ' New line/tab strings
Dim IDs                 ' A dictionary object used to ensure each object is processed once
Dim Rev                 ' Control processing order, usually reversed
Dim Quit                ' Used to abort script
Dim Title,Summary       ' Text for dialog boxes
Dim Tracing             ' Display/suppress tracing messages

' Additional variables for this particular script
' Modified 2020-09-18
Dim FSO 		            ' Handle to FileSystemObject
Dim N			              ' Timestamp


' =======================
' Initialise user options
' =======================
' Custom values for this script
' Modified 2020-09-18
Intro=True              ' Set false to skip initial prompts, avoid if non-reversible actions
Outro=True              ' Produce summary report
Check=False             ' Track-by-track confirmation
Prog=False              ' Display progress bar
Debug=True              ' Include any debug messages in progress bar
Timing=True             ' Display running time in summary report
Named=False             ' Force script to process specific playlist rather than current selection or playlist
Rev=False               ' Control processing order, usually reversed
Source=""               ' Named playlist to process, use "Library" for entire library
Tracing=False           ' Display/suppress tracing messages

Title="Embed iTunes Art"
Summary="Creates a cache of iTunes downloaded or embedded artwork, then embeds art into any track that doesn't have embedded art"


' ============
' Main program
' ============

  Init			      ' Set things up
  ProcessTracks		' Main process 
  Report		      ' Summary

' ===================
' End of main program
' ===================


' ===============================
' Declare subroutines & functions
' ===============================


' Format time interval from x.xxx seconds to hh:mm:ss
' Modified 2011-11-07
Function FormatTime(T)
  If T<0 Then T=T+86400         ' Watch for timer running over midnight
  If T<2 Then
    FormatTime=FormatNumber(T,3) & " seconds"
  ElseIf T<10 Then
    FormatTime=FormatNumber(T,2) & " seconds"
  ElseIf T<60 Then
    FormatTime=Int(T) & " seconds"
  Else
    Dim H,M,S
    S=T Mod 60
    M=(T\60) Mod 60             ' \ = Div operator for integer division
    'S=Right("0" & (T Mod 60),2)
    'M=Right("0" & ((T\60) Mod 60),2)  ' \ = Div operator for integer division
    H=T\3600
    If H>0 Then
      FormatTime=H & Plural(H," hours "," hour ") & M & Plural(M," mins"," min")
      'FormatTime=H & ":" & M & ":" & S
    Else
      FormatTime=M & Plural(M," mins "," min ") & S & Plural(S," secs"," sec")
      'FormatTime=M & " :" & S
      'If Left(FormatTime,1)="0" Then FormatTime=Mid(FormatTime,2)
    End If
  End If
End Function


' Get album art from Artwork folder where the script is in the form <Artist> - <Album>.jpg
' Modified 2020-09-18
Function GetArt(T)
  Dim AA,AL,Art,File,Folder,Img,R,Update
  File=""
  With T
    AA=.AlbumArtist & "" : If AA="" Then AA=.Artist & "" : If AA="" Then AA="Unknown Artist"
    AL=.Album & "" : If AL="" Then AL=.Name : If AL="" Then AL="Unknown Album"
    Folder=FSO.GetParentFolderName(WScript.ScriptFullName) & "\Artwork"
    File=Folder & "\" & ValidName(AA & " - " & AL,".jpg")
    If FSO.FileExists(File) Then      ' Found an image, now embed it if necessary
      If .Artwork.Count=1 Then        ' Erase any downloaded artwork
        If .Artwork.Item(1).IsDownloadedArtwork Then
          .Artwork.Item(1).Delete     ' Then remove the store art
        End If
      End If
      If .Artwork.Count=0 Then        ' Now art if a track doesn't have art
        .AddArtworkFromFile(File)     ' Should probably add an error handler here
        U=U+1                         ' Increment update counter
      Else
        V=V+1                         ' Increment counter of unchanged tracks
      End If
    End If
  End With
End Function


' Group digits and separate with commas
' Modified 2014-04-29
Function GroupDig(N)
  GroupDig=FormatNumber(N,0,-1,0,-1)
End Function


' Initialise track selections, quit script if track selection is out of bounds or user aborts
' Modified 2020-09-18
Sub Init
  Dim R,T
  ' Initialise global variables
  D=0
  M=0
  P=0
  S=0
  U=0
  V=0
  Quit=False
  nl=vbCr & vbLf
  ' Initialise global objects
  Set FSO=CreateObject("Scripting.FileSystemObject")
  Set iTunes=CreateObject("iTunes.Application")
  ' Set SH=CreateObject("Shell.Application") 
  Set Tracks=iTunes.SelectedTracks        ' Will error if open modal dialog box
  If Tracks is Nothing Then
    If iTunes.BrowserWindow.SelectedPlaylist.Source.Name<>"Library" Then
      Set Tracks=iTunes.LibraryPlaylist.Tracks
    Else
      Set Tracks=iTunes.BrowserWindow.SelectedPlaylist.Tracks
    End If
  End If
  Count=Tracks.Count
  ' Check there is a suitable number of suitable tracks to work with
  IF Count<Min Or (Count>Max And Max>0) Then
    If Max=0 Then
      MsgBox "Please select " & Min & " or more tracks in iTunes before calling this script!",0,Title
      WScript.Quit
    Else 
      MsgBox "Please select between " & Min & " and " & Max & " tracks in iTunes before calling this script!",0,Title
      WScript.Quit
    End If
  End If
  ' Check if the user wants to proceed and how
  If Intro Then
    T=Summary & nl & nl & "Process " & GroupDig(Count) & " track" & Plural(Count,"s","") & "?"
    R=MsgBox(T,vbOKCancel+vbQuestion,Title)
    If R=vbCancel Then WScript.Quit
  End If  
End Sub


' Return relevant string depending on whether value is plural or singular
' Modified 2011-10-04
Function Plural(V,P,S)
  If V=1 Then Plural=S Else Plural=P
End Function


' Format a list of values for output
' Modified 2012-08-25
Function PrettyList(L,N)
  If L="" Then
    PrettyList=N & "."
  Else
    PrettyList=Replace(Left(L,Len(L)-1)," and" & nl,"," & nl) & " and" & nl & N & "."
  End If
End Function


' Loop through track selection processing suitable items
' Modified 2020-09-18
Sub ProcessTracks
  Dim I,T,SA
  StartTimer
  For I=1 To Count              ' First pass, cache any new artwork images
    Set T=Tracks.Item(I)
    If T.Kind=1 Then		        ' Only process "File" tracks
      P=P+1
      SaveArt T
    End If
  Next
  For I=1 To Count      	      ' Second pass to insert fresh art in tracks that need it
    Set T=Tracks.Item(I)
    If T.Kind=1 Then		        ' Only process "File" tracks
      If T.Location<>"" Then    ' Cannot embed art in missing tracks
        GetArt T
      Else
        M=M+1                   ' Increment mIssing tracks
      End If
    End If
  Next
  StopTimer
End Sub


' Output report
' Modified 2020-09-18
Sub Report
  If Not Outro Then Exit Sub
  Dim L,T
  T=GroupDig(P) & " track" & Plural(P,"s","")
  If P<Count Then T=T & " of " & GroupDig(Count)
  T=T & Plural(P," were"," was") & " processed of which " & nl
  If D>0 Then L=PrettyList(L,GroupDig(D) & Plural(D," were duplicates"," was a duplicate") & " in the list")
  If V>0 Then L=PrettyList(L,GroupDig(V) & " did not need updating")
  If U>0 Or V=0 Then L=PrettyList(L,GroupDig(U) & Plural(U," were"," was") & " updated")
  If M>0 Then L=PrettyList(L,GroupDig(M) & Plural(M," were"," was") & " missing")
  L=L & nl & GroupDig(S) & " new image" & Plural(S,"s were"," was") & " saved."
  T=T & L
  If Timing Then 
    T=T & nl & nl & "Running time: " & FormatTime(Clock) & "."
  End If
  MsgBox T,vbInformation,Title
End Sub


' Save album art in an Artwork folder where the script is in the form <Artist> - <Album>.jpg
' Modified 2020-09-18
Function SaveArt(T)
  Dim AA,AL,Art,File,Folder,Img,R,Update
  File=""
  With T
    If .Location<>"" Then       ' Cannot save art from a file that cannot be found
      AA=.AlbumArtist & "" : If AA="" Then AA=.Artist & "" : If AA="" Then AA="Unknown Artist"
      AL=.Album & "" : If AL="" Then AL=.Name : If AL="" Then AL="Unknown Album"
      Set Art=.Artwork
      If Art.Count>0 Then	      ' Found some art, try to save
        Update=True
        Folder=FSO.GetParentFolderName(WScript.ScriptFullName) & "\Artwork"
        If FSO.FolderExists(Folder)=False Then FSO.CreateFolder(Folder)
        File=Folder & "\" & ValidName(AA & " - " & AL,".jpg")
        If FSO.FileExists(File) Then
          Update=FSO.GetFile(File).DateLastModified<.ModificationDate
          ' MsgBox "File date  = " & FSO.GetFile(File).DateLastModified & nl & "Track date = " & .ModificationDate & nl & "Update = " & Update
        End If
        If Update Then          ' Update existing image if potentially newer
          Set Img=Art.Item(1)
          On Error Resume Next  ' Catch any error saving the file
          Img.SaveArtworkToFile(File)
          If Err.Number<>0 Then
            On Error Goto 0
            R=MsgBox("Error Message: &" & Hex(Err.Number) & " " & Err.Description & nl & "while saving image to:" & nl & File,vbExclamation+vbOKCancel,Title)
            If R=vbCancel Then wscript.quit
            File=""             ' Failed to save, don't export file path
          Else
            S=S+1               ' Update saved art counter
          End If
          On Error Goto 0
        End If
      End If
    End If
  End With
  SaveArt=File
End Function


' Start timing session
' Modified 2011-10-08
Sub StartTimer
  T1=Timer
End Sub


' Stop timing session and add elapased time to running clock
' Modified 2011-10-08
Sub StopTimer
  Clock=Clock+Timer-T1
  If Clock<0 Then Clock=Clock+86400     ' Watch for timer running over midnight
End Sub


' Replace invalid filename characters: \ / : * ? " < > | per http://support.microsoft.com/kb/177506
' Strip leading/trailing spaces & leading periods, trailing periods allowed except for folders
' Change the replacement characters on the right for other valid characters if required
' A name consisting only of spaces or periods is changed to a single underscore
' Pass name and extention, extention="" for folders
' Modified 2012-01-04
Function ValidName(I,E)
  If I="" Then ValidName="" : Exit Function
  Dim N : N=I                   ' Prevent pass by reference error
  N=Replace(N,"\","-")
  N=Replace(N,"/","-")
  N=Replace(N,":",";")
  N=Replace(N,"*","-")
  N=Replace(N,"?","")
  N=Replace(N,"""","''")
  N=Replace(N,"<","{")
  N=Replace(N,">","}")
  N=Replace(N,"|","!")
  Do While (Left(N,1)=" " Or Left(N,1)=".")
    N=Mid(N,2)
    If N=" " Or N="." Then N="_" ' Prevent name from vanishing
  Loop 
  Do While Right(N,1)=" " Or (E="" And Right(N,1)=".")
    N=Left(N,Len(N)-1)
  ' If N=" " Or N="." Then N="_" ' Prevent name from vanishing - Redundant!
  Loop 
  ValidName=N & E
End Function

' ==============
' End of listing
' ==============