' ====================
' SetLastPlayedByAlbum
' ====================
' Version 1.0.0.8 - Aug 25th 2016
' Copyright © Steve MacGuire 2011-2016
' http://samsoft.org.uk/iTunes/SetLastPlayedByAlbum.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
' ===========
' Set last played values for each album in selected tracks or current playlist to max, mean, median, mid, or min of current last played values, or manually.

' Written in response to this thread in Apple Support Communities
' https://discussions.apple.com/thread/7045215

' =========
' ChangeLog 
' =========
' Version 1.0.0.1 - Initial version
' Version 1.0.0.2 - Calculate mean & median
' Version 1.0.0.3 - Spread the updated times out as if tracks played in sequence
' Version 1.0.0.4 - Addition of a manual input mode
' Version 1.0.0.5 - Fixed error with compilations
' Version 1.0.0.6 - Improved behaviour with unplayed albums
' Version 1.0.0.7 - Improved offset times so repeat runs in the same mode should not change times
' Version 1.0.0.8 - Fixed error when setting times manually 


' ==========
' To-do List
' ==========
' Stop updated times drifting when in mean mode
' Add things to do

' =============================
' Declare constants & variables
' =============================
' Variables for common code
' Modified 2014-04-09
Option Explicit	        ' Declare all variables before use
Dim Intro,Outro,Check   ' Manage confirmation dialogs
Dim PB,Prog,Debug       ' Control the progress bar
Dim Clock,T1,T2,Timing  ' The secret of great comedy
Dim Named,Source        ' Control use on named playlist
Dim Playlist,List       ' Name for any generated playlist, and the object itself
Dim iTunes              ' Handle to iTunes application
Dim Tracks              ' A collection of track objects
Dim Count               ' The number of tracks
Dim D,M,P,S,U,V         ' Counters
Dim nl,tab              ' New line/tab strings
Dim IDs                 ' A dictionary object used to ensure each object is processed once
Dim Rev                 ' Control processing order, usually reversed
Dim Quit                ' Used to abort script
Dim Title,Summary       ' Text for dialog boxes
Dim Tracing             ' Display/suppress tracing messages

' Values for common code
' Modified 2016-04-09
Const Kimo=False        ' True if script expects "Keep iTunes Media folder organised" to be disabled
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
Const Warn=500          ' Warning level, require confirmation for processing above this level
Intro=True              ' Set false to skip initial prompts, avoid if non-reversible actions
Outro=True              ' Produce summary report
Check=True              ' Track-by-track confirmation, can be set during Intro
Prog=True               ' Display progress bar, may be disabled by UAC/LUA settings
Debug=True              ' Include any debug messages in progress bar
Timing=True             ' Display running time in summary report
Source="<Any>"          ' Named playlist to process, use "Library" for entire library - <Any> allows for a selection on a manually managed device to be used
Rev=True                ' Control processing order, usually reversed
Debug=True              ' Include any debug messages in progress bar
Tracing=True            ' Display tracing message boxes

' Additional variables for this particular script
' Modified 2016-08-23
Dim Lengths             ' A dictionary object for album lengths
Dim Mans                ' A dictionary object for album manual set points
Dim Means               ' A dictionary object for album mean points
Dim Meds                ' A dictionary object for album median points
Dim Mids                ' A dictionary object for album mid points
Dim Offsets             ' A dictionary object for track offsets from start of first track
Dim Played              ' A dictionary object for last played values
Dim Times               ' A dictionary object for track lengths
Dim Mode                ' Operating mode: {"Max", "Mean", "Median", "Mid", or "Min")
Dim TimeFactor          ' No. of hours to add/subtract to/from PlayedDate to correct for time zone
Dim FudgeFactor         ' Fix for rounding errors
Dim Overlap             ' Running total to prevent manually set unplayed albums overlapping
Overlap=0
TimeFactor=TZOffset
FudgeFactor=-1/(2*60*60*24)     ' 0.5 seconds  

' Initialise variables for this particular script
' Modified 2016-04-08 
Mode="Mean"              ' Set to "Man", "Max", "Mean", "Median", "Mid", or "Min"
Title="Set Last Played By Album"
Summary="Set Last Played for selected tracks/current playlist "
Select Case Mode
  Case "Man"
    Summary=Summary & "manually."
  Case "Max"
    Summary=Summary & "to maximum"
  Case "Mean"
    Summary=Summary & "to mean"
  Case "Median"
    Summary=Summary & "to median"
  Case "Mid"
    Summary=Summary & "to middle"
  Case "Min"
    Summary=Summary & "to minimum"
  Case Else
    MsgBox "Invalid value for Mode, script aborting.",0,Title
    WScript.Quit
End Select
If Mode<>"Man" Then Summary=Summary & vbCrLf & "of last played values by album."


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

GetTracks               ' Set things up
GetPlayed               ' Get last played values into ordered list by album
ProcessTracks           ' Main process 
Report                  ' Summary

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


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


' Note: The bulk of the code in this script is concerned with making sure that only suitable tracks are processed by
'       the following module and supporting numerous options for track selection, confirmation, progress and results.


