' ===================== ' KillTopLevelPlaylists ' ===================== ' Version 1.0.0.3 - March 26th 2018 ' Copyright © Steve MacGuire 2011-2018 ' http://samsoft.org.uk/iTunes/KillTopLevelPlaylists.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 ' =========== ' Seek out and destroy playlists that meet certain conditions ' Related scripts: KillEmptyPlaylists.vbs, KillIndexedPlaylists.vbs, KillTopLevelPlaylists.vbs ' ========= ' ChangeLog ' ========= ' Version 1.0.0.1 - Initial version ' Version 1.0.0.2 - Minor tweaks ' Version 1.0.0.3 - Recode to match selected criteria from empty, indexed, top-level, etc. ' Visit http://samsoft.org.uk/iTunes/scripts.asp for updates ' ========== ' To-do List ' ========== ' Add more things to do ' ============================= ' Declare constants & variables ' ============================= Option Explicit ' Declare all variables before use Dim Intro,Outro,Check ' Manage confirmation dialogs Dim iTunes ' Handle to iTunes application Dim P,S,U ' Counters Dim nl,tab ' New line/tab strings Dim Title,Summary ' Title & summary Dim MatchEmpty,MatchFolders,MatchIndex,MatchSmart,MatchTop ' ======================= ' Initialise user options ' ======================= Intro=True ' Set false to skip initial prompts, avoid if non-reversible actions Outro=True ' Produce summary report Check=True ' Step-by-step confirmation MatchEmpty=False ' Match with empty lists MatchFolders=False ' Match with empty playlist folders MatchIndex=False ' Match playlist with an index number MatchSmart=False ' Match with smart lists, false excludes MatchTop=True ' Match with top level lists Title="Kill" If MatchEmpty Then Title=Title & " Empty" If MatchIndex Then Title=Title & " Indexed" If MatchTop Then Title=Title & " Top Level" Title=Title & " Playlists" Summary="Remove" If MatchEmpty Then Summary=Summary & " empty" If MatchIndex Then Summary=Summary & " indexed" If MatchTop Then Summary=Summary & " top level" If MatchSmart=False Then Summary=Summary & " non-smart" Summary=Summary & " playlists" If MatchFolders Then Summary=Summary & " & playlist folders if empty" Summary=Summary & "." ' ============ ' Main program ' ============ Init ' Set things up ProcessLists ' Main process Report ' Summary ' =================== ' End of main program ' =================== ' =============================== ' Declare subroutines & functions ' =============================== ' Returns the path of the playlist as a string ' Modified 2013-03-21 Function GetListPath(Playlist) If (Playlist.Parent Is Nothing) Then GetListPath=Playlist.Name Else GetListPath=GetListPath(Playlist.Parent) & "\" & Playlist.Name End If End Function ' Returns true if a playlist folder has children ' Modified 2018-03-26 Function HasChildren(F) Dim I,ID,L,Lists,M HasChildren=False ID=PersistentID(F) Set Lists=iTunes.Sources.Item(1).Playlists For I=1 To Lists.Count Set L=Lists.Item(I) If L.Kind=2 Then ' Check user playlists Set M=L.Parent ' Get the parent If Not (M Is Nothing) Then If PersistentID(M)=ID Then HasChildren=True : Exit For End If Next End Function ' Returns true if a string ends in digits ' Modified 2018-03-26 Function HasIndex(S) Dim I,P S=Trim(S) P=InstrRev(S," ") If P=0 Then HasIndex=False Else HasIndex=True For I=P+1 To Len(S) If IsDigit(Mid(S,I,1))=False Then HasIndex=False : Exit For Next End If End Function ' Initialisation routine ' Modified 2011-10-24 Sub Init Dim Q,R ' Initialise global variables P=0 S=0 U=0 nl=vbCrLf tab=Chr(9) ' Initialise global objects If Intro Then Q=Summary & nl & nl & "Proceed?" If Check Then Q=Q & nl & nl Q=Q & "Yes" & tab & ": Process playlists automatically" & nl Q=Q & "No" & tab & ": Preview & confirm each action" & nl Q=Q & "Cancel" & tab & ": Abort script" R=MsgBox(Q,vbYesNoCancel+vbQuestion,Title) Else R=MsgBox(Q,vbOKCancel+vbQuestion,Title) End If If R=vbCancel Then WScript.Quit If R=vbYes or R=vbOK Then Check=False Else Check=True End If End If Set iTunes=CreateObject("iTunes.Application") End Sub ' Return true if character is a digit ' Modified 2017-11-11 Function IsDigit(C) If C="" Then isDigit = False Else IsDigit=(Asc(C)>47) And (Asc(C)<58) End Function ' Create a string representing the 64 bit persistent ID of an iTunes object ' Modified 2012-08-24 Function PersistentID(T) PersistentID=Right("0000000" & Hex(iTunes.ITObjectPersistentIDHigh(T)),8) & "-" & Right("0000000" & Hex(iTunes.ITObjectPersistentIDLow(T)),8) End Function ' Return relevant string depending on whether value is plural or singular ' Modified 2011-09-28 Function Plural(V,P,S) If V=1 Then Plural=S Else Plural=P End Function ' Loop through playlists ' Modified 2018-03-26 Sub ProcessLists Dim C,I,K,L,Lists,M,R,Q Set Lists=iTunes.Sources.Item(1).Playlists For I=Lists.Count To 1 Step -1 ' Work backwards to avoid issues after deleting an item Set L=Lists.Item(I) ' Get a list If L.Kind=2 Then ' Process user playlists only If L.SpecialKind=0 Or (MatchFolders And L.SpecialKind=4) Then K=True ' Assume this list might need removing If L.Name="Voice Memos" Or Left(L.Name,9)="Purchased" Then K=False Set M=L.Parent ' Get the parent C=L.Tracks.Count HasChildren(L) If L.SpecialKind=4 Then If HasChildren(L) Then K=False ' Don't kill non-empty folders, note folders considered as smart so skip test below Else If MatchEmpty And C>0 Then K=False ' Check and limit to empty playlists if needed If Not MatchSmart And L.Smart=True Then K=False ' Check and limit to non-smart playlists if needed End If If MatchIndex And Not HasIndex(L.Name) Then K=False ' Check and limit to indexed playlists if needed If MatchTop And Not (M Is Nothing) Then K=False ' Check and limit to top level playlists if needed If K Then Q="Remove list?" & nl & nl & "Name" & tab & L.Name & nl & "Count" & tab & C & nl & "Path" & tab & GetListPath(L) & nl & "Special" & tab & L.SpecialKind & nl & "Smart" & tab & L.Smart If Check Then R=MsgBox(Q,vbYesNoCancel,Title) Else R=vbYes If R=vbCancel Then WScript.Quit If R=vbYes Then L.Delete U=U+1 Else S=S+1 End If End If End If End If P=P+1 Next End Sub ' Output report ' Modified 2011-10-24 Sub Report If Not Outro Then Exit Sub Dim T T=P & " playlist" & Plural(P,"s were"," was") & " processed," & nl T=T & U & Plural(U," were"," was") & " removed." MsgBox T,vbInformation,Title End Sub ' ============== ' End of listing ' ==============