Запускать приложения по расписанию

'——— Мини-планировщик задач ———————————————————————————————————
 
' Назначение: запуск программ в опр. дни недели/месяца и время
' Публикация: https://www.cyberforum.ru/post17272566.html
'  Авторство: FlasherX (09.04.2024)
 
'    Условие: скрипт завершается при отсутствии запланированных
' на текущие сутки задач, поэтому требует каждодневного запуска
 
' /a — запуск с данным ключом производит запись в автозагрузку
' Шаблон задачи: [диск:\путь\]имя программы | <HH:mm> | <дни>
' Пример задачи: notepad | 12:20 | Пн,Ср-Пт,Вс,2-7,9-19,25,28
' С параметрами: %WinDir%\regedit /s c:\fix.reg | 07:00 | все
 
Option Explicit
'——— Путь списка задач в ANSI —————————————————————————————————
Const Tasks = "C:\path to\Tasks.txt"
'——————————————————————————————————————————————————————————————
Dim oFSO, Tm, cDay, wDay, oList, oWSH, oWMI, oCol,_
SINK, Task, Parts, Prog, Ch, i, Str, Dy, Range, c
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not oFSO.FileExists(Tasks) Then MsgBox "Укажите верный путь " &_
"списка задач!" & Space(10), 262192, " Планировщик задач": WSH.Quit
Tm = CDbl(Timer): cDay = Day(Date)
Const Days = "пн вт ср чт пт сб вс"
wDay = WeekdayName(Weekday(Date), 1)
Set oList = oFSO.OpenTextFile(Tasks)
If oList.AtEndOfStream Then
   MsgBox "Список задач пуст!       ", 262192, " Планировщик задач"
   oList.Close: Set oList = Nothing: Set oFSO = Nothing: WSH.Quit
End If
Set oWSH = CreateObject("WScript.Shell")
Set oWMI = GetObject("winmgmts:\\.\root\cimv2")
Set oCol = CreateObject("System.Collections.ArrayList")
Set SINK = WSH.CreateObject("WbemScripting.SWbemSink", "SINK_")
If WSH.Arguments.Named.Exists("a") Then
   Const Key = "HKCU\Software\Microsoft\Windows\CurrentVersion\Run"
   If GetObject("winmgmts:\\.\root\default:StdRegProv").GetStringValue(&H80000001,_
   Key, "Sheduler") Then oWSH.RegWrite Key & "\Sheduler", WSH.ScriptFullName
End If
 
Do: Task = Trim(oList.ReadLine)
   If Not IsEmpty(Task) Then
      Parts = Split(Task, " | ")
      If Ubound(Parts) = 2 Then
         Prog = Parts(0)
         If Left(Prog, 1) = """" Then Prog = Split(Prog, """")(1) Else Prog = Split(Prog)(0)
         If oFSO.GetExtensionName(Prog) = "" Then Prog = Prog & ".exe"
         If InStr(Prog, "\") = 0 Or oFSO.FileExists(oWSH.ExpandEnvironmentStrings(Prog)) Then
            Ch = 0: i = Parts(2)
            Str = "-" & Replace(i, ",", "-") & "-"
            Select Case True
               Case StrComp(i, "все", 1) = 0 Ch = 1
               Case InStr(Str, "-" & cDay & "-") > 0 Ch = 1
               Case InStr(1, Str, "-" & wDay & "-", 1) > 0 Ch = 1
               Case InStr(i, "-") > 0
                  For Each Dy in Split(LCase(i), ",")
                     If InStr(Dy, "-") Then
                        Range = Split(Dy, "-")
                        If IsNumeric(Range(0)) Then
                           If cDay >= Abs(Range(0)) And cDay <= Abs(Range(1)) Then Ch = 1: Exit For
                        ElseIf InStr(1, Mid(Days, InStr(Days, Range(0)) + 2, InStr(Days, Range(1))_
                               - InStr(Days, Range(0)) - 2), wDay, 1) > 0 Then Ch = 1: Exit For
                        End If
                     End If
                  Next
            End Select
            If CDate(Parts(1)) > Time Then _
            If Ch Then oCol.Add Parts(1) & "|" & Parts(0) & "|" & i
         End If
      End If
   End If
Loop Until oList.AtEndOfStream
oList.Close: Set oList = Nothing
If oCol.Count = 0 Then Quit 0
 
oCol.Sort
For Each i in oCol
   oWMI.ExecNotificationQueryAsync SINK, "SELECT * FROM __InstanceModificationEvent" &_
   " WITHIN 1 WHERE TargetInstance ISA 'Win32_LocalTime' AND TargetInstance.Hour="   &_
   Abs(Split(Split(i, "|")(0), ":")(0)) & " AND TargetInstance.Minute=" &_
   Abs(Split(Split(i, "|")(0), ":")(1)) & " AND TargetInstance.Second=0"
Next
Do: WSH.Sleep 8^10: Loop Until c = oCol.Count
 
Sub SINK_OnObjectReady(x, o)
   oWSH.Run Split(oCol(c), "|")(1), 7
   If c = oCol.Count - 1 Then Quit 1
   c = c + 1
End Sub
 
Sub Quit(N)
   Dim Pr, Tx: Tx = Timer
   Const Q = "Win32_Process.Handle="
   Set oCol = Nothing: Set SINK = Nothing: Set oFSO = Nothing
   For Each Pr in oWMI.ExecQuery("Select ElapsedTime,IDProcess FROM" &_
   " Win32_PerfFormattedData_PerfProc_Process WHERE Name='unsecapp'")
      If Pr.ElapsedTime >= Fix(Tx - Tm) Then oWMI.Get(Q & Pr.IDProcess).Terminate
   Next
   If N Then
      Dim PID
      With oWSH.Exec("rundll32 kernel32,Sleep")
         PID = oWMI.Get(Q & .ProcessId).ParentProcessId
         .Terminate
      End With
   End If
   Set oWSH = Nothing
   If N Then oWMI.Get(Q & PID).Terminate
   Set oWMI = Nothing: WSH.Quit
End Sub