' ============
' CleanDeadArt
' ============

' Version 1.0.0.9 - July 1st 2010
' Copyright © Steve MacGuire 2009-2010


' =======
' 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 clean orphaned artwork from media folders that no longer contain media,
' also backs up any orphaned artwork for manual review in case they might prove useful,
' then deletes any empty folders within the library structure.
' Where an artist has only one album the artwork can optionaly be promoted into the artist folder.
' Read-only files will be left in place.
' Add a dummy text file called "Ignore.txt" to prevent processing of a given folder and all it's subfolders.



' =========
' ChangeLog
' =========
' Version 1.0.0.1 - Initial GNU GPLv3.0 Release.
' Version 1.0.0.2 - Updated debug options, allow abort after info/debug message, provide activity summary.
' Version 1.0.0.3 - Add code to promote thumbnail if only one subfolder, remove if more than one subfolder.
' Version 1.0.0.4 - Add code to hide images, desktop,ini & thumbs.db files in library, unhide when archived.
'                   Don't archive read-only files. 
' Version 1.0.0.5 - Change criteria for images to hide, restrict to AlbumArt*.jpg & Folder.jpg.
'                   Allow run-time supression of further debug reports. Option to achive empty folder structure.
'                   Produce the partial summary report for an aborted run.
' Version 1.0.0.6 - Fix cosmetic problem with displayed path if archiving to root level folder.
' Version 1.0.0.7 - Add option to promote/remove promoted thumbnails where Artist has a single album.
'		    Ignore iTunes LP folders.
' Version 1.0.0.8 - Skip processing if folder contains a file called Ignore.txt.
' Version 1.0.0.9 - Ignore iTunes Extras folders


' ==========
' To-do List
' ==========
' Handle error if file moves would require an overwrite.
' This could happen if archived files are copied back to original location and then archived again.


' ============
' Declarations
' ============


' ==============================================================================================================


' N.B. Edit opt & dbg values to suit your needs.


' Control archive options, add bit values (x) for selective actions
' Bit 0 = Archive empty folders as opposed to just deleting				(1)
' Bit 1 = Promote artwork from single albums - clear to remove any promoted art		(2)

opt = 3


' Control debug output, add the bit values (x) for selective reporting
' Bit 0 = Detail folder deletions							(1)
' Bit 1 = Detail archive operations							(2)
' Bit 2 = Detail thumbnail promotion							(4)
' Bit 3 = Report folders without artwork						(8)
' Bit 4 = Report attribute corrections						       (16)

dbg = 31


' End of customisable values


' ==============================================================================================================

' Get FileSystemObject to allow script access to files
Set FSO = CreateObject("Scripting.FileSystemObject")

' Get Application Object to allow access to browse folder dialog
Set SAO = CreateObject("Shell.Application")

' Set constants required for browse folder dialog
Const MY_COMPUTER = &H11&
Const WINDOW_HANDLE = 0
Const OPTIONS = 0
Const TITLE = "CleanDeadArt"

' Newline string for text output
nl = vbCr & vbLf

' Initialise counters
ca = 0	' archived files
ce = 0	' empty folders
cf = 0	' archived folders
ch = 0  ' hidden files
cj = 0  ' media folders without Folder.jpg
cp = 0	' processed folders
cx = 0  ' extra promoted artwork


' Start of main program

' Intro
' Get source & target folders, abort if dialog is cancelled
strPath = GetFolder("Select the Media folder to scan for orphaned artwork:" & nl & _
  "E.g. My Documents\My Music\iTunes\iTunes Music")
If strPath="" Then wscript.quit
strBackup = GetFolder("Select/create the Archive folder for orphaned artwork:" & nl & _
  "E.g. My Documents\My Music\iTunes\Dead Art")
If strBackup="" Then wscript.quit


' Confirm action before proceeding
If MsgBox("About to clean dead artwork & empty folders from:" & nl & strPath & nl & nl & _
  "Backing up any art found to:" & nl & strBackup,33,TITLE)=vbOK Then

' Main process
  DoFolders FSO.GetFolder(strPath)
  
'Outro
  Report("complete.")

End If

' End of main program


' ===================
' Declare subroutines
' ===================

' Process folders recursively
Sub DoFolders(ByVal Folder)

' Do something with each folder on entry
  cp = cp+1

' Do something with each subfolder
  For Each Subfolder in Folder.SubFolders
    sp=Subfolder.Path
    ' Don't process target folder if nested within source to avoid infinite recursion, ignore iTunes LP/Extras folders or folders with Ignore.txt
    If sp<>strBackup AND LCase(Right(sp,5))<>".itlp" AND LCase(Right(sp,4))<>".ite" AND FSO.FileExists(sp & "\Ignore.txt")=False Then DoFolders Subfolder
  Next

