Total Commander Forum Index Total Commander
Форум поддержки пользователей Total Commander
Сайты: Все о Total Commander | Totalcmd.net | Ghisler.com | RU.TCKB
 
 RulesRules   SearchSearch   FAQFAQ   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Single Post  Topic: [Script] Выполнение команды для каждого элемента списка 
Author Message
Batya



PostPosted: Wed Dec 31, 2008 11:13    Post subject: [Script] Выполнение команды для каждого элемента списка Reply with quote

Представляю MultiRun.vbs - выполняет мнократный запуск команды для каждого элемента в файле-списке.
Code:
'=======================================================================================
' Выполнение указанной команды (программы) для каждого элемента файла-списка

' Параметры скрипта:
' 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

Плюсы:
- Поддержка неограниченного количества списков. Также возможен вариант перечисления файлов-списков в другом файле-списке.
- Поддержка переменных окружения.
- Возможно задание режима обработки элементов списка.
- Возможно задание режима обработки нескольких списков.
- Использование буфера обмена в параметрах.
_________________
Нет, я не сплю. Я просто медленно моргаю.


Last edited by Batya on Sat Feb 06, 2010 19:55; edited 6 times in total
View user's profile Send private message


Powered by phpBB © 2001, 2005 phpBB Group