'=======================================================================================
' Выполнение указанной команды (программы) для каждого элемента файла-списка

' Параметры скрипта:
' [1] - Набор режимов, где каждый режим определяется цифрами по разрядам:
'     1 - обрабатывать каждый список отдельно (0 - умолч.) или синхронно (1),
'     2 - последовательное (0 - умолч.) или параллельное (по числу ядер) выполнение команд по списку
' 2 и далее - Выполняемая команда (программа) и параметры к ней
' Начало и конец файла-списка определяется заданными ниже символами (набором символов).
'   Команда выполняется для каждого элемента списка, подстановкой этого элемента в местоположение списка.
' В качестве параметра может быть указано текстовое содержимое буфера обмена.
'   Тэг буфера обмена задается в секции скрипта "Изменяемые параметры".
'   Для использования буфера обмена в системе должен быть установлен TCScript.Helper.
' Например, параметры вызова из TC для одновременного фонового извлечения из архивов,
'   пароль к которым находится в буфере обмена, в текущую папку:
'   10 "%ProgramFiles%\WinRar\WinRar.Exe" X -ibck -p### "%P{{%L}}" "%P"
'
' Автор  - Batya
' Версия - 1.2
' + Dobrov: можно не писать режим, по-умолчанию 14 (синхронно, 4 задачи максимум)
'======================================================================
Option Explicit
'================= Изменяемые параметры ================================================
Const ListBegin    = "{{"  'Начало списка
Const ListEnd      = "}}"  'Конец списка
Const ClipboardTag = "###" 'Тэг буфера обмена
'=======================================================================================
Dim FSO, WSH, Mess, Mode(1), Command, i, L, P, LenListBegin, LenListEnd, Clipboard, Hint, L1, L1s, R, C, m, z
Set FSO  = CreateObject("Scripting.FileSystemObject")
Set WSH  = CreateObject("WScript.Shell")
R = "14" 'режим по-умолчанию: каждый список синхронно, 4 задачи одновременно

'Задаем массив сообщений
MessDefine : LenListBegin = Len(ListBegin) : LenListEnd = Len(ListEnd)
'Проверяем параметры
CheckParams

'Выполняем команды по списку
For Each L In SearchList(Command, 0)
  C = C +1 'счётчик активных задач
    WSH.Run L, 7, (C >= CInt(Mode(1)))
  ' MsgBox L, vbOKOnly, (C >= CInt(Mode(1)))    'Тестовая строка - раскомментарить для проверки
  if C >= CInt(Mode(1)) then C = 0
Next

Quit    'Выход

'===== Процедуры и функции =============================================================
'Проверка входных параметров
Sub CheckParams
  Dim k, lP, n, F
  With WScript
    If .Arguments.Count < 1 Then
      MsgBox Mess(2), vbCritical + vbOKOnly, Mess(0)
      Quit
    End If

    F = IsNumeric(.Arguments(0)) and (.Arguments.Count > 1)
    If F then m = .Arguments(0)
    m = m & Right(R, Len(R) - Len(m))

    For i = Abs(F) To .Arguments.Count - 1
      lP = WSH.ExpandEnvironmentStrings(.Arguments(i))
      If InStr(lP, " ") > 0 Then lP = """" & lP & """"
      Command = Command & " " & lP
    Next
    Command = Mid(Command, 2)
  End With
  n = UBound(Mode) + 1
  For i = 0 To n - 1
    k = Mid(m, i + 1, 1) 'Берем очередной разряд
    Mode(i) = k
  Next
End Sub

'Поиск в строке тэгов файлов-списков и формирование массива элементов
Function SearchList(pStr, byVal pDepth)
  Dim lList, lL, lPos1, lPos2, lStr, lBegin, lEnd, lList1, lL1, lList2, k, m
  If UCase(ListBegin) = UCase(ListEnd) Then
    'Ищем начало списка
    lPos1 = InStr(1, pStr, ListBegin, vbTextCompare)
    If lPos1 = 0 Then
      SearchList = Array(SearchClipboard(pStr))
      Exit Function
    End If
    'Ищем конец списка
    lPos2 = InStr(lPos1 + LenListBegin, pStr, ListEnd, vbTextCompare)
    If lPos2 = 0 Then
      SearchList = Array(SearchClipboard(pStr))
      Exit Function
    End If
  Else
    'Ищем конец списка
    lPos2 = InStr(1, pStr, ListEnd, vbTextCompare)
    If lPos2 = 0 Then
      SearchList = Array(SearchClipboard(pStr))
      Exit Function
    End If
    'Ищем начало списка
    lPos1 = InStrRev(pStr, ListBegin, lPos2 - 1, vbTextCompare)
    If lPos1 = 0 Then
      SearchList = Array(SearchClipboard(pStr))
      Exit Function
    End If
  End If
  'Файл-список
  lList = Mid(pStr, lPos1 + LenListBegin, lPos2 - lPos1 - LenListBegin)
  'Если файла-списка не существует, выходим
  If Not FSO.FileExists(lList) Then
    MsgBox Mess(3) & " """ & lList & """ " & Mess(4),_
           vbCritical + vbOKOnly, Mess(0)
    Quit
  End If
  'Начало и конец командной строки
  lBegin = Left(pStr, lPos1 - 1)
  lEnd   = Mid(pStr, lPos2 + LenListBegin)
  'Перебираем список
  lList2 = Split(FSO.OpenTextFile(lList, 1, False, -2).ReadAll, vbNewLine)
  m = pDepth
  If pDepth = 0 Then
    pDepth = UBound(lList2)
    m = 0
  End If
  For k = m To pDepth
    lL = lList2(k)
    If lL = "" Then Exit For
    lL = WSH.ExpandEnvironmentStrings(lL)
    If InStr(lL, " ") > 0 Then lL = """" & lL & """"
    'Формируем выходной список в зависимости от режима
    Select Case Mode(0)
      Case 0
        'Рекурсивный поиск списка
        lList1 = SearchList(lBegin & lL & lEnd, 0)
        For Each lL1 In lList1
          lStr = lStr & vbNewLine & lL1
        Next
      Case 1
        'Рекурсивный поиск списка
        lList1 = SearchList(lBegin & lL & lEnd, k)
        lStr   = lStr & vbNewLine & lList1(0)
    End Select
  Next
  SearchList = Split(SearchClipboard(Mid(lStr, Len(vbNewLine) + 1)), vbNewLine)
End Function

'Подстановка текстового значения из буфера обмена
Function SearchClipboard(pStr)
  If UBound(Filter(Array(pStr), ClipboardTag)) >= 0 Then
    SearchClipboard = Replace(pStr, ClipboardTag, GetClipboard)
  Else
    SearchClipboard = pStr
  End If
End Function

'Содержимое буфера обмена
Function GetClipboard()
  If IsEmpty(Clipboard) Then
    GetClipboard = CreateObject("TCScript.Helper").GetTextFromClip
  Else
    GetClipboard = Clipboard
  End If
End Function

'Описание сообщений
Sub MessDefine
  Set Mess = CreateObject("Scripting.Dictionary")
  With Mess
    .Add 0,  "Выполнение программы для списка"
    .Add 1,  "Не указаны параметры!"
    .Add 2,  "Не указана выполняемая команда!"
    .Add 3,  "Файл-список"
    .Add 4,  "не существует!"
    .Add 5,  "Тест командной строки"
  End With
End Sub

'Выход
Sub Quit
  Set Mess = Nothing
  Set WSH  = Nothing
  Set FSO  = Nothing
  WScript.Quit
End Sub