' ===============
' CreateFolderArt
' ===============

' Version 1.0.0.5 - May 31st 2012
' Copyright © Steve MacGuire 2010-2012


' =======
' 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
' ===========

' Create Folder.jpg album artwork for selected tracks or all tracks in the current playlist


' =========
' ChangeLog
' =========

' Version 1.0.0.1 - Initial version
' Version 1.0.0.2 - Extended to support overwriting existing tracks
' Version 1.0.0.3 - Optional second pass to add/embed freshly saved image for tracks with none/downloaded art
' Version 1.0.0.4 - Bug fixes for missing files or redirected paths
' Version 1.0.0.5 - Ignore missing download art error


' Visit http://samsoft.org.uk/iTunes/scripts.asp for updates


' ==========
' To-do List
' ==========

' Add things to do


' =============================
' Declare constants & variables
' =============================

Option Explicit
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
'Dim CD			' Handle to CommonDialog object
Dim FSO 		' Handle to FileSystemObject
Dim iTunes		' Handle to iTunes application
'Dim SH			' Handle to Shell application
Dim nl			' New line string for messages
Dim Title		' Message box title
Dim Tracks		' A collection of track objects
Dim Count		' The number of tracks
Dim A,P,S,U		' Counters
Dim Q			' Global flag
Dim Dbg			' Manage debugging output
Dim Opt			' Script options
Dim N			' Timestamp


' =======================
' Initialise user options
' =======================

' N.B. Edit Opt value to suit your needs.

' Control options, add bit values (x) for selective actions
' Bit 0 = Suppress dialog box for previews, just process tracks					                  (1)
' Bit 1 = Suppress summary report								                                          (2)
' Bit 2 = In no selection process entire library, otherwise restict to current playlist		(4)
' Bit 3 = Update existing folder images								                                    (8)
' Bit 4 = Embed art if track has none and recently refreshed art exists in folder	       (16)

Opt=28

' Debug/report options, add bit values (x) for selective actions, initial value may be modified during run
' Bit 0 = Confirm actions									                                                (1)

Dbg=0


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

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

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


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


' Initialise track selections, quit script if track selection is out of bounds or user aborts
Sub Init
  Dim R,T
  ' Initialise global variables
  A=0
  P=0
  S=0
  U=0
  Q=False
  nl=vbCr & vbLf
  Title="Create Folder Art"
  ' Initialise global objects
  Set FSO=CreateObject("Scripting.FileSystemObject")
  Set iTunes=CreateObject("iTunes.Application")
  ' Set SH=CreateObject("Shell.Application") 

  Set Tracks=iTunes.SelectedTracks
  If Tracks is Nothing Then
    If (Opt AND 4) OR 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 (Opt AND 1)=0 Then
    T="Process " & Count & " track" & Plural(Count,"s","") & "?" & nl & nl
    T=T & "Please choose from the options below:" & nl & nl
    IF (Opt And 24) Then
      T=T & "Yes : Add new art, refresh existing images & embed downloaded art" & nl
    Else
      T=T & "Yes : Add new art & refresh existing images" & nl
    End If
    T=T & "No : Only add art to folders with none at present" & nl
    T=T & "Cancel : Abort script"
    IF (Opt AND 16) Then
      T=T & nl & nl & "N.B. Don't click Yes if you may have tracks from more than one" & nl
      T=T & "album in the same folder."
    End If
    R=MsgBox(T,vbYesNoCancel+vbQuestion,Title)
    If R=vbCancel Then WScript.Quit
    If R=vbYes Then
      Opt=(Opt OR 8)
    Else
      Opt=(Opt OR 8)-8
    End If
  End If
  
End Sub


' Return relevant string depending on whether value is plural or singular
Function Plural(V,P,S)
  If V=1 Then Plural=S ELSE Plural=P
End Function


