'=======================================================================================
' Выполнение указанной команды (программы) для каждого элемента файла-списка
' Параметры скрипта:
' 1 - Набор режимов, где каждый режим определяется цифрами по разрядам:
' 1 - обрабатывать каждый список отдельно (0 - умолч.) или синхронно (1),
' 2 - последовательное (0 - умолч.) или параллельное (1) выполнение команд по списку
' 2 и далее - Выполняемая команда (программа) и параметры к ней
' Начало и конец файла-списка определяется заданными ниже символами (набором символов).
' Команда выполняется для каждого элемента списка, подстановкой этого элемента в
' местоположение списка.
' В качестве параметра может быть указано текстовое содержимое буфера обмена.
' Тэг буфера обмена задается в секции скрипта "Изменяемые параметры".
' Для использования буфера обмена в системе должен быть установлен TCScript.Helper.
' Например, параметры вызова из TC для одновременного фонового извлечения из архивов,
' пароль к которым находится в буфере обмена, в текущую папку:
' 10 "%ProgramFiles%\WinRar\WinRar.Exe" X -ibck -p### {{%L}} "%P"
'
' Автор - Batya
' Версия - 1.2
'=======================================================================================
Option Explicit
'================= Изменяемые параметры ================================================
Const ListBegin = "{{" 'Начало списка
Const ListEnd = "}}" 'Конец списка
Const ClipboardTag = "###" 'Тэг буфера обмена
'=======================================================================================
Dim FSO, WSH, Mess, Mode(1), Command, i, L, P, LenListBegin, LenListEnd, Clipboard
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
'Задаем массив сообщений
MessDefine
'Проверяем параметры
CheckParams
LenListBegin = Len(ListBegin)
LenListEnd = Len(ListEnd)
'Выполняем команды по списку
For Each L In SearchList(Command, 0)
'Тестовая строка - раскомментарить для проверки
'MsgBox L, vbOKOnly, Mess(5)
WSH.Run L, 7, (Mode(1) = 0)
Next
'Выход
Quit
'===== Процедуры и функции =============================================================
'Проверка входных параметров
Sub CheckParams
Dim k, m, lP, n
With WScript
If .Arguments.Count = 0 Then
MsgBox Mess(1), vbCritical + vbOKOnly, Mess(0)
Quit
End If
If .Arguments.Count < 2 Then
MsgBox Mess(2), vbCritical + vbOKOnly, Mess(0)
Quit
End If
m = .Arguments(0)
For i = 1 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
m = Right(String(n, "0") & m, n)
For i = 0 To n - 1
k = Left(Right(m, i + 1), 1) 'Берем очередной разряд
'Проверяем правильность задания каждого режима
Select Case i
Case 0
If IsNumeric(k) Then k = CInt(k)
If (k=0) Or (k=1) Then Mode(i) = k
Case 1
If IsNumeric(k) Then k = CInt(k)
If (k=0) Or (k=1) Then Mode(i) = k
End Select
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 |
Спасибо, заработало.