' Change played date and time
' Modified 2015-05-20
Sub Action(T)
  Dim A,B,C,Key,NPD,Off,PD
  With T
    StartEvent
    A=.AlbumArtist & "" : If A="" And .Compilation=True Then A="Various Artists" Else If A="" Then A=.Artist & ""
    B=.Album & ""
    C=.DiscNumber : If C=0 Then C=1
    Key=LCase(A & "\" & B)
    Off=Key & "\" & Right("0" & .DiscNumber,2) & "\" & Right("00" & .Tracknumber,3)
    NPD=GetNPD(Key,Off)
    PD=.PlayedDate
    .PlayedDate=NPD
    If DateToString(.PlayedDate)<>DateToString(NPD) Then
      .PlayedDate=DateAdd("n",TimeFactor*60,NPD)
    End If
    If DateToString(.PlayedDate)<>DateToString(NPD) Then
      Trace T,"Error changing Played Date to " & nl & NPD & " from" & nl & PD & " value set was" & nl & .PlayedDate
    End If
    StopEvent
    U=U+1               ' Increment updated tracks
  End With
End Sub


' Returns date with time added in hh:mm:ss format
' Modified 2015-05-19
Function AddTime(D,T)
  ' Trace Null,"Adding " & T & " to " & DateToString(D)
  AddTime=DateAdd("h",Left(T,2),D)
  AddTime=DateAdd("n",Mid(T,4,2),AddTime)
  AddTime=DateAdd("s",Right(T,2),AddTime)
End Function


' Converts list of track times into list of cumulative offsets to the start of each track
' Modified 2016-08-23
Function Cumulative(L,Key)
  Dim I,List,Total
  Total=0
  List=Split(L,nl)
  For Each I In List
    If Cumulative<>"" Then Cumulative=Cumulative & nl
    If I<>List(0) Then Total=Total+TimeFromString(Right(I,8))
    Cumulative=Cumulative & Left(I,7) & TimeToString(Total)
    Offsets.Add Key & "\" & Left(I,6),TimeToString(Total)
    ' Trace Null,"Adding offset " & Key & "\" & Left(I,6) & "=" & TimeToString(Total)
  Next
  Lengths.Add Key,TimeToString(Total)
  ' Trace Null,L & nl & nl & Cumulative
End Function


' Returns date from a string in yyyy/mm/dd hh:mm:ss format
' Modified 2015-05-19
Function DateFromString(D)
  DateFromString=DateSerial(Left(D,4),Mid(D,6,2),Mid(D,9,2))+TimeValue(Right(D,8))  
End Function


' Returns date as a string in yyyy/mm/dd hh:mm:ss format
' Modified 2015-05-19
Function DateToString(D)
  DateToString=DatePart("yyyy",D) & "/" & Right("0" & DatePart("m",D),2) & "/" & Right("0" & DatePart("d",D),2) & _
     " " & Right("0" & DatePart("h",D),2) & ":" & Right("0" & DatePart("n",D),2) & ":" & Right("0" & DatePart("s",D),2)  
End Function


' Get new played date
' Modified 2016-08-24
Function GetNPD(Key,Off)
  Dim SafeMode
  SafeMode=Mode
  If Played(Key)="" Then SafeMode="Man"
  Select Case SafeMode
    Case "Man"
      GetNPD=AddTime(Mans(Key),Offsets(Off))
    Case "Max"
      GetNPD=AddTime(MaxList(Played(Key)),Offsets(Off))
      GetNPD=SubTime(GetNPD,Lengths(Key))
    Case "Mean"
      GetNPD=AddTime(MeanList(Played(Key)),Offsets(Off))
      GetNPD=SubTime(GetNPD,Means(Key))
    Case "Median"
      GetNPD=AddTime(MedianList(Played(Key)),Offsets(Off))
      GetNPD=SubTime(GetNPD,Meds(Key))
    Case "Mid"
      GetNPD=AddTime(MidList(Played(Key)),Offsets(Off))
      GetNPD=SubTime(GetNPD,Mids(Key))      
    Case "Min"
      GetNPD=AddTime(MinList(Played(Key)),Offsets(Off))
  End Select
End Function


' Get the current last played values for each album
' Modified 2016-08-23
Sub GetPlayed
  Dim A,B,Base,C,I,ID,IDs,Key,L,List,N,R,T,TopUp,Total,SafeMode
  Dim First,Last,Steps
  If IsEmpty(Rev) Then Rev=True
  If Rev Then
    First=Count : Last=1 : Steps=-1
  Else
    First=1 : Last=Count : Steps=1
  End If
  N=0
  Set IDs=CreateObject("Scripting.Dictionary")    ' Local version of IDs for this subroutine only
  Set Lengths=CreateObject("Scripting.Dictionary")
  Set Mans=CreateObject("Scripting.Dictionary")
  Set Means=CreateObject("Scripting.Dictionary")
  Set Meds=CreateObject("Scripting.Dictionary")
  Set Mids=CreateObject("Scripting.Dictionary")
  Set Offsets=CreateObject("Scripting.Dictionary")
  Set Played=CreateObject("Scripting.Dictionary")
  Set Times=CreateObject("Scripting.Dictionary")
  If Prog Then                  ' Create ProgessBar
    Set PB=New ProgBar
    PB.SetTitle Title
    PB.Show
  End If
  Clock=0 : StartTimer
  For I=First To Last Step Steps        ' Usually work backwards in case edit removes item from selection
    N=N+1                 
    If Prog Then
      PB.SetStatus Status(N)
      PB.Progress N-1,Count
    End If
    Set T=Tracks.Item(I)
    ID=PersistentID(T)
    If Prog Then PB.SetInfo Replace(Info(T),"Updating","Checking",1,1)
    If Not IDs.Exists(ID) Then  ' Ignore tracks already processed
      IDs.Add ID,0              ' Note ID to prevent reprocessing this track in this pass
      If T.Kind=1 Then          ' Only process "File" tracks
        With T
          A=.AlbumArtist & "" : If A="" And .Compilation=True Then A="Various Artists" Else A=.Artist & ""
          B=.Album & ""
          C=.PlayedDate
          'Ignore tracks with unknown artist or album
          If Not(A="" Or B="") Then
            Key=LCase(A & "\" & B)
            If C>0 Then         ' Ignore unplayed tracks
              If Not Played.Exists(Key) Then
                Played.Add Key,DateToString(C)
              Else
                Played(Key)=OrderedList(Played(Key),DateToString(C))
              End If
            End If
            If Not Times.Exists(Key) Then
              Times.Add Key,Right("0" & .DiscNumber,2) & "\" & Right("00" & .Tracknumber,3) & " " & Left("00:00:00",8-Len(.Time)) & .Time
              'Trace T,Times(Key)
            Else
              Times(Key)=OrderedList(Times(Key),Right("0" & .DiscNumber,2) & "\" & Right("00" & .Tracknumber,3) & " " & Left("00:00:00",8-Len(.Time)) & .Time)
              'Trace T,Times(Key)
            End If           
          End If
        End With
      End If
    End If
    If Quit Then Exit For       ' Abort loop on user request
  Next
  Base=Now
  For Each Key In Times
    List=Split(Times(Key),nl)
    TopUp=TimeFromString(Mid(List(LBound(List)),8))
    Times(Key)=Cumulative(Times(Key),Key)
    List=Split(Times(Key),nl)
    ' Get new time for first track
    L=Played(Key)
    SafeMode=Mode
    If L="" Then SafeMode="Man"     ' Catch albums that have never been played and set manually
    Select Case SafeMode
      Case "Man"
        First=Left(List(0),6)
        ' Trace Null,Key & nl & nl & Played(Key) & nl & nl & Times(Key) & nl & nl & GetNPD(Key,Key & "\" & First) & nl & nl & "Mid" & tab & Meds(Key) & nl & "Total" & tab & Lengths(Key)
        If L="" Then
          Overlap=AddTime(Overlap,Lengths(Key))
          C=DateToString(SubTime(Base,Overlap))
          Overlap=AddTime(Overlap,TopUp)
        Else
          C=DateToString(MinList(Played(Key)))
        End If
        Do 
          R=InputBox("Edit played date/time for album:" & nl & key & nl & nl & "Current values:" & nl & Played(Key) & nl,Title,C)
        Loop Until R="" Or ValidDate(R)
        If R="" Then Quit=True Else Mans.Add Key,DateFromString(R)
      Case "Max"
        Trace Null,"Max:" & nl & nl & L & nl & nl & DateToString(MaxList(L)) & nl & nl & "Set times from last track backwards"
      Case "Mean"
        Total=0
        For Each I In List
          Total=Total+TimeFromString(Right(I,8))
        Next
        Means.Add Key,TimeToString(Total/(UBound(List)+1))
        Trace Null,"Mean:" & nl & nl & L & nl & nl & DateToString(MeanList(L)) & nl & nl & "Set times around mean time, offset to first track -" & Means(Key)
      Case "Median"
        C=UBound(List)
        If C Mod 2 = 0 Then         ' Odd no. of elements, get the middle one
          Meds.Add Key,Right(List(C/2),8)
        Else                        ' Otherwise get mean average of middle two
          Meds.Add Key,TimeToString((TimeFromString(Right(List((C-1)/2),8))+TimeFromString(Right(List((C+1)/2),8))+FudgeFactor)/2)
        End If
        Trace Null,"Median:" & nl & nl & L & nl & nl & DateToString(MedianList(L)) & nl & nl & "Set times around median time, offset to first track -" & Meds(Key)
      Case "Mid"
        Mids.Add Key,TimeToString((TimeFromString(Lengths(Key))+FudgeFactor)/2)
        Trace Null,"Mid:" & nl & nl & L & nl & nl & DateToString(MidList(L)) & nl & nl & "Set times around mid-point, offset to first track -" & Mids(Key)
      Case "Min"
        Trace Null,"Min:" & nl & nl & L & nl & nl & DateToString(MinList(L)) & nl & nl & "Set times from first track forwards"
    End Select
    If Quit Then Exit For       ' Abort loop on user request
  Next
  StopTimer
  If Prog And Not Quit Then
    PB.Progress Count,Count
    WScript.Sleep 200
  End If
End Sub


' Custom info message for progress bar
' Modified 2015-05-19
Function Info(T)
  Dim A,B
  With T
    ' NB Adding an empty string prevents assignment errors where value is null
    A=.AlbumArtist & "" : If A="" Then A=.Artist & "" : If A="" Then A="Unknown Artist"
    B=.Album & "" : If B="" Then B="Unknown Album"
    Info="Checking: " & A & " - " & B & " - " & .Name
  End With
End Function


' Obtain maximum value from an ordered list
' Modified 2015-05-19
Function MaxList(L)
  Dim List
  List=Split(L,nl)
  MaxList=FormatDateTime(DateFromString(List(UBound(List))))
End Function


' Obtain mean value from an ordered list
' Modified 2015-05-19
Function MeanList(L)
  Dim I,List,Total
  Total=0
  List=Split(L,nl)
  For Each I In List
    Total=Total+DateFromString(I)
  Next
  MeanList=FormatDateTime(Total/(UBound(List)+1))
End Function


' Obtain median value from an ordered list
' Modified 2015-05-19
Function MedianList(L)
  Dim C,I,List
  List=Split(L,nl)
  C=UBound(List)
  If C Mod 2 = 0 Then   ' Odd no. of elements, get the middle one
    MedianList=FormatDateTime(DateFromString(List(C/2)))
  Else                  ' Otherwise get mean average of middle two
    MedianList=FormatDateTime((DateFromString(List((C-1)/2))+DateFromString(List((C+1)/2)))/2)
  End If
End Function


' Obtain middle value (average of min & max) from an ordered list
' Modified 2015-05-19
Function MidList(L)
  Dim List
  List=Split(L,nl)
  MidList=FormatDateTime((DateFromString(List(LBound(List)))+DateFromString(List(UBound(List))))/2)
End Function


' Obtain minimum value from an ordered list
' Modified 2015-05-19
Function MinList(L)
  Dim List
  List=Split(L,nl)
  MinList=FormatDateTime(DateFromString(List(LBound(List))))
End Function


' Adds values into an ordered list
' Modified 2015-05-18
Function OrderedList(L,V)
  Dim I,List
  If L="" Then OrderedList=V : Exit Function
  OrderedList=""
  List=Split(L,nl)
  For Each I In List
    If OrderedList<>"" Then OrderedList=OrderedList & nl
    If I<V Or V="" Then
      OrderedList=OrderedList & I
    Else
      OrderedList=OrderedList & V & nl & I
      V=""
    End If
  Next
  If V<>"" Then OrderedList=OrderedList & nl & V
End Function


' Custom prompt for track-by-track confirmation
' Modified 2015-05-19
Function Prompt(T)
  Dim A,AA,AL,AR,B,C,DC,DN,Key,NA,NPD,Off,PD,TC,TN
  With T
    A=.AlbumArtist & "" : If A="" And .Compilation=True Then A="Various Artists" Else If A="" Then A=.Artist & ""
    B=.Album & ""
    Key=LCase(A & "\" & B)
    Off=Key & "\" & Right("0" & .DiscNumber,2) & "\" & Right("00" & .Tracknumber,3)
    AL=.Album & ""
    AA=.AlbumArtist & ""
    AR=.Artist & ""
    NA=.Name & ""
    PD=.PlayedDate
    DC=.DiscCount
    DN=.DiscNumber
    TC=.TrackCount
    TN=.TrackNumber
    If Played.Exists(Key) Then NPD=GetNPD(Key,Off) Else NPD=PD
    Prompt="Update starred properties?"
    Prompt=Prompt & nl & nl & "Album" & tab & tab & AL ': If NAL<>.Album Then Prompt=Prompt & " *" & nl & "->" & tab & tab & NAL
    Prompt=Prompt & nl & nl & "Album Artist" & tab & AA ': If NAA<>.AlbumArtist Then Prompt=Prompt & " *" & nl & "->" & tab & tab & NAA
    Prompt=Prompt & nl & nl & "Artist" & tab & tab & AR ': If NAR<>.Artist Then Prompt=Prompt & " *" & nl & "->" & tab & tab & NAR
    Prompt=Prompt & nl & nl & "Name" & tab & tab & NA ': If NNA<>.Name Then Prompt=Prompt & " *" & nl & "->" & tab & tab & NNA
    Prompt=Prompt & nl & nl & "Track" & tab & tab & TN & " of " & TC ': If TC<>NTC Then Prompt=Prompt & " *" & nl & "->" & tab & tab & TN & " of " & NTC
    Prompt=Prompt & nl & nl & "Disc" & tab & tab & DN & " of " & DC ': If DC<>NDC Or DN=0 Then Prompt=Prompt & " *" & nl & "->" & tab & tab & C & " of " & NDC
    Prompt=Prompt & nl & nl & "Last Played" & tab & PD: If PD<>NPD Then Prompt=Prompt & " *" & nl & "->" & tab & tab & NPD
    ' If Played.Exists(Key) Then Trace T, "Played dates for this track's album:" & nl & Played(Key) & nl & nl & "Max" & tab & MaxList(Played(Key)) & nl & _
    '   "Mean" & tab & MeanList(Played(Key)) & nl & "Median" & tab & MedianList(Played(Key)) & nl & "Mid" & tab & MidList(Played(Key)) & nl & "Min" & tab & MinList(Played(Key))
  End With
End Function


' Reverse the elements in a list
' Modified 2015-05-19
Function RevList(L)
  Dim I,List
  RevList=""
  List=Split(L,nl)
  For Each I In List
    If RevList<>"" Then RevList=nl & RevList
    RevList=I & RevList
  Next
End Function


' Custom status message for progress bar
' Modified 2011-10-21
Function Status(N)
  Status="Processing " & N & " of " & Count
End Function


' Returns date with time subtracted in hh:mm:ss format
' Modified 2015-05-19
Function SubTime(D,T)
  SubTime=DateAdd("h",-Left(T,2),D)
  SubTime=DateAdd("n",-Mid(T,4,2),SubTime)
  SubTime=DateAdd("s",-Right(T,2),SubTime)
End Function


' Returns time from a string in hh:mm:ss format
' Modified 2015-05-19
Function TimeFromString(T)
  TimeFromString=TimeValue(T)  
End Function


' Returns time as a string in hh:mm:ss format
' Modified 2015-05-19
Function TimeToString(T)
  TimeToString=Right("0" & DatePart("h",T),2) & ":" & Right("0" & DatePart("n",T),2) & ":" & Right("0" & DatePart("s",T),2)  
End Function


' Custom trace messages for troubleshooting, T is the current track if needed, Null otherwise 
' Modified 2015-05-19
Sub Trace(T,M)
  If Tracing Then
    Dim R,Q
    If IsNull(T) Then
      Q=M & nl & nl
    Else
      Q=Info(T) & nl & nl & M & nl & nl
    End If    
    Q=Q & "Yes" & tab & ": Continue tracing" & nl
    Q=Q & "No" & tab & ": Skip further tracing" & nl
    Q=Q & "Cancel" & tab & ": Abort script"
    R=MsgBox(Q,vbYesNoCancel,Title)
    If R=vbCancel Then Quit=True : WScript.Quit
    If R=vbNo Then Tracing=False
  End If
End Sub


' Get active time zone offset from GMT
' Modified 2011-10-04
Function TZOffset
  Dim Shell
  Set Shell=CreateObject("WScript.Shell") 
  TZOffset=Shell.RegRead("HKEY_LOCAL_MACHINE\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias")/60
End Function  


' Test for tracks which can be usefully updated
' Modified 2016-04-09
Function Updateable(T)
  Dim A,B,C,ID,Key,Off,NPD
  ID=PersistentID(T)
  Updateable=False              ' Default position
  If IDs.Exists(ID) Then        ' Ignore tracks already processed
    D=D+1                       ' Increment duplicate tracks
  Else
    IDs.Add ID,0                ' Note ID to prevent reprocessing this track
    With T    
      A=.AlbumArtist & "" : If A="" And .Compilation=True Then A="Various Artists" Else If A="" Then A=.Artist & ""
      B=.Album & ""
      C=.PlayedDate
      Key=LCase(A & "\" & B)
      Off=Key & "\" & Right("0" & .DiscNumber,2) & "\" & Right("00" & .Tracknumber,3)
      'Ignore tracks with unknown artist or album
      If Not(A="" Or B="") Then
        If Played.Exists(Key) Then NPD=GetNPD(Key,Off) Else NPD=C
        If DateToString(NPD)<>DateToString(C) Then Updateable=True
      End If
    End With
  End If
End Function


' Check for valid date string in yyyy/mm/dd hh:mm:ss format
' Modified 2016-04-08
Function ValidDate(D)
  Dim C,I
  ValidDate=False
  If Len(D)<>19 Then Exit Function
  For I=1 To 19
    C=Mid(D,I,1)
    Select Case I
      Case 5,8
        If C<>"/" Then Exit Function
      Case 11
        If C<>" " Then Exit Function
      Case 14,17
        If C<>":" Then Exit Function
      Case Else
        If C<"0" Or C>"9" Then Exit Function
    End Select
  Next
  ValidDate=True
End Function


' ============================================
' Reusable Library Routines for iTunes Scripts
' ============================================
' Modified 2015-01-24


' Get extension from file path
' Modified 2015-01-24
Function Ext(P)
  Ext=LCase(Mid(P,InStrRev(P,".")))
End Function


' Format time interval from x.xxx seconds to hh:mm:ss
' Modified 2011-11-07
Function FormatTime(T)
  If T<0 Then T=T+86400         ' Watch for timer running over midnight
  If T<2 Then
    FormatTime=FormatNumber(T,3) & " seconds"
  ElseIf T<10 Then
    FormatTime=FormatNumber(T,2) & " seconds"
  ElseIf T<60 Then
    FormatTime=Int(T) & " seconds"
  Else
    Dim H,M,S
    S=T Mod 60
    M=(T\60) Mod 60             ' \ = Div operator for integer division
    'S=Right("0" & (T Mod 60),2)
    'M=Right("0" & ((T\60) Mod 60),2)  ' \ = Div operator for integer division
    H=T\3600
    If H>0 Then
      FormatTime=H & Plural(H," hours "," hour ") & M & Plural(M," mins"," min")
      'FormatTime=H & ":" & M & ":" & S
    Else
      FormatTime=M & Plural(M," mins "," min ") & S & Plural(S," secs"," sec")
      'FormatTime=M & " :" & S
      'If Left(FormatTime,1)="0" Then FormatTime=Mid(FormatTime,2)
    End If
  End If
End Function


' Initialise track selections, quit script if track selection is out of bounds or user aborts
' Modified 2014-05-05
Sub GetTracks
  Dim Q,R
  ' Initialise global variables
  nl=vbCrLf : tab=Chr(9) : Quit=False
  D=0 : M=0 : P=0 : S=0 : U=0 : V=0
  ' Initialise global objects
  Set IDs=CreateObject("Scripting.Dictionary")
  Set iTunes=CreateObject("iTunes.Application")
  Set Tracks=iTunes.SelectedTracks      ' Get current selection
  If iTunes.BrowserWindow.SelectedPlaylist.Source.Kind<>1 And Source="" Then Source="Library" : Named=True      ' Ensure section is from the library source
  'If iTunes.BrowserWindow.SelectedPlaylist.Name="Ringtones" And Source="" Then Source="Library" : Named=True    ' and not ringtones (which cannot be processed as tracks???)
  If iTunes.BrowserWindow.SelectedPlaylist.Name="Radio" And Source="" Then Source="Library" : Named=True        ' or radio stations (which cannot be processed as tracks)
  If iTunes.BrowserWindow.SelectedPlaylist.Name=Playlist And Source="" Then Source="Library" : Named=True       ' or a playlist that will be regenerated by this script
  If Named Or Tracks Is Nothing Then    ' or use a named playlist
    If Source<>"" Then Named=True
    If Source="Library" Then            ' Get library playlist...
      Set Tracks=iTunes.LibraryPlaylist.Tracks
    Else                                ' or named playlist
      On Error Resume Next              ' Attempt to fall back to current selection for non-existent source
      Set Tracks=iTunes.LibrarySource.Playlists.ItemByName(Source).Tracks
      On Error Goto 0
      If Tracks is Nothing Then         ' Fall back
        Named=False
        Source=iTunes.BrowserWindow.SelectedPlaylist.Name
        Set Tracks=iTunes.SelectedTracks
        If Tracks is Nothing Then
          Set Tracks=iTunes.BrowserWindow.SelectedPlaylist.Tracks
        End If
      End If
    End If
  End If  
  If Named And Tracks.Count=0 Then      ' Quit if no tracks in named source
    If Intro Then MsgBox "The playlist " & Source & " is empty, there is nothing to do.",vbExclamation,Title
    WScript.Quit
  End If
  If Tracks.Count=0 Then Set Tracks=iTunes.LibraryPlaylist.Tracks
  If Tracks.Count=0 Then                ' Can't select ringtones as tracks?
    MsgBox "This script cannot process " & iTunes.BrowserWindow.SelectedPlaylist.Name & ".",vbExclamation,Title
    WScript.Quit
  End If
  ' Check there is a suitable number of suitable tracks to work with
  Count=Tracks.Count
  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
  Q=Summary
  If Q<>"" Then Q=Q & nl & nl
  If Warn>0 And Count>Warn Then
    Intro=True
    Q=Q & "WARNING!" & nl & "Are you sure you want to process " & GroupDig(Count) & " tracks"
    If Named Then Q=Q & nl
  Else
    Q=Q & "Process " & GroupDig(Count) & " track" & Plural(Count,"s","")
  End If
  If Named Then Q=Q & " from the " & Source & " playlist"
  Q=Q & "?"
  If Intro Or (Prog And UAC) Then
    If Check Then
      Q=Q & nl & nl 
      Q=Q & "Yes" & tab & ": Process track" & Plural(Count,"s","") & " automatically" & nl
      Q=Q & "No" & tab & ": Preview & confirm each action" & nl
      Q=Q & "Cancel" & tab & ": Abort script"
    End If
    If Kimo Then Q=Q & nl & nl & "NB: Disable ''Keep iTunes Media folder organised'' preference before use."
    If Prog And UAC Then
      Q=Q & nl & nl & "NB: Use the EnableLUA script to allow the progress bar to function" & nl
      Q=Q & "or change the declaration ''Prog=True'' to ''Prog=False'' to hide this message. "
      Prog=False
    End If
    If Check Then
      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 
  If Check Then Prog=False      ' Suppress progress bar if prompting for user input
End Sub


' Group digits and separate with commas
' Modified 2014-04-29
Function GroupDig(N)
  GroupDig=FormatNumber(N,0,-1,0,-1)
End Function


' Return the persistent object representing the track from its ID as a string
' Modified 2012-09-05
Function ObjectFromID(ID)
  Set ObjectFromID=iTunes.LibraryPlaylist.Tracks.ItemByPersistentID(Eval("&H" & Left(ID,8)),Eval("&H" & Right(ID,8)))
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 the persistent object representing the track
' Keeps hold of an object that might vanish from a smart playlist as it is updated
' Modified 2015-01-24
Function PersistentObject(T)
  Dim E,L
  Set PersistentObject=T
  On Error Resume Next  ' Trap possible error
  If Instr(T.KindAsString,"audio stream") Then
    L=T.URL 
  ElseIf T.Kind=5 Then
    L="iCloud/Shared"
  Else
    L=T.Location
  End If
  If Err.Number<>0 Then
    Trace T,"Error reading location property from object."
  ElseIf L<>"" Then
    E=Ext(L)
    If Instr(".ipa.ipg.m4r",E)=0 Then   ' Method below fails for apps, games & ringtones
      Set PersistentObject=iTunes.LibraryPlaylist.Tracks.ItemByPersistentID(iTunes.ITObjectPersistentIDHigh(T),iTunes.ITObjectPersistentIDLow(T))
    End If  
  End If  
End Function


' Return relevant string depending on whether value is plural or singular
' Modified 2011-10-04
Function Plural(V,P,S)
  If V=1 Then Plural=S Else Plural=P
End Function


' Format a list of values for output
' Modified 2012-08-25
Function PrettyList(L,N)
  If L="" Then
    PrettyList=N & "."
  Else
    PrettyList=Replace(Left(L,Len(L)-1)," and" & nl,"," & nl) & " and" & nl & N & "."
  End If
End Function


' Loop through track selection processing suitable items
' Modified 2015-01-06
Sub ProcessTracks
  Dim C,I,N,Q,R,T
  Dim First,Last,Steps
  If IsEmpty(Rev) Then Rev=True
  If Rev Then
    First=Count : Last=1 : Steps=-1
  Else
    First=1 : Last=Count : Steps=1
  End If
  N=0
  If Prog Then                  ' Create ProgessBar
    Set PB=New ProgBar
    PB.SetTitle Title
    PB.Show
  End If
  Clock=0 : StartTimer
  For I=First To Last Step Steps        ' Usually work backwards in case edit removes item from selection
    N=N+1                 
    If Prog Then
      PB.SetStatus Status(N)
      PB.Progress N-1,Count
    End If
    Set T=Tracks.Item(I)
    If T.Kind=1 Then            ' Ignore tracks which can't change
      Set T=PersistentObject(T) ' Attach to object in library playlist
      If Prog Then PB.SetInfo Info(T)
      If Updateable(T) Then     ' Ignore tracks which won't change
        If Check Then           ' Track by track confirmation
          Q=Prompt(T)
          StopTimer             ' Don't time user inputs 
          R=MsgBox(Q,vbYesNoCancel+vbQuestion,Title & " - " & GroupDig(N) & " of " & GroupDig(Count))
          StartTimer
          Select Case R
          Case vbYes
            C=True
          Case vbNo
            C=False
            S=S+1               ' Increment skipped tracks
          Case Else
            Quit=True
            Exit For
          End Select          
        Else
          C=True
        End If
        If C Then               ' We have a valid track, now do something with it
          Action T
        End If
      End If
    End If 
    P=P+1                       ' Increment processed tracks
    ' WScript.Sleep 500         ' Slow down progress bar when testing
    If Quit Then Exit For       ' Abort loop on user request
  Next
  StopTimer
  If Prog And Not Quit Then
    PB.Progress Count,Count
    WScript.Sleep 250
  End If
  If Prog Then PB.Close
End Sub


' Output report
' Modified 2014-04-29
Sub Report
  If Not Outro Then Exit Sub
  Dim L,T
  L=""
  If Quit Then T="Script aborted!" & nl & nl Else T=""
  T=T & GroupDig(P) & " track" & Plural(P,"s","")
  If P<Count Then T=T & " of " & GroupDig(Count)
  T=T & Plural(P," were"," was") & " processed of which " & nl
  If D>0 Then L=PrettyList(L,GroupDig(D) & Plural(D," were duplicates"," was a duplicate") & " in the list")
  If V>0 Then L=PrettyList(L,GroupDig(V) & " did not need updating")
  If U>0 Or V=0 Then L=PrettyList(L,GroupDig(U) & Plural(U," were"," was") & " updated")
  If S>0 Then L=PrettyList(L,GroupDig(S) & Plural(S," were"," was") & " skipped")
  If M>0 Then L=PrettyList(L,GroupDig(M) & Plural(M," were"," was") & " missing")
  T=T & L
  If Timing Then 
    T=T & nl & nl
    If Check Then T=T & "Processing" Else T=T & "Running"
    T=T & " time: " & FormatTime(Clock)
  End If
  MsgBox T,vbInformation,Title
End Sub


' Return iTunes like sort name
' Modified 2011-01-27
Function SortName(N)
  Dim L
  N=LTrim(N)
  L=LCase(N)
  SortName=N
  If Left(L,2)="a " Then SortName=Mid(N,3)
  If Left(L,3)="an " Then SortName=Mid(N,4)
  If Left(L,3)="""a " Then SortName=Mid(N,4)
  If Left(L,4)="the " Then SortName=Mid(N,5)
  If Left(L,4)="""an " Then SortName=Mid(N,5)
  If Left(L,5)="""the " Then SortName=Mid(N,6)
End Function


' Start timing event
' Modified 2011-10-08
Sub StartEvent
  T2=Timer
End Sub


' Start timing session
' Modified 2011-10-08
Sub StartTimer
  T1=Timer
End Sub


' Stop timing event and display elapsed time in debug section of Progress Bar
' Modified 2011-11-07
Sub StopEvent
  If Prog Then
    T2=Timer-T2
    If T2<0 Then T2=T2+86400            ' Watch for timer running over midnight
    If Debug Then PB.SetDebug "<br>Last iTunes call took " & FormatTime(T2) 
  End If  
End Sub


' Stop timing session and add elapased time to running clock
' Modified 2011-10-08
Sub StopTimer
  Clock=Clock+Timer-T1
  If Clock<0 Then Clock=Clock+86400     ' Watch for timer running over midnight
End Sub


' Detect if User Access Control is enabled, UAC (or rather LUA) prevents use of progress bar
' Modified 2011-10-18
Function UAC
  Const HKEY_LOCAL_MACHINE=&H80000002
  Const KeyPath="Software\Microsoft\Windows\CurrentVersion\Policies\System"
  Const KeyName="EnableLUA"
  Dim Reg,Value
  Set Reg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv") 	  ' Use . for local computer, otherwise could be computer name or IP address
  Reg.GetDWORDValue HKEY_LOCAL_MACHINE,KeyPath,KeyName,Value	  ' Get current property
  If IsNull(Value) Then UAC=False Else UAC=(Value<>0)
End Function


' Wrap & tab long strings, break string S on first separator C found at or before character W adding T tabs to each new line
' Modified 2014-05-29
Function Wrap(S,W,C,T)
  Dim P,Q
  P=InstrRev(S," ",W)
  Q=InstrRev(S,"\",W)
  If Q>P Then P=Q
  If P Then
    Wrap=Left(S,P) & nl & String(T,tab) & Wrap(Mid(S,P+1),W,C,T)
  Else
    Wrap=S
  End If
End Function


' ==================
' Progress Bar Class
' ==================

' Progress/activity bar for vbScript implemented via IE automation
' Can optionally rebuild itself if closed or abort the calling script
' Modified 2014-05-04
Class ProgBar
  Public Cells,Height,Width,Respawn,Title,Version
  Private Active,Blank,Dbg,Filled(),FSO,IE,Info,NextOn,NextOff,Status,SHeight,SWidth,Temp

' User has closed progress bar, abort or respwan?
' Modified 2011-10-09
  Public Sub Cancel()
    If Respawn And Active Then
      Active=False
      If Respawn=1 Then
        Show                    ' Ignore user's attempt to close and respawn
      Else
        Dim R
        StopTimer               ' Don't time user inputs 
        R=MsgBox("Abort Script?",vbExclamation+vbYesNoCancel,Title)
        StartTimer
        If R=vbYes Then
          On Error Resume Next
          CleanUp
          Respawn=False
          Quit=True             ' Global flag allows main program to complete current task before exiting
        Else
          Show                  ' Recreate box if closed
        End If  
      End If        
    End If
  End Sub

' Delete temporary html file  
' Modified 2011-10-04
  Private Sub CleanUp()
    FSO.DeleteFile Temp         ' Delete temporary file
  End Sub
  
' Close progress bar and tidy up
' Modified 2011-10-04
  Public Sub Close()
    On Error Resume Next        ' Ignore errors caused by closed object
    If Active Then
      Active=False              ' Ignores second call as IE object is destroyed
      IE.Quit                   ' Remove the progess bar
      CleanUp
    End If    
 End Sub
 
' Initialize object properties
' Modified 2012-09-05
  Private Sub Class_Initialize()
    Dim I,Items,strComputer,WMI
    ' Get width & height of screen for centering ProgressBar
    strComputer="."
    Set WMI=GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set Items=WMI.ExecQuery("Select * from Win32_OperatingSystem",,48)
    'Get the OS version number (first two)
    For Each I in Items
      Version=Left(I.Version,3)
    Next
    Set Items=WMI.ExecQuery ("Select * From Win32_DisplayConfiguration")
    For Each I in Items
      SHeight=I.PelsHeight
      SWidth=I.PelsWidth
    Next
    If Debug Then
      Height=160                ' Height of containing div
    Else
      Height=120                ' Reduce height if no debug area
    End If
    Width=300                   ' Width of containing div
    Respawn=True                ' ProgressBar will attempt to resurect if closed
    Blank=String(50,160)        ' Blanks out "Internet Explorer" from title
    Cells=25                    ' No. of units in ProgressBar, resize window if using more cells
    ReDim Filled(Cells)         ' Array holds current state of each cell
    For I=0 To Cells-1
      Filled(I)=False
    Next
    NextOn=0                    ' Next cell to be filled if busy cycling
    NextOff=Cells-5             ' Next cell to be cleared if busy cycling
    Dbg="&nbsp;"                ' Initital value for debug text
    Info="&nbsp;"               ' Initital value for info text
    Status="&nbsp;"             ' Initital value for status text
    Title="Progress Bar"        ' Initital value for title text
    Set FSO=CreateObject("Scripting.FileSystemObject")          ' File System Object
    Temp=FSO.GetSpecialFolder(2) & "\ProgBar.htm"               ' Path to Temp file
  End Sub

' Tidy up if progress bar object is destroyed
' Modified 2011-10-04
  Private Sub Class_Terminate()
    Close
  End Sub
 
' Display the bar filled in proportion X of Y
' Modified 2011-10-18
  Public Sub Progress(X,Y)
    Dim F,I,L,S,Z
    If X<0 Or X>Y Or Y<=0 Then
      MsgBox "Invalid call to ProgessBar.Progress, variables out of range!",vbExclamation,Title
      Exit Sub
    End If
    Z=Int(X/Y*(Cells))
    If Z=NextOn Then Exit Sub
    If Z=NextOn+1 Then
      Step False
    Else
      If Z>NextOn Then
        F=0 : L=Cells-1 : S=1
      Else
        F=Cells-1 : L=0 : S=-1
      End If
      For I=F To L Step S
        If I>=Z Then
          SetCell I,False
        Else
          SetCell I,True
        End If
      Next
      NextOn=Z
    End If
  End Sub

' Clear progress bar ready for reuse  
' Modified 2011-10-16
  Public Sub Reset
    Dim C
    For C=Cells-1 To 0 Step -1
      IE.Document.All.Item("P",C).classname="empty"
      Filled(C)=False
    Next
    NextOn=0
    NextOff=Cells-5   
  End Sub
  
' Directly set or clear a cell
' Modified 2011-10-16
  Public Sub SetCell(C,F)
    On Error Resume Next        ' Ignore errors caused by closed object
    If F And Not Filled(C) Then
      Filled(C)=True
      IE.Document.All.Item("P",C).classname="filled"
    ElseIf Not F And Filled(C) Then
      Filled(C)=False
      IE.Document.All.Item("P",C).classname="empty"
    End If
  End Sub 
 
' Set text in the Dbg area
' Modified 2011-10-04
  Public Sub SetDebug(T)
    On Error Resume Next        ' Ignore errors caused by closed object
    Dbg=T
    IE.Document.GetElementById("Debug").InnerHTML=T
  End Sub

' Set text in the info area
' Modified 2011-10-04
  Public Sub SetInfo(T)
    On Error Resume Next        ' Ignore errors caused by closed object
    Info=T
    IE.Document.GetElementById("Info").InnerHTML=T
  End Sub

' Set text in the status area
' Modified 2011-10-04
  Public Sub SetStatus(T)
    On Error Resume Next        ' Ignore errors caused by closed object
    Status=T
    IE.Document.GetElementById("Status").InnerHTML=T
  End Sub

' Set title text
' Modified 2011-10-04
  Public Sub SetTitle(T)
    On Error Resume Next        ' Ignore errors caused by closed object
    Title=T
    IE.Document.Title=T & Blank
  End Sub
  
' Create and display the progress bar  
' Modified 2014-05-04
  Public Sub Show()
    Const HKEY_CURRENT_USER=&H80000001
    Const KeyPath="Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_LOCALMACHINE_LOCKDOWN"
    Const KeyName="iexplore.exe"
    Dim File,I,Reg,State,Value
    Set Reg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv") 	' Use . for local computer, otherwise could be computer name or IP address
    'On Error Resume Next        ' Ignore possible errors
    ' Make sure IE is set to allow local content, at least while we get the Progress Bar displayed
    Reg.GetDWORDValue HKEY_CURRENT_USER,KeyPath,KeyName,Value	' Get current property
    State=Value	 							  ' Preserve current option
    Value=0		    							' Set new option 
    Reg.SetDWORDValue HKEY_CURRENT_USER,KeyPath,KeyName,Value	' Update property
    'If Version<>"5.1" Then Prog=False : Exit Sub      ' Need to test for Vista/Windows 7 with UAC
    Set IE=WScript.CreateObject("InternetExplorer.Application","Event_")
    Set File=FSO.CreateTextFile(Temp, True)
    With File
      .WriteLine "<!doctype html>"
      '.WriteLine "<!-- saved from url=(0014)about:internet -->"
      .WriteLine "<!-- saved from url=(0016)http://localhost -->"      ' New "Mark of the web"
      .WriteLine "<html><head><title>" & Title & Blank & "</title>"
      .WriteLine "<style type='text/css'>"
      .WriteLine ".border {border: 5px solid #DBD7C7;}"
      .WriteLine ".debug {font-family: Tahoma; font-size: 8.5pt;}"
      .WriteLine ".empty {border: 2px solid #FFFFFF; background-color: #FFFFFF;}"
      .WriteLine ".filled {border: 2px solid #FFFFFF; background-color: #00FF00;}"
      .WriteLine ".info {font-family: Tahoma; font-size: 8.5pt;}"
      .WriteLine ".status {font-family: Tahoma; font-size: 10pt;}"
      .WriteLine "</style>"
      .WriteLine "</head>"
      .WriteLine "<body scroll='no' style='background-color: #EBE7D7'>"
      .WriteLine "<div style='display:block; height:" & Height & "px; width:" & Width & "px; overflow:hidden;'>"
      .WriteLine "<table border-width='0' cellpadding='2' width='" & Width & "px'><tr>"
      .WriteLine "<td id='Status' class='status'>" & Status & "</td></tr></table>"
      .WriteLine "<table class='border' cellpadding='0' cellspacing='0' width='" & Width & "px'><tr>"
      ' Write out cells
      For I=0 To Cells-1
	      If Filled(I) Then
          .WriteLine "<td id='p' class='filled'>&nbsp;</td>"
        Else
          .WriteLine "<td id='p' class='empty'>&nbsp;</td>"
        End If
      Next
	    .WriteLine "</tr></table>"
      .WriteLine "<table border-width='0' cellpadding='2' width='" & Width & "px'><tr><td>"
      .WriteLine "<span id='Info' class='info'>" & Info & "</span><br>"
      .WriteLine "<span id='Debug' class='debug'>" & Dbg & "</span></td></tr></table>"
      .WriteLine "</div></body></html>"
    End With
    ' Create IE automation object with generated HTML
    With IE
      .width=Width+35           ' Increase if using more cells
      .height=Height+60         ' Increase to allow more info/debug text
      If Version>"5.1" Then     ' Allow for bigger border in Vista/Widows 7
        .width=.width+10
        .height=.height+10
      End If        
      .left=(SWidth-.width)/2
      .top=(SHeight-.height)/2
      .navigate "file://" & Temp
      '.navigate "http://samsoft.org.uk/progbar.htm"
      .addressbar=False
      .resizable=False
      .toolbar=False
      On Error Resume Next      
      .menubar=False            ' Causes error in Windows 8 ? 
      .statusbar=False          ' Causes error in Windows 7 or IE 9
      On Error Goto 0
      .visible=True             ' Causes error if UAC is active
    End With
    Active=True
    ' Restore the user's property settings for the registry key
    Value=State		    					' Restore option
    Reg.SetDWORDValue HKEY_CURRENT_USER,KeyPath,KeyName,Value	  ' Update property 
    Exit Sub
  End Sub
 
' Increment progress bar, optionally clearing a previous cell if working as an activity bar
' Modified 2011-10-05
  Public Sub Step(Clear)
    SetCell NextOn,True : NextOn=(NextOn+1) Mod Cells
    If Clear Then SetCell NextOff,False : NextOff=(NextOff+1) Mod Cells
  End Sub

' Self-timed shutdown
' Modified 2011-10-05 
  Public Sub TimeOut(S)
    Dim I
    Respawn=False                ' Allow uninteruppted exit during countdown
    For I=S To 2 Step -1
      SetDebug "<br>Closing in " & I & " seconds" & String(I,".")
      WScript.sleep 1000
    Next
      SetDebug "<br>Closing in 1 second."
      WScript.sleep 1000
    Close
  End Sub 
    
End Class


' Fires if progress bar window is closed, can't seem to wrap up the handler in the class
' Modified 2011-10-04
Sub Event_OnQuit()
  PB.Cancel
End Sub


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