' ===============
' TagFromFilename 
' ===============

' Version 1.0.0.7 - June 10th 2010
' Copyright © Steve MacGuire 2010
' Please visit http://samsoft.org.uk/iTunes/scripts.asp for more info.


' =======
' 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 VBScript to populate iTunes track information from the filename & path.
' Particularly useful when working with .wav files which don't have tags.

' Sets Album Artist, Artist (as Album Artist or optionally extracted from filename),
' Album, Disc No., Track No., Track Name, Compilation status and artwork.

' Assumes filename in the format:
' <Main Path>\<Album Artist>\<Album>\[D<-|.>][##[< |-|.>]]<Name>[ - <Artist>].<Ext>
' Split at:  ^              ^       ^                           [ ^ ]        ^

' Also inteprets "Album Artist, The" as "The Album Artist", etc.
' If appropriate will try to embed any artwork found in the file's folder.


' =========
' ChangeLog
' =========
' Version 1.0.0.1 - Inital version
' Version 1.0.0.2 - Allow for missing track number in filename
' Version 1.0.0.3 - Allow for trailing artist in filename
' Version 1.0.0.4 - GNU GPLv3.0 Release
' Version 1.0.0.5 - Add summary reporting, debug option, support for disc no.
' Version 1.0.0.6 - Minor updates
' Version 1.0.0.7 - Add support for trailing ", The", demo mode now highlights changes
' 		    add artwork from Folder.jpg if no existing art in the tag
'		    

' ==========
' To-do List
' ==========
' Think of more things to improve...


' =============================
' 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 FSO			' Handle to FileSystemObject
Dim iTunes		' Handle to iTunes 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,U			' Counters
Dim Dbg			' Manage debugging output
Dim Opt			' Script options


' =======================
' 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 update tracks					(1)
' Bit 1 = Suppress summary report								(2)
' Bit 2 = Set, treat filename as ## <Artist> - <Name>, clear, treat as ## <Name> - <Artist>	(4)
' Bit 3 = Only update Album/Album Artist if empty 						(8)
Opt=0


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

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

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


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

' Case-insensitive string comparison
Function Alike(A,B)
  Alike=(LCase(A)=LCase(B))
End Function


' Initialise track selections, quit script if track selection is out of bounds or user aborts
Sub Init
  Dim R,T
  ' Initialise global variables
  P=0
  U=0
  nl=vbCr & vbLf
  Title="Tag From Filename"
  dbg=False						' True => Display proposed updates
  ' Initialise global objects
  Set FSO=CreateObject("Scripting.FileSystemObject")
  Set iTunes=CreateObject("iTunes.Application")
  Set Tracks=iTunes.SelectedTracks
  If Tracks is Nothing Then
    Set Tracks=iTunes.BrowserWindow.SelectedPlaylist.Tracks
  End If
  If Tracks is Nothing or iTunes.BrowserWindow.SelectedPlaylist.Source.Name<>"Library" Then
    Count=0
  Else 
    Count=Tracks.Count
  End If
  ' 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
    Else 
      MsgBox "Please select between " & Min & " and " & Max & " tracks in iTunes before calling this script!",0,title
    End If
    WScript.Quit
  End If
  ' Check if the user wants to proceed and how
  If (Opt AND 1)=0 Then
    T="Update information for " & Count & " track" & Plural(Count,"s","") & "?" & nl & nl & _
      "Yes : Update track" & Plural(Count,"s","") & nl & "No : Preview derived information" & nl & _
      "Cancel : Abort script"
    R=MsgBox(T,vbYesNoCancel,title)
    If R=vbNo Then
      dbg=True
    ElseIf R=vbCancel Then
      Wscript.Quit
    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


' Output report
Sub Report
  If (Opt AND 2) Then Exit Sub
  Dim T
  T=P & " track" & Plural(P,"s were"," was")
  If Dbg Then
    T=T & " previewed of which " & U & " would be"
  Else
    T=T & " processed of which " & U & Plural(U," were"," was")
  End If
  T=T & " updated."
  MsgBox T,0,Title
End Sub


' Attempt to update tag data from filename and folder paths
Sub TagFromFilename
  Dim A,F,I,J,R,S1,S2,S3,S4,S5,T,Art,Ext,Folder,Path,Track
  Dim Album,AlbumArtist,Artist,Compilation,DiscNumber,Name,TrackNumber
  For I=1 To Tracks.Count
    P=P+1						' Update count of processed files
    Set Track=Tracks.Item(I)
    If Track.Kind=1 Then
      Path=Track.Location
      S4=InStrRev(Path,".")
      Ext=LCase(Mid(Path,S4))
      If Instr(".ipa.ipg.ite.itlp",Ext)=0 Then
	S3=InStrRev(Path,"\")
	S2=InStrRev(Path,"\",S3-1)
	S1=InStrRev(Path,"\",S2-1)
	Folder=Left(Path,S3) & "Folder.jpg"
	AlbumArtist=TheString(Mid(Path,S1+1,S2-S1-1))
	Album=TheString(Mid(Path,S2+1,S3-S2-1))
	Name=Mid(Path,S3+1,S4-S3-1)
        ' Assume disc no, if present, has a single digit followed by - or .
        A=Asc(Name)-48
        IF A>0 AND A<10 And (Mid(Name,2,1)="-" OR Mid(Name,2,1)=".") Then
          DiscNumber=Val(Name)
          Name=TrimNum(Name)
        Else
          DiscNumber=0
        End If
        TrackNumber=Val(Name)
        Name=TrimNum(Name)
        S5=Instr(Name," - ")
        If S5>0 And Ext<>".pdf" Then
          If (Opt And 4) Then
            Artist=Left(Name,S5-1)
            Name=TheString(Mid(Name,S5+3))
          Else
            Artist=TheString(Mid(Name,S5+3))
            Name=Left(Name,S5-1)
          End If
        Else
          Artist=AlbumArtist
        End If
        Compilation=(Alike(AlbumArtist,"Various Artists")OR(AlbumArtist<>Artist))
        With Track
          ' Try not to change values that have been explicitly set already
          If (Opt And 8) Then
	    If .Album<>"" Then Album=.Album
	    If .AlbumArtist<>"" Then AlbumArtist=.AlbumArtist
            If .Compilation=True Then Compilation=True
          End If
          If .DiscNumber>0 And DiscNumber=0 Then DiscNumber=.DiscNumber
          If .TrackNumber>0 And TrackNumber=0 Then TrackNumber=.TrackNumber
          ' Look to see if anything will actually be changed
          F=False
  	  J=False
          If .Artwork.Count=0 And FSO.FileExists(Folder) And Instr(".pdf.wav",Ext)=0 Then
            F=True
  	    J=True
          End If
          If .Compilation<>Compilation Then F=True
          If .AlbumArtist<>AlbumArtist Then F=True
          If .Artist<>Artist Then F=True
          If .Album<>Album Then F=True
          If .DiscNumber<>DiscNumber Then F=True
          If .TrackNumber<>TrackNumber Then F=True	
          If .Name<>Name Then F=True
          If F Then U=U+1				' Update count of updated files
          If Dbg Then
            T="The file at path:" & nl & nl & Path & nl & nl
            T=T & "has the following derived properties:" & nl & nl
            T=T & "Compilation : " & ValueAdded(Compilation,.Compilation) & nl
            T=T & "Album Artist : " & ValueAdded(AlbumArtist,.AlbumArtist) & nl
            T=T & "Artist : " & ValueAdded(Artist,.Artist) & nl
            T=T & "Album : " & ValueAdded(Album,.Album) & nl
            T=T & "Disc : " & ValueAdded(DiscNumber,.DiscNumber) & nl
            T=T & "Track : " & ValueAdded(TrackNumber,.TrackNumber) & nl
            T=T & "Name : " & ValueAdded(Name,.Name)
            If F Then
              T=T & nl & nl & "This file would be updated"
              If J Then
	        T=T & " and have artwork inserted."
              Else
                T=T & "."
              End If
            Else
              T=T & nl & nl & "This file would not be updated."
            End If
            R=MsgBox(T,vbOKCancel,Title)
  	    If R=vbCancel Then Exit Sub
          ElseIf F Then  			' Only update values that need changing
            If .Compilation<>Compilation Then .Compilation=Compilation
            If .AlbumArtist<>AlbumArtist Then .AlbumArtist=AlbumArtist
            If .Artist<>Artist Then .Artist=Artist
            If .Album<>Album Then .Album=Album
            If .DiscNumber<>DiscNumber Then .DiscNumber=DiscNumber
            If .TrackNumber<>TrackNumber Then .TrackNumber=TrackNumber	
            If .Name<>Name Then .Name=Name
            If J Then
              Track.AddArtworkFromFile(Folder)
            End If
          End If
        End With
      End If
    End If
  Next
End Sub


' Reconstructs a string where a leading "The " has been moved to become a trailing ", The"
Function TheString(T)
  If Alike(Right(T,5),", The") Then
    TheString="The " & Left(T,Len(T)-5)
  Else
    TheString=T
  End If
End Function


' Returns string without leading track number, whitespace, stop or dash.
' Should work with most naming conventions, e.g. iTunes, Amazon
Function TrimNum(T)
  Dim A,I
  I=1
  Do
    A=Asc(Mid(T,I))-48
    IF A<0 Or A>9 Then Exit Do
    I=I+1
  Loop
  If Mid(T,I,1)=" " Then I=I+1
  If Mid(T,I,1)="." Then I=I+1
  If Mid(T,I,1)="-" Then I=I+1
  If Mid(T,I,1)=" " Then I=I+1
  TrimNum=Mid(T,I)
End Function


' Reads track number from string.
Function Val(T)
  Dim A,I
  I=1
  Val=0
  Do
    A=Asc(Mid(T,I))-48
    IF A<0 Or A>9 Then Exit Do
    Val=Val*10+A
    I=I+1
  Loop
End Function


' Return value A with trailing " *" if different from B.
Function ValueAdded(A,B)
  If A=B Then
    ValueAdded=A
  Else
    ValueAdded=A & " *"
  End If
End Function