' ===============
' KeywordsToAlbum
' ===============
' Version 1.0.0.8 - June 17th 2016
' Copyright © Steve MacGuire 2010-2016
' http://samsoft.org.uk/iTunes/KeywordsToAlbum.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
' ===========
' A script for iTunes for Windows to add or remove keywords from the Album field

' If required can easily be modified to update a different field by adjusting the working field
' See comments in the ProcessTracks subroutine 

' Field keywords:   <Albums>, <AlbumArtist>, <Artist>, <Comment>, <Composer>, <Description>, <Disc>, <Genre>, <Grouping>, <Location>, <Lyrics>, <Name>, 
'                   <Show>, <SortAlbum>, <SortAlbumArtist>, <SortArtist>, <SortComposer>, <SortName>, <SortShow>, <Track>, <Year>. \n = newline

' Related scripts:  KeywordsToAlbum.vbs, KeywordsToAlbumArtist.vbs, KeywordsToArtist.vbs, KeywordsToComments.vbs, KeywordsToComposer.vbs, 
'                   KeywordsToDescription, KeywordsToGrouping.vbs, KeywordsToLyrics.vbs, KeywordsToName.vbs, KeywordsToShow, KeywordsToSortAlbum

' =========
' ChangeLog
' =========
' Version 1.0.0.1 - Initial version, prompted by this thread: http://discussions.apple.com/message.jspa?messageID=12039739#12039739
' Version 1.0.0.2 - Tweak to support insertion of the file location into Grouping using <Location> as the keyword to be inserted
' Version 1.0.0.3 - Reverse processing loop to prevent out-of-bounds error if selection alters during processing
' Version 1.0.0.4 - Implement multiple keyword input and optional sorting of keywords, will now work with multi-character separator
' Version 1.0.0.5 - Added field replacement keywords <Comment> & <Grouping>
' Version 1.0.0.6 - Changed method for inserting fields so a pattern like "Year: <Year>" can become "Year: 2010"
'                 - If not sorting can choose if new words are appended or prepended to existing value of the target field
' Version 1.0.0.7 - Added new keywords and more related scripts
' Version 1.0.0.8 - Added new keywords and more related scripts

' ==========
' To-do List
' ==========
' Add more 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 P,S,U		    ' Counters
Dim Q			      ' Global flag
Dim Dbg  			  ' Manage debugging output
Dim Opt		  	  ' Script options
Dim Append	  	' Option to add keywords at end, if not sorting
Dim Sorting		  ' Option for keyword sorting
Dim Sep	  		  ' Keyword delimiter
Dim Keyword	  	' Keyword to add or remove


' =======================
' 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 = Process entire library, otherwise try to restict to current playlist	(4)

Opt=0

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

Dbg=0

' Keyword separator, e.g. / , ; <space> etc. should be a single character that you won't want to use inside keywords/phrases
' If target field supports multiple lines use Sep=" " & vbCrLf to have keywords listed on separate lines
' N.b. the space separates the words if iTunes displays the field on a single line in the browser e.g. with comments

Sep=" "

' Option to have keywords sorted alphabetically, or added after or before existing content

Sorting=False		' Probably not a good idea to sort the lyrics field in case it actually contains lyrics
Append=True		  ' True to add keywords after existing content instead of before, unless sorting keywords are added in the order given


' ============
' 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
' Modified 2012-11-04
Sub Init
  Dim R,T
  ' Initialise global variables
  P=0
  S=0
  U=0
  Q=False
  nl=vbCrLf
  Title="Keywords To Album"
  ' Initialise global objects
  ' Set CD=CreateObject("UserAccounts.CommonDialog")
  ' 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 get keywords
  T="Enter keyword to add to the Album field for " & Count & " track" & Plural(Count,"s","")
  T=T & ", separate keywords with "
  If Sep=" " & nl Then
    T=T & "\n"
  ElseIf Sep=" " Then
    T=T & "a space"
  Else
    T=T & Sep
  End If
  T=T & " and/or prefix with - to remove a keyword."
  R=InputBox(T,Title)
  If R="" Then
    WScript.Quit
  Else
    R=Replace(R,"\n"," " & nl)	' Replace \n with space & newline
    R=Replace(R,"\N"," " & nl)	' Replace \N with space & newline
    Keyword=Replace(R,"  "," ")	' Remove any double spaces
  End If
End Sub


' Add or remove keywords from string
' Modified 2016-06-17
Function Keywords(ByVal V,ByVal K,ByVal T)
  Dim R,S
  If Append Then
    S=InstrRev(K,Sep)		
  Else
    S=Instr(K,Sep)
  End If
  If S>0 Then	          ' If more than one keyword, split & recurse
    If Append Then
      V=Keywords(V,Left(K,S-1),T)
      K=Mid(K,S+Len(Sep))
    Else
      V=Keywords(V,Mid(K,S+Len(Sep)),T)
      K=Left(K,S-1)
    End If
  End If
  'MsgBox "Input: " & K & " into " & V
  If Left(K,1)="-" Then
    R=True
    K=Mid(K,2)
  Else
    R=False
  End If
  
  ' Replace field names with their values, extend list as required
  IF Instr(K,"<") Then
    With Tracks.Item(T)
      K=Replace(K,"<Album>",.Album)
      K=Replace(K,"<AlbumArtist>",.AlbumArtist)
      K=Replace(K,"<Artist>",.Artist)
      K=Replace(K,"<Comment>",.Comment)
      K=Replace(K,"<Composer>",.Composer)
      K=Replace(K,"<Description>",.Description)
      K=Replace(K,"<Disc>",Pad(.DiscNumber,.DiscCount))
      K=Replace(K,"<Genre>",.Genre)
      K=Replace(K,"<Grouping>",.Grouping)
      K=Replace(K,"<Location>",.Location)
      K=Replace(K,"<Lyrics>",.Lyrics)
      K=Replace(K,"<Name>",.Name)
      K=Replace(K,"<Show>",.Name)
      K=Replace(K,"<SortAlbum>",.SortAlbum)
      K=Replace(K,"<SortAlbumArtist>",.SortAlbumArtist)
      K=Replace(K,"<SortArtist>",.SortArtist)
      K=Replace(K,"<SortComposer>",.SortComposer)
      K=Replace(K,"<SortName>",.SortName)
      K=Replace(K,"<SortShow>",.SortShow)
      K=Replace(K,"<Track>",Pad(.TrackNumber,.TrackCount))
      K=Replace(K,"<Year>",.Year)
    End With
  End If
  
  If R Then			        ' If keyword begins "-" then remove it if found
    V=Replace(V,Sep & K & Sep,Sep)
    If V=Sep Then V=V & Sep
  Else				          ' Otherwise add the keyword if not already present
    IF V=Sep & Sep Then
      V=Sep & K & Sep
    ElseIf Instr(V,Sep & K & Sep)=0 Then
      If Append Then
        V=V & K & Sep		' Add keywords to end of list
      Else
        V=Sep & K & V		' Add keywords to front of list
      End If
    End If
  End If
  'MsgBox "Output: " & V
  Keywords=V
End Function


' Pad out number V to width of number W
' Modified 2014-12-31
Function Pad(V,W)
  Pad=V
  If Len(W & "")>Len(V & "") Then Pad=String(Len(W & "")-Len(V & ""),"0") & V
End Function


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


' Loop through track selection processing suitable items
' Modified 2012-11-04
Sub ProcessTracks
  Dim I,T,V
  For I=Count to 1 step -1			        ' Work backwards to avoid index errors
    Set T=Tracks.Item(I)
    If T.Kind=1 Then				            ' Only process "File" tracks
      P=P+1
      V=Sep & T.Album & Sep  	          ' Change working field here,
      V=Keywords(V,Keyword,I)
      V=Mid(V,Len(Sep)+1,Len(V)-2*Len(Sep))
      If Sorting Then V=SortIt(V)
      If V<>T.Album Then	              ' here
        U=U+1
        T.Album=V  	      			        ' and here
      End If
      If Q Then Exit Sub
    End If
  Next
End Sub


' Output report
' Modified 2010-09-18
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 of which " & nl
  T=T & U & Plural(U," were"," was") & " updated"
  T=T & "."
  MsgBox T,vbInformation,Title
End Sub


' Sort list of keywords split by separator
' Modified 2010-09-18
Function SortIt(ByVal List)
  Dim I,Array,Sorted,Temp
  If InStr(List,Sep)=0 Then
    SortIt=List
  Else  
    Array=Split(List,Sep)
    Sorted=False
    Do Until Sorted
      Sorted=True
      For I=0 to UBound(Array)
        ' Compare this entry to the next entry
        If I<UBound(Array) Then
          If Array(I+1)<Array(I) Then
            Temp=Array(I+1)
            Array(I+1)=Array(I)
            Array(I)=Temp
            Sorted=False
          End If
        End If
      Next
    Loop
    SortIt=Array(0)
    For I=1 to UBound(Array)
      SortIt=SortIt & Sep & Array(I)
    Next
  End If  
End Function


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