' Do something with each folder on exit
  DoTidy(Folder)

End Sub


' Count files of various types to determine if folder can be cleaned,
' if appropriate backup art/desktop.ini files then delete the folder.
Sub DoTidy(ByVal Folder)
  a=0
  b=0
  c=0
  g=0
  j=0
  di=0
  td=0
  fj=0
  Set objFiles = Folder.Files
  s=Folder.Subfolders.Count

  For Each F in objFiles
    n=LCase(F.Name)
    c=c+1
    h = (F.attributes AND 3) = 0     ' Hide artwork/desktop.ini/thumbs.db if not hidden or read-only
    If Right(n,4)=".bmp" Then b=b+1 
    If Right(n,4)=".gif" Then g=g+1 
    If Right(n,4)=".jpg" Then j=j+1: If h AND (Left(n,8)="albumart") Then Hide(F)
    If n="desktop.ini" Then di=1:    If h Then Hide(F)
    If n="thumbs.db" Then td=1:      If h Then Hide(F)
    If n="folder.jpg" Then fj=1:     If h Then Hide(F)
  Next

  ' Create debug string if debugging is enabled
  If dbg > 0 Then
    t = Folder.Path & nl & "has " & c & " file"
    If c<>1 Then t = t & "s"
    t=t & ", " & s & " subfolder"
    If s<>1 Then t=t & "s"
    If b > 0 Then
      t = t & ", " & b & " bmp"
      If b<>1 Then t = t & "s"
    End If
    If g > 0 Then
      t = t & ", " & g & " gif"
      If g<>1 Then t = t & "s"
    End If
    If j > 0 Then
      t = t & ", " & j & " jpg"
      If j<>1 Then t = t & "s"
    End If
    If di > 0 then t = t & ", desktop.ini"
    If td > 0 Then t = t & ", thumbs.db"
    If s=0 AND c=0 Then t = t & " and can be deleted as it is empty!"
  End If

  ' Determine target folder for archive
  Target = strBackup & "\" & FSO.GetFolder(strPath).Name & Mid(Folder.path,Len(strPath)+1)


  If s=0 AND c=0 Then
    ' There are no files or subfolders so remove this folder
    If dbg AND 1 Then
      IF opt AND 1 Then
        t = t & nl & nl & "Continue reporting when archiving empty folders?"
      Else
        t = t & nl & nl & "Continue reporting when removing empty folders?"
      End If
      r = MsgBox(t,vbYesNoCancel,TITLE)
      if r=vbCancel Then
	Report("aborted.")
        wscript.quit
      ElseIf r=vbNo Then
        dbg=dbg-1
      End If
    End If
    If opt AND 1 Then MakePath Target
    RmDir Folder.Path
    ce = ce + 1

  ElseIF s=0 AND c = b+g+j+di+td Then
    ' All the files are images, information or thumbnails so this folder can be archived

    If dbg AND 2 Then 
      t = t & " and contains only dead art which can be backed up to"
      t = t & nl & Target
      t = t & nl & nl & "Continue reporting when archiving artwork?"
      r = MsgBox(t,vbYesNoCancel,TITLE)
      if r=vbCancel Then
	Report("aborted.")
        wscript.quit
      ElseIf r=vbNo Then
        dbg=dbg-2
      End If
    End If

    ' And archive each file in this folder unless read-only
    For Each F in objFiles
      IF (F.Attributes AND 1)=0 Then	      
        If a=0 Then
	  ' Create the target folder for the archive if required
	  MakePath Target
          a=1
	  cf=cf+1
	End If
	F.Attributes=0	' Unhide file before archiving	
        F.Move(Target & "\")
	ca=ca+1
      End If
    Next

    ' Delete the folder if now empty
    If Folder.Files.Count=0 Then
      RmDir Folder.Path
    End If

  ElseIf (s>1 OR ((opt AND 2)=0 AND s=1)) AND fj=1 AND c=td+1 Then
    ' This folder contains more than one album or all promoted art is to be removed - archive the Folder.jpg it contains unless read-only
    For Each F in objFiles
      If LCase(F.Name)="folder.jpg" AND (F.Attributes AND 1)=0 Then
        If dbg AND 1 Then 
          t = t & nl & "and contains redundant art which can be backed up to"
          t = t & nl & Target
          t = t & nl & nl & "Continue reporting when archiving artwork?"
          r = MsgBox(t,vbYesNoCancel,TITLE)
          if r=vbCancel Then
	    Report("aborted.")
            wscript.quit
          ElseIf r=vbNo Then
            dbg=dbg-1
          End If
        End If
        ' Create the target folder for the archive
        MakePath Target
        ' And archive folder.jpg from this folder
	F.Attributes=0
        F.Move(Target & "\")
        ca = ca+1
        cf = cf+1
      End If
    Next

  ElseIf s=1 AND fj=0 AND (opt AND 2)=2 Then
    ' This folder contains just one subfolder and promote art option is on - try to promote Folder.jpg from that subfolder
    For Each F in Folder.Subfolders ' I know there's only 1, but this is the easiest way to get to the object
	IF FSO.FileExists(F.Path & "\Folder.jpg") Then
          If dbg AND 4 Then 
            t = t & " and contains just one album subfolder." & nl & "Promoting folder artwork from that album."
            t = t & nl & nl & "Continue reporting when promoting artwork?"
            r = MsgBox(t,vbYesNoCancel,TITLE)
            if r=vbCancel Then
              Report("aborted.")
              wscript.quit
            ElseIf r=vbNo Then
              dbg=dbg-4
            End If
          End If
	  FSO.CopyFile (F.Path & "\Folder.jpg"), Folder.Path & "\" : cx=cx+1
        End If
    Next

  ElseIf s=0 AND fj=0 Then
    ' This folder has media, but no Folder.jpg file
    If dbg AND 8 Then 
      t = t & " and is missing folder artwork."
      t = t & nl & nl & "Continue reporting where missing?"
      r = MsgBox(t,vbYesNoCancel,TITLE)
      if r=vbCancel Then
	Report("aborted.")
        wscript.quit
      ElseIf r=vbNo Then
        dbg=dbg-8
      End If
    End If
    cj=cj+1
  End If

End Sub


' Open a Browse for folder dialog and return the selected folder path
Function GetFolder(P)
  Set objFolder = SAO.Namespace(MY_COMPUTER)
  Set objFolderItem = objFolder.Self
  strStart = objFolderItem.Path
  Set objFolder = SAO.BrowseForFolder (WINDOW_HANDLE, P, OPTIONS, strStart) 
  If objFolder Is Nothing Then
    GetFolder=""
  Else
    Set objFolderItem = objFolder.Self
    If Left(objFolderItem.Path,2) = "::" Then
      MsgBox "That item cannot be processed, please try again.",0,TITLE
    Else 
      GetFolder=objFolderItem.Path
      IF Right(GetFolder,1)="\" Then GetFolder=Left(GetFolder,Len(GetFolder)-1)
    End If
  End If
End Function


' Set hidden & system attributes for folder artwork
Sub Hide(F)
  Dim t
  If dbg AND 16 Then 
   t = F.path & " needs hidden attribute setting."
   t = t & nl & nl & "Continue reporting when not set?"
   r = MsgBox(t,vbYesNoCancel,TITLE)
    if r=vbCancel Then
      Report("aborted.")
      wscript.quit
    ElseIf r=vbNo Then
      dbg=dbg-16
    End If
  End If
  ch=ch+1
  F.Attributes = (F.Attributes OR 6)
End Sub


' Create a folder path if it doesn't already exist
Function MakePath(Path)
' Default result
  MakePath = False
' Fail if drive is not valid
  If Not FSO.DriveExists(FSO.GetDriveName(Path)) Then Exit Function
' Succeed if folder exists
  If FSO.FolderExists(Path) Then
    MakePath = True
    Exit Function
  End If
' Call self to ensure parent path exists
  If Not MakePath(FSO.GetParentFolderName(Path)) Then Exit function
' Create folder
  On Error Resume Next
  FSO.CreateFolder Path
  MakePath = FSO.FolderExists(Path)    
End Function


' 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


' Report summary of activity when task complete or process aborted
Sub Report(r)
  t="Cleaning dead artwork & empty folders " & r & nl & nl & _
    cp & " folder" & Plural(cp,"s were"," was") & " processed." & nl
    If ca>0 Then t=t & ca & " file" & Plural(ca,"s","") & _
    " in " & cf & " folder" & Plural(cf,"s","") & Plural(ca," were"," was") & " archived." & nl
    If cx>0 Then t=t & cx & " album" & Plural(cx,"s","") & " had artwork promoted to artist folder." & nl
    If ch>0 Then t=t & ch & " file" & Plural(ch,"s","") & " had attributes corrected." & nl
    If ce>0 Then
      t=t & ce & " empty folder" & Plural(ce,"s were"," was")
      If opt AND 1 Then
        t = t & " archived." & nl
      Else
        t = t & " deleted." & nl
      End If
    End If
    If cj>0 Then  t=t & cj & " folder" & Plural(cj,"s","") & " had no folder art." & nl
  MsgBox t,0,TITLE
End Sub


' Remove folder even if marked as Read only
Sub RmDir(F)
  FSO.DeleteFolder F, True
End Sub


' =============
' End of script
' =============