' Loop through track selection processing suitable items
' 2015-05-31
Sub ProcessTracks
  Dim Art,F,I,Img,Path,R,T
  N=Now
  For I=Count To 1 Step -1	' Work backwords in case edit removes item from selection
    Set T=Tracks.Item(I)
    If T.Kind=1 Then		' Only process "File" tracks
      P=P+1
      With T
        Path=FSO.GetParentFolderName(.Location) & "\Folder.jpg"
        Set Art=.Artwork
        If Art.Count>0 Then	' Found some art, try to save
          Set Img=Art.Item(1)
          If FSO.FileExists(Path) Then
            If (Opt AND 4) Then
              If FSO.GetFile(Path).DateLastModified<N Then

              On Error Resume Next
                Img.SaveArtworkToFile(Path)
                If Err.Number<>0 Then
                  R=MsgBox("Error: &" & Hex(Err.Number) & " " & Err.Description & nl & "while saving image to:" & nl & Path,vbExclamation+vbOKCancel,Title)
                  If R=vbCancel Then wscript.quit
                  Err.Clear
                Else
                  FSO.GetFile(Path).Attributes=38		'Archive,Hidden,System
                  U=U+1
                End If
                On Error Goto 0

                End If
            End If
          Else
	    ' Test for missing tracks before save?
            If .Location<>"" Then

              On Error Resume Next
              Img.SaveArtworkToFile(Path)
              If Err.Number<>0 Then
                R=MsgBox("Error: &" & Hex(Err.Number) & " " & Err.Description & nl & "while saving image to:" & nl & Path,vbExclamation+vbOKCancel,Title)
                If R=vbCancel Then wscript.quit
                Err.Clear
              Else
                FSO.GetFile(Path).Attributes=38
                S=S+1
              End If
              On Error Goto 0

              End If
          End If
        End If
      End With
    End If
  Next
  If (Opt AND 24) Then
    For I=Count To 1 Step -1	' 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
          Path=FSO.GetParentFolderName(T.Location) & "\Folder.jpg"
          If FSO.FileExists(Path) Then
            If FSO.GetFile(Path).DateLastModified>=N Or T.Artwork.Count=0 Then
              If T.Artwork.Count=1 Then
                ' Begin error handler  
                On Error Resume Next
                If T.Artwork.Item(1).IsDownloadedArtwork Then T.Artwork.Item(1).Delete
                If Err.Number<>0 Then 'Ignore error
                  'R=MsgBox("Error: &" & Hex(Err.Number) & " " & Err.Description & nl & "while deleting image from:" & nl & T.Location,vbExclamation+vbOKCancel,Title)
                  'If R=vbCancel Then wscript.quit
                  Err.Clear
                End If
                On Error Goto 0
                ' End error handler             
              End If
              If T.Artwork.Count=0 Then
                ' Begin error handler  
                On Error Resume Next
                T.AddArtworkFromFile(Path)
                If Err.Number<>0 Then 'Ignore error
                  R=MsgBox("Error: &" & Hex(Err.Number) & " " & Err.Description & nl & "while deleting image from:" & nl & T.Location,vbExclamation+vbOKCancel,Title)
                  If R=vbCancel Then wscript.quit
                  Err.Clear
                Else
                  A=A+1
                End If
                On Error Goto 0
                ' End error handler             
              End If
            End If
          End If
        End If
      End If
    Next
  End If
End Sub


' Output report
Sub Report
  If (Opt AND 2) Then Exit Sub
  Dim T
  T=P & " track" & Plural(P,"s","")
  If P<Count Then T=T & " of " & count
  T=T & Plural(P," were"," was") & " processed"
  T=T & nl & S & " new folder image" & Plural(S,"s were"," was") & " generated"
  If U>0 Then T=T & nl & U & " existing folder image" & Plural(U,"s were"," was") & " updated"
  IF A>0 Then T=T & nl & A & " track" & Plural(A,"s","") & " had artwork embedded"
  T=T & "." & nl & nl
  T=T & "Running time " & DateDiff("S",N,Now) & " seconds."   
  MsgBox T,vbInformation,Title
End Sub

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