Скрипты для Total Commander

  1. Offline

    Andrey_A

    Пользователь

    Posts: 275

    Скрипты - уникальный инструмент для достижения различных целей в работе с файлами и не только, особенно в файловом менеджере, даже если вы раньше об этом ничего не слышали и не знали, то путём простых движений вы можете оптимизировать свои действия
    Тема тестирования скриптов создана для увеличения функциональности Total Commander
    Всё это делается для тех, кто хочет экономить время и автоматизировать работу
    Огромное спасибо участникам, авторам и всем повлиявшим на тему
    #/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#
    В этой теме Каждый может выложить свой скрипт, написанный на любом языке: vbs, js, hta, au3,ahk, bat,cmd... - главное, чтобы он относился как-то к Total Commander, можно было им воспользоваться и к нему было должное описание к применению.
    #/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#
    В теме "Тестирование и заказ скриптов" Каждый может протестировать, дать свой комментарий (все комментарии из этой темы будут удаляться)...если есть интересная идея, вы так же можете поделиться ей в соседней теме и заказать скрипт, а вдруг она покажется интересной для авторов...
    #/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#



    Сообщение отредактировал LonerD 25 апреля 2017 - 04:38

    Читайте: Справочные материалы по работе c TC + Онлайн справка TC

    22 ноября 2011 - 13:03 / #1
  2. Offline

    Andrey_A

    Пользователь

    Posts: 275

    SpisokHtmlLink.vbs
    Создание списка файлов с гиперссылками в html формате

    ' SpisokHtmlLink.vbs
    '========================   Описание   =====================================
    ' Создание списка файлов с гиперссылками в html формате
    '=======================   Параметры  =====================================
    ' 1-й параметр: список файлов
    ' 2-й параметр: путь сохранения
    ' 3-й параметр: текст до
    ' 4-й параметр: текст после
    '========================   Примеры   =====================================
    ' %UL %t   - сохранение в соcедней панели списка с гиперссылками в html
    ' Автор:             Аверин Андрей
    ' Версия:          1.1 (18.10.2011 - 23.11.2011)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '========================================================================
    With WScript
      If .Arguments.Count < 2 Then
        MsgBox "Не хватает параметров!" & vbNewLine &_
        "Должно быть прописано минимум 2 параметра %UL %t",_
        vbOKOnly & vbInformation, "Создание списка файлов в html формате"
        .Quit
      End If
      List = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(.Arguments(0)).ReadAll, vbNewLine)
      Path = .Arguments(1)
      If Cnt > 2 Then
        Text1 = .Arguments(2)
        If Cnt > 3 Then Text2 = .Arguments(3)
      End If
    End With
    Stroki = "<head>" & vbNewLine &_
                   "<meta http-equiv='Content-Type'content='text/html; charset=utf-8' />" & vbNewLine &_
                   "<style type='text/css'>" & vbNewLine &_
                   "body {background-color: #E4F3FF;font-family: sans-serif, Helvetica, Arial;font-size:px;}" & vbNewLine &_
                   "h1 {color: #2D58AE;font-size: 25px;}" & vbNewLine &_
                   "hr {color: #555555;}" & vbNewLine &_
                   "</style>" & vbNewLine &_
                   "</head>" & vbNewLine &_
                   "<body>" & vbNewLine &_
                   "<h1>List Link</h1>" & vbNewLine &_
                   "<hr />" & vbNewLine &_
                   "<ol>"
    With CreateObject("Scripting.FileSystemObject")
      For i = 0 To Ubound(List)
        If Len(List(i)) > 0 Then Stroki = Stroki & vbNewLine & "    <li><a href='" & List(i) & "'>" & text1 & .GetFileName(List(i)) & text2 & "</a><BR></li>"
      Next

      Stroki = Stroki & vbNewLine  & "</ol>" & vbNewLine & "<hr />" & vbNewLine & "</body>" & vbNewLine & "</html>" & vbNewLine
      .CreateTextFile(Path & "SpisokLink" & "." & "html", True).Write(Stroki)
    End With
    WScript.Quit
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:27

    Читайте: Справочные материалы по работе c TC + Онлайн справка TC

    23 ноября 2011 - 16:33 / #31
  3. Offline

    Andrey_A

    Пользователь

    Posts: 275

    SpisokHtmlTab.vbs
    Создание списка файлов в html формате в виде таблицы

    ' SpisokHtmlTab.vbs
    '========================   Описание   ===============
    ' Создание списка файлов в html формате в виде таблицы
    '=======================   Параметры  ===============
    ' 1-й параметр: список файлов
    ' 2-й параметр: путь сохранения
    ' 3-й параметр: текст до
    ' 4-й параметр: текст после
    '========================   Примеры   ===============
    ' %UL %t   - сохранение в соcедней панели списка в html
    ' Автор:             Аверин Андрей
    ' Версия:          1.2 (2010 - 23.11.2011)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '==================================================
    With WScript
      If .Arguments.Count < 2 Then
        MsgBox "Не хватает параметров!" & vbNewLine &_
        "Должно быть прописано минимум 2 параметра %UL %t",_
        vbOKOnly & vbInformation, "Создание списка файлов в html формате"
        .Quit
      End If
      Set ts = CreateObject("Scripting.FileSystemObject").OpenTextFile(.Arguments(0), 1)
      Path = .Arguments(1)
      If Cnt > 2 Then
        Text1 = .Arguments(2)
        If Cnt > 3 Then Text2 = .Arguments(3)
      End If
    End With
    i = 1
    Stroki = "<head>" & vbNewLine &_
                  "<meta http-equiv='Content-Type'content='text/html; charset=utf-8' />" & vbNewLine &_
                  "<style type='text/css'>" & vbNewLine &_
                  "body {background-color: #E4F3FF;font-family: sans-serif, Helvetica, Arial;font-size:px;}" & vbNewLine &_
                  "h1 {color: #2D58AE;font-size: 25px;}" & vbNewLine &_
                  "hr {color: #555555;}" & vbNewLine &_
                  "</style>" & vbNewLine &_
                  "</head>" & vbNewLine &_
                  "<body>" & vbNewLine &_
                  "<h1>List " & text1 & "</h1>" & vbNewLine &_
                  "<div align='center'><center><table border='1' cellpadding='3' cellspacing='0'" & vbNewLine &_
                  "bordercolorlight='#8080FF' bordercolordark='#000080'>" & vbNewLine
    Do Until ts.AtEndOfStream
      Stroki = Stroki & "   <tr><td bgcolor='#EEEEFF'>" & i & "</td>" & vbNewLine
      Stroki = Stroki & "   <td bgcolor='#EEEEFF'>" & text1 & "&nbsp;&nbsp;" & ts.ReadLine &  "&nbsp;&nbsp;" & text2 & "  </td></tr>" & vbNewLine
      i = i + 1
    Loop

    Stroki = Stroki & "</body>" & vbNewLine & "</html>" & vbNewLine
    CreateObject("Scripting.FileSystemObject").CreateTextFile(Path & "SpisokTab" & "." & "html", True).Write(Stroki)
    ts.Close : Set ts = Nothing : WScript.Quit
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:27

    Читайте: Справочные материалы по работе c TC + Онлайн справка TC

    23 ноября 2011 - 16:34 / #32
  4. Offline

    Andrey_A

    Пользователь

    Posts: 275

    GroupDescripts.vbs
    Массовое Добавление\Удаление\Замена комментария (descript.ion), переданного параметрами

    ' GroupDescripts.vbs
    '========================   Описание   =====================================
    ' Массовое Добавление\Удаление\Замена комментария (descript.ion), переданного параметрами
    '=======================   Параметры  =====================================
    ' 1-й параметр: %p - обязательный
    ' 2-й параметр: список файлов- обязательный
    ' 3-й параметр: Сам Комментарий
    ' 4-й параметр: Режим работы с комментарием
    '      1 - Добавление (по умолчанию)
    '      2 - Удаление
    '      3 - Инверсия
    ' 5-й параметр: Режим места комментария
    '      1 - Начало (по умолчанию)
    '      2 - Конец
    '      3 - Полностью
    '========================   Примеры   =====================================
    ' %p %L - Комметарий, режим вводится во всплывающих диалогах (если коментарий оставить в окне пустым, он берётся из буфера)
    ' %p %L "Мой комментарий" - Режим вводится во всплывающих диалогах
    ' %p %L "Мой комментарий" 1  - Комментарий добавляется, режим места вводится в диалоге
    ' %p %L "Мой комментарий" 1 1  - Комментарий добавляется в начало
    ' %p %L "" 2 3 - Полностью удаляются комментарии для выделенного

    ' %p %L "####" 1 1 - добавления комментария ''####'' в начало
    ' %p %L "####" 2 1 - удаление комментария ''####'' в начале
    ' %p %L "####" 1 2 - добавления комментария ''####'' в конец
    ' %p %L "####" 2 2 - удаление комментария ''####'' в конеце

    ' Автор:             Batya & Аверин Андрей
    ' Версия:          1.2 (28.08.2006 - 30.10.2011)
    ' Site:                  http://tc-image.3dn.ru
    '========================================================================
    Dim TextComm, M1, M2
    Titles = "Групповое комментирование "
    Cnt = WScript.Arguments.Count
    If Cnt < 2 Then
      MsgBox "Не хватает параметров!" & vbNewLine &_
      "Должно быть прописано минимум 2 параметра %p %L",_
      vbOKOnly & vbInformation, Titles
      WScript.Quit
    End If
    If Cnt < 3 Then
      TextComm = InputBox("Введите комментарий, который необходимо внести\удалить" & vbNewLine &_
      "(по умолчанию комментарий берётся из буфера обмена)", Titles)
    Else
      TextComm = WScript.Arguments(2)
    End If
    If Cnt < 4 Then
      M1 = InputBox("Введите режим работы с комментарием ." & vbNewLine &_
                                  "Если хотите добавить коментарий - введите 1." & vbNewLine &_
                                  "Если хотите удалить - введите 2." & vbNewLine &_
                                  "Если инвертировать - введите 3" & vbNewLine &_
                                  "(по умолчанию число равно 1)", Titles, "1")
      If Len(M1) = 0 Then WScript.Quit
    Else
      M1 = WScript.Arguments(3)
    End If
    If M1 < 1 Or M1 > 3 Then ErrComm

    If Cnt < 5 Then
      M2 = InputBox("Введите режим места комментария ." & vbNewLine &_
                                  "Если хотите добавить в начало - введите 1." & vbNewLine &_
                                  "Если хотите добавить в конец - введите 2." & vbNewLine &_
                                  "Если хотите добавить полностью - введите 3" & vbNewLine &_
                                  "(по умолчанию число равно 1)", Titles, "1")
      If M2 = "" Then WScript.Quit
      If Len(M2) = 0 Then WScript.Quit
    Else
      M2 = WScript.Arguments(4)
    End If

    Dim Mode2
    If WScript.Arguments.Count < 2  Then
      Mode2 = 1
    Else
      Mode2 = M2
    End If

    If Mode2 < 1 Or Mode2 > 3 Then ErrComm

    Dim CommLabel
    CommLabel = TextComm
    If Len(CommLabel) = 0 Then
      CommLabel = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")
      If Len(CommLabel) = 0 Then ErrComm
      CommLabel = Replace(CommLabel, vbNewLine, " ")
      CommLabel = Replace(CommLabel, Chr(10),   " ")
      CommLabel = Replace(CommLabel, Chr(13),   " ")
    End If

    Dim FSO, oTextFile, OTF, oCommFile
    Dim AllText, FileName, CommFile, BegFile, BegFileComm, EndFileComm
    Dim Mode1, CompareComm, FindComm, LenC
    Set FSO  = CreateObject("Scripting.FileSystemObject")
    CommFile = WScript.Arguments(0) & "descript.ion"
    Mode1 = M1 : LenC = Len(CommLabel)

    If FSO.FileExists(CommFile) Then
      Set oTextFile = FSO.OpenTextFile(CommFile, 1)
      On Error Resume Next  'Игнорируем ошибку, если файл пустой
      AllText = oTextFile.ReadAll
      On Error GoTo 0
      oTextFile.Close
    Else
      On Error Resume Next
      Set oTextFile = FSO.CreateTextFile(CommFile)
      If Err.Number = 0 Then
        oTextFile.Close
        With FSO.GetFile(CommFile) .Attributes = .Attributes Or 2 End With
        AllText = ""
      Else
        ErrWrite : Err.Clear : Set oTextFile = Nothing : Set FSO = Nothing : WScript.Quit
      End If
    End If

    Set OTF = FSO.OpenTextFile(WScript.Arguments(1), 1)
    Do While Not OTF.AtEndOfStream
      FileName = OTF.ReadLine
      If FSO.FileExists(FileName) Then
        FileName = FSO.GetFile(FileName).Name
      Else
        FileName = FSO.GetFolder(FileName).Name
      End If
      If InStr(1, FileName, " ", 1) > 0 Then FileName = """" & FileName & """"
      BegFile = InStr(1, vbNewLine & AllText, vbNewLine & FileName & " ", 1)
      If BegFile > 0 Then 'Есть какой-то комментарий для текущего файла
        BegFileComm = BegFile + Len(FileName) + 1 'Позиция начала комментария
        EndFileComm = InStr(BegFileComm, AllText & vbNewLine, vbNewLine, 1) 'Конец комментария + 1
        If EndFileComm - BegFileComm < LenC Then 'Существующий комм. не равен указанному
          FindComm = 0
        Else 'Поверяем дальше
          CompareComm = Mid(AllText, BegFileComm, EndFileComm - BegFileComm)
          If StrComp(CompareComm, CommLabel, 1) = 0 Then 'Существующий комм. = указанному
            FindComm = 2
          Else
            Select Case Mode2
            Case 1 'Начало
              If InStr(1, Left(CompareComm, LenC), CommLabel, 1) > 0 Then
                FindComm = 1
              Else
                FindComm = 0
              End If
            Case 2 'Конец
              If InStr(1, Right(CompareComm, LenC), CommLabel, 1) > 0 Then
                FindComm = 1
              Else
                FindComm = 0
              End If
            Case 3 'Полностью
              FindComm = 0
            End Select
          End If
        End If
        If FindComm = 0 Then 'Существующий комм. не равен указанному
          If Mode1 = 1 Or Mode1 = 3 Then 'Добавляем комментарий
            Select Case Mode2
            Case 1 AllText = Left(AllText, BegFileComm - 1) & CommLabel & " " & Mid(AllText, BegFileComm)
            Case 2 AllText = Left(AllText, EndFileComm - 1) & " " & CommLabel & Mid(AllText, EndFileComm)
            Case 3 AllText = Left(AllText, BegFileComm - 1) & CommLabel & Mid(AllText, EndFileComm)
            End Select
          End If
          If Mode1 = 2 Or Mode2 = 3 Then AllText = DelLine(AllText, BegFile, EndFileComm)
        ElseIf FindComm = 1 Then 'Указанный комментарий есть
          If Mode1 = 2 Or Mode1 = 3 Then 'Удаляем комментарий
            Select Case Mode2
            Case 1 AllText = Left(AllText, BegFileComm - 1) & Mid(AllText, BegFileComm + LenC + 1)
            Case 2 AllText = Left(AllText, EndFileComm - LenC - 2) & Mid(AllText, EndFileComm)
            Case 3 AllText = DelLine(AllText, BegFile, EndFileComm)
            End Select
          End If
          If Mode1 = 1 Or Mode2 = 3 Then AllText = Left(AllText, BegFileComm - 1) & CommLabel & Mid(AllText, EndFileComm)
        Else 'FindComm = 2 - Существующий комментарий равен указанному
          If Mode1 = 2 Or Mode1 = 3 Then AllText = DelLine(AllText, BegFile, EndFileComm)
        End If
        If Mode1 = 2 Or (Mode1 = 3 And (FindComm = 1 Or FindComm = 2)) Then' Обработаем после удаления
          If Instr(BegFile, AllText, FileName & "  ", 1) > 0 Then AllText = Left(AllText, BegFileComm - 2) & Mid(AllText, BegFileComm)
          If Instr(BegFile, AllText & vbNewLine, FileName & " " & vbNewLine) > 0 Then AllText = Left(AllText, BegFile - 1) & Mid(AllText, BegFile + Len(FileName & " " & vbNewLine))
          If Right(AllText, Len(vbNewLine)) = vbNewLine Then AllText = Left(AllText, Len(AllText) - Len(vbNewLine))
          If Right(AllText, Len(vbNewLine)) = vbNewLine Then AllText = Left(AllText, Len(AllText) - Len(vbNewLine))
          If Len(AllText) = 0 Then FSO.DeleteFile(CommFile)
        End If
        If Len(AllText) > 0 Then
          On Error Resume Next
          With FSO.OpenTextFile(CommFile, 2)
            If Err.Number = 0 Then
              .Write AllText : .Close
            Else
              ErrWrite : Err.Clear : Exit Do
            End If
          End With
          On Error GoTo 0
        End If
      Else            'Нет комментариев для файла
        If Mode1 = 1 Or Mode1 = 3 Then             'Добавляем комментарий
          On Error Resume Next
          With FSO.OpenTextFile(CommFile, 8, 2)
            If Err.Number = 0 Then
              If Right(AllText, Len(vbNewLine)) <> vbNewLine Then .WriteLine : AllText = AllText & vbNewLine
              .Write FileName & " " & CommLabel : .Close : AllText = AllText & FileName & " " & CommLabel
            Else
              ErrWrite : Err.Clear : Exit Do
            End If
          End With
          On Error GoTo 0
        End If
      End If
    Loop

    OTF.Close :Set oTextFile = Nothing : Set OTF = Nothing : Set FSO = Nothing : WScript.Quit

    Function DelLine(FullText, BegLine, EndLine)
      If BegLine > Len(vbNewLine) Then
        DelLine = Left(FullText, BegLine - 1 - Len(vbNewLine)) & Mid(FullText, EndLine)
      ElseIf EndLine - 1 + Len(vbNewLine) <= Len(FullText) Then
        DelLine = Left(FullText, BegLine - 1) & Mid(FullText, EndLine + Len(vbNewLine))
      Else
        DelLine = ""
      End If
    End Function

    Sub ErrComm
      MsgBox "Не определен комментарий", vbOKOnly + vbExclamation, Titles : WScript.Quit
    End Sub

    Sub ErrWrite
      MsgBox "Запись в " & CommFile & " невозможна из-за ошибки:" &_
      vbNewLine & Err.Description, vbOKOnly + vbCritical, Titles
    End Sub
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:28

    Читайте: Справочные материалы по работе c TC + Онлайн справка TC

    23 ноября 2011 - 17:00 / #33
  5. Offline

    Andrey_A

    Пользователь

    Posts: 275

    NnulFilesExt1OnExt2.vbs
    Создание в текущей папке для всех файлов с указанным расширением аналогичного файла с другим указанным расширением

    ' NnulFilesExt1OnExt2.vbs
    '========================   Описание   =====================================
    ' Создание в текущей папке для всех файлов с указанным расширением
    ' аналогичного файла с другим указанным расширением
    '=======================   Параметры  =====================================
    ' 1-й параметр: путь\к\папке
    ' 2-й параметр: расширение исходных файлов
    ' 3-й параметр: расширение создаваемых файлов
    ' если 2-й и 3-й параметр отсутствуют, их можно ввести в диалоге
    '========================   Примеры   =====================================
    ' %p
    ' %p mp3 txt
    ' Автор:             Batya & Аверин Андрей
    ' Версия:          1.2 (10.05.2006 - 14.11.2011)
    ' Site:                  http://tc-image.3dn.ru
    '========================================================================
    CurrentFolder = CreateObject("Shell.Application").NameSpace(WScript.Arguments(0)).Self.Path & "\"
    Titles = "Создание зеркальных файлов "
    Ext1 = InputBox("Введите РАСШИРЕНИЕ файла, которому" & vbNewLine &_
      "будет делаться зеркальные файл(ы) в текущем каталоге." & vbNewLine &_
      "Пример для ввода: mp3", Titles, "mp3")
    If Len(Ext1) = 0 Then WsEnd

    Ext2 = InputBox("Введите РАСШИРЕНИЕ зеркальных файлов" & vbNewLine &_
    "Пример для ввода: txt", Titles, "txt")
    If Len(Ext2) = 0 Then WsEnd

    With CreateObject("Scripting.FileSystemObject")
      If Not .FolderExists(CurrentFolder) Then
        MB = MsgBox("Папка " & CurrentFolder &_
        " не существует!", vbOKOnly + vbExclamation, Titles) : WScript.Quit
      End If

      For Each oFile in .GetFolder(CurrentFolder).Files
        If .GetExtensionName(oFile.Path) = Ext1 Then
          NewFilePath = CurrentFolder & .GetBaseName(oFile.Path) & "." & Ext2
          If Not .FileExists(NewFilePath) Then .CreateTextFile(NewFilePath)
        End If
      Next
    End With
    Wscript.Quit

    Sub WsEnd : MsgBox "Не задано расширение!", vbExclamation, Titles : WScript.Quit : End Sub
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:28

    Читайте: Справочные материалы по работе c TC + Онлайн справка TC

    23 ноября 2011 - 17:01 / #34
  6. Offline

    Andrey_A

    Пользователь

    Posts: 275

    BigDateNameFolder.vbs
    Создание НУЖНОГО количества каталогов с именем текущей даты
    Используется TCMC.exe - файл можете скачать в шапке темы

    ' BigDateNameFolder.vbs
    '========================   Описание   =====================================
    ' Создание НУЖНОГО количества каталогов с именем текущей даты [29.09.2010 -  10.25.33]
    '=======================   Параметры  =====================================
    ' 1-й параметр: путь\где\создавать\каталоги
    ' 2-й параметр: имя перед датой
    ' 3-й параметр: количество создаваемых каталогов
    '========================   Примеры   =====================================
    ' %p             - Создать в текущей папке каталоги с Датой, количество вводится в диалоге
    ' %p "%O " - Создать в текущей папке каталоги с именем под курсором + Дата, количество вводится в диалоге
    ' %p "" 10   - Создать в текущей папке 10 каталогов с Датой, количество вводится в диалоге
    ' %p "Моя папка " 100
    '
    ' Автор:             Аверин Андрей
    ' Версия:          1.1 (08.08.2010 - 30.10.2011)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '============================================================================
    With WScript
      Cnt = .Arguments.Count
      If Cnt < 1 Then
        MsgBox "Неправильно указано количество параметров!" & vbNewLine &_
        "Должен быть Один параметр %p", vbOKOnly & vbInformation, "Создание каталогов"
        .Quit
      End If

      Path = .Arguments(0)
      If Cnt > 1 Then
        Insert = .Arguments(1)
        If Cnt > 2 Then Count = .Arguments(2)
      End If

      If Len(Count) = 0 Then
        Count = InputBox("Введите нужное КОЛИЧЕСТВО создаваемых каталогов именем сегодняшней даты" &_
        vbNewLine & "(по умолчанию число создаваемых каталогов равно 2)", "Создание каталогов ", 2)
        If Len(Count) = 0 Then .Quit
      End If

    End With

    YY = Year(Date) : MM = Month(Date) : DD = Day(Date) : H = Hour(Time) : M = Minute(Time) : S = Second(Time)

    For i = 1 To Count
      FoldTime = "[" & Right("0" & YY, 2)  & "." & Right("0" & MM, 2)  & "." & Right("0" & DD, 2)  &_
                            " - " & Right("0" & H, 2)  & "." & Right("0" & M, 2)  & "." & Right("0" & S, 2)  & "]"
      Call CreateObject("Scripting.FileSystemObject").CreateFolder(Path & Insert & FoldTime)
      S = S + 1
      if S = 60 Then
          S = 0 : M = M + 1
          If M = 60 Then
              M = 0 : H = H + 1
              if H = 23 Then
                  H = 0 : DD = DD + 1
                  If DD = 31 And MM = 1 Then MM = MM + 1
                  If DD = 31 And MM = 3 Then MM = MM + 1
                  If DD = 31 And MM = 5 Then MM = MM + 1
                  If DD = 31 And MM = 7 Then MM = MM + 1
                  If DD = 31 And MM = 8 Then MM = MM + 1
                  If DD = 31 And MM = 10 Then MM = MM + 1
                  If DD = 31 And MM = 12 Then MM = 1 : YY = YY + 1 End If
                  If DD = 30 And MM = 4 Then MM = MM + 1
                  If DD = 30 And MM = 6 Then MM = MM + 1
                  If DD = 30 And MM = 9 Then MM = MM + 1
                  If DD = 30 And MM = 11 Then MM = MM + 1
                  If DD = 28 And MM = 2 Then
                    If YY/4 <> Atn(YY/4) Then MM = MM + 1
                  End If
                  If DD = 29 And MM = 2 Then MM = MM + 1
              End if
          End If
      End if
    Next

    CreateObject("WScript.Shell").Exec("%COMMANDER_PATH%\Utilities\TotalCom\TCMC\TCMC.exe 100 CM540")
    Wscript.Quit
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:29

    Читайте: Справочные материалы по работе c TC + Онлайн справка TC

    23 ноября 2011 - 17:04 / #35
  7. Offline

    Andrey_A

    Пользователь

    Posts: 275

    CreateBigFolders.vbs
    Создание НУЖНОГО количества каталогов с добавлением счётчика
    Используется TCMC.exe - файл можете скачать в шапке темы

    ' CreateBigFolders.vbs
    '=============================== Описание ====================================
    ' Создание НУЖНОГО количества каталогов с добавлением счётчика _00N
    '============================== Параметры ====================================
    ' 1-й параметр: Путь\сохранения\каталогов (обязательный)
    ' 2-й параметр: Имя каталога, если параметр не указан, то:
    '      ИМЯ создаваемых каталогов = Имени "КАТАЛОГ"
    '      ИМЯ возможно ввести во всплывающем диалоге
    ' 3-й параметр:
    '      1 - каталоги будут сохраняться в Родительской папке
    '      2 - каталоги будут сохраняться в Дедушкиной папке
    '      3 - каталоги будут сохраняться в Корне диска
    ' 4-й параметр: любой, если он есть, то всплывающий диалог не появится
    '============================== Примеры ====================================
    ' %p                  -
    ' %p "%O"       -  создание каталогов в текущей панели
    ' %p "%O" 0 1 -  создание каталогов в текущей панели (без диалога о вводе имени)
    ' %p "%O" 1    -  создание каталогов в текущей панели в родительской папке
    ' %t                    -
    ' %t "%O"         -  создание каталогов в соседней панели
    ' %t "%O" 0 1   -  создание каталогов в соседней панели (без диалога о вводе имени)
    ' %t "%O" 3      -  создание каталогов в соседней панели в корне диска
    ' %p "Имя каталогов" 0 1
    ' также можно попробовать 2-й параметр %M
    ' Автор:             Аверин Андрей
    ' Версия:          1.7 (2010 - 30.10.2011)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '============================================================================
    Titles = "Создание каталогов "
    With WScript
      Cnt = .Arguments.Count
      If Cnt < 1 Then
       MsgBox "Неправильно указано количество параметров!" & vbNewLine &_
       "Должен быть как минимум Один параметр %p", vbOKOnly & vbInformation, Titles
       .Quit
      End If

      Set FSO = CreateObject("Scripting.FileSystemObject")
      Path = .Arguments(0) : If Right(Path, 1) <> "\" Then    Path = FSO.GetParentFolderName(Path) & "\"

      If Cnt > 2 Then
        Select Case .Arguments(2)
          Case 1 Path = FSO.GetParentFolderName(Path) & "\"
          Case 2 Path = FSO.GetParentFolderName(FSO.GetParentFolderName(Path)) & "\"
          Case 3 Path = Left(Path,3)
        End Select
      End If

      If Cnt > 1 Then NameFold = FSO.GetBaseName(.Arguments(1))
    End With
    If Len(NameFold) = 0 Then NameFold = "Каталог"

    If Cnt < 4 Then
      NameFold = InputBox("   Введите ИМЯ создаваемых каталогов" & vbNewLine &_
      "   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - " , Titles, NameFold)
      If Len(NameFold) = 0 Then WsEnd
    End If
    StrFind = InputBox("Введите нужное КОЛИЧЕСТВО создаваемых каталогов" &_
      vbNewLine & "- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -" & vbNewLine &_
      "(по умолчанию число создаваемых каталогов равно 5)", Titles, 5)
    If Len(StrFind) = 0 Then WsEnd

    For i = 1 To StrFind
      NewFold = Path & NameFold & Number(i)
      Do While FSO.FolderExists(NewFold)
           n = n + 1 : NewFold = Path & NameFold & Number(n)
      Loop
      FSO.CreateFolder(NewFold)
    Next

    CreateObject("WScript.Shell").Exec("%COMMANDER_PATH%\Utilities\TotalCom\TCMC\TCMC.exe 100 CM540")
    WsEnd
    Sub WsEnd : Set FSO = Nothing : WScript.Quit : End Sub
    Function Number(t) : Number = "_" & t \100 & (t Mod 100)\10 & (t Mod 10) : End Function
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:29

    Читайте: Справочные материалы по работе c TC + Онлайн справка TC

    23 ноября 2011 - 17:06 / #36
  8. Offline

    Andrey_A

    Пользователь

    Posts: 275

    CreateFolderLine.vbs
    Создание ВЛОЖЕННЫХ друг в друга каталогов из строки типа кат1|кат2|кат3|кат4

    ' CreateFolderLine.vbs
    '========================   Описание   =====================================
    ' Создание ВЛОЖЕННЫХ друг в друга каталогов из строки типа кат1|кат2|кат3|кат4
    ' Можно ввести и строку типа "c:\Files\Scripts\1\3\"  -   с:\ не будет браться в расчёт
    ' Вместо | могут разделителями могут быть *  \  /     ? | : < >
    ' строка       1/2*3?4>5<6|7\8"9:10      создаст 10 каталогов 1 в нём 2 в нём 3 ...
    '========================  Параметры =====================================
    'Параметры вызова {"путь\создания\папок\"}
    'Пример %p
    '
    ' Автор:             Аверин Андрей
    ' Версия:          1.5 (15.11.2010 - 20.08.2011)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '========================================================================
    Option Explicit
    Const Titles = "Создание ВЛОЖЕННЫХ друг в друга каталогов"
    If WScript.Arguments.Count < 1 Then
      MsgBox "Неправильно указано количество параметров!" & vbNewLine &_
       "Должен быть минимум Один параметр %p", vbOKOnly & vbInformation, Titles
      WScript.Quit
    End If
    Dim FSO, NewFold, i, n, m, k, Line, LineX, Name, Path
    Path = CreateObject("Shell.Application").NameSpace(WScript.Arguments(0)).Self.Path & "\"
    Name = "" : LineX = "\/>""""<|*?:"
    Line = InputBox("Введите СТРОКУ создаваемых каталогов." & vbNewLine &_
      "Пример: папка1\папка2\папка3\папка4\" & vbNewLine &_
      "Разделителем может быть \  *  /  |  >  <    ?  : """ & vbNewLine &_
      "Можно ввести  с:\k1\k2\  и в кавычках" & vbNewLine &_
      "Лишнее будет отсекаться и создадутся" & vbNewLine &_
      "каталоги k1, а в нём k2 в текущей панели", Titles,"Папка1|Папка2\Папка3/Папка4?Папка5")
    If Len(Line) = 0 Then Wscript.Quit

    For i = 1 To Len(LineX)*3
      n = Mid(LineX, i, 1)
      If Left(Line, 1) = n Then Line = Right(Line, Len(Line) - 1)
      If Right(Line, 1) = n Then Line = Left(Line, Len(Line) - 1)
    Next

    If Mid(Line, 2, 2) = ":\" Then Line = Right(Line, Len(Line) - 3)

    For i = 1 To Len(Line)
      n = Mid(Line, i, 1)
      If n = "\" Or n = "|" Or n = "/" Or n = "*" Or n = "?" Or n = ":" Or n = """" Or n = ">" Or n = "<" Then
        If i <> Len(Line) And k <> 1 Then
            CreateFold :     Path = Path & Name & "\" : Name = "" : m = i : k = 1
        End If
        Else
          Name = Name & n : k = 0
      End If
    Next

    Name = "" : n = Right(Line, 1)

    If n <> "\" Or n <> "|" Or n <> "/" Or n <> "*" Or n <> "?" Or n <> ":" Or n <> """" Or n <> ">" Or n <> "<" Then
      Name = Mid(Line, m+1) : CreateFold
    End If
    Wscript.Quit

    Sub CreateFold : CreateObject("Scripting.FileSystemObject").CreateFolder(Path & Name) : End Sub
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:30

    Читайте: Справочные материалы по работе c TC + Онлайн справка TC

    23 ноября 2011 - 17:12 / #37
  9. Offline

    Andrey_A

    Пользователь

    Posts: 275

    DelEmtySubDirs.vbs
    Удаление пустых папок внутри текущей директории и во всех вложенных в нее

    'DelEmtySubDirs.vbs
    '========================   Описание   =====================================
    ' Удаление пустых папок внутри текущей директории и во всех вложенных в нее.
    ' Если текущая будет корневой -- во всем диске тогда.
    '=======================   Параметры  =====================================
    ' %p или %P%N (папка под курсором)
    ' Можно указать начальную папку и напрямую 'StartFolder = "D:\"
    ' Автор:             Volniy
    ' Версия:          1.0 (2004)
    '========================================================================
    Option Explicit
    Dim fso, StartFolder

    If WScript.Arguments.Count = 1 Then
      StartFolder = CreateObject("Shell.Application").NameSpace(WScript.Arguments(0)).Self.Path & "\"
    Else
      MsgBox "Должен быть один параметр!", vbCritical : WScript.Quit
    End If

    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FolderExists(StartFolder) = False Then
      MsgBox "Неверная директория!", vbCritical : WScript.Quit
    End If

    ScanFolder StartFolder
    MsgBox "Пустые папки в '" & StartFolder & "' удалены!", vbInformation

    Set fso = Nothing : WScript.Quit

    Sub ScanFolder(FolderPath)
      Dim curFolder, FItem
      Set curFolder = fso.GetFolder(FolderPath)
      For Each FItem In curFolder.SubFolders
        ScanFolder FItem.Path
      Next
      On Error Resume Next
      If curFolder.SubFolders.Count = 0 And curFolder.Files.Count = 0 Then curFolder.Delete
      Set curFolder = Nothing
    End Sub
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:30

    Читайте: Справочные материалы по работе c TC + Онлайн справка TC

    23 ноября 2011 - 17:14 / #38
  10. Offline

    Andrey_A

    Пользователь

    Posts: 275

    GoCDPahtBuffer.vbs
    Переход в каталог, путь которого содержится в буфере обмена
    Используется TCMC.exe - файл можете скачать в шапке темы

    ' GoCDPahtBuffer.vbs
    '========================   Описание   =====================================
    ' Переход в каталог, путь которого содержится в буфере обмена
    ' Можно даже скопировать полный путь с файлом (имя отсечётся)
    '=======================   Параметры  =====================================
    ' 1-й параметр:
    '    0 - каталог открывается в текущей панели (или без параметров)
    '    1 - каталог открывается в соседней панели
    ' 2-й параметр:
    '    любой параметр = каталог открывается в новой вкладке
    '========================   Примеры   =====================================
    ' 0 1 - открывается в текущей панели в новой вкладке
    ' 1    - каталог открывается в соседней панели
    '
    ' Автор:             Аверин Андрей
    ' Версия:          1.4 (2010 - 08.03.2012)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '========================================================================
    Panel = 0 : Tab = 0 : CD = "CDS"
    With WScript
      Cnt = .Arguments.Count
      If Cnt > 0 Then
        Panel = .Arguments(0)
        If Cnt > 1 Then CD = "CDST"
      End If
    End With

    Clip = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")
    If Len(Clip) < 2 Then MSBOX
    On Error Resume Next
    Path = Split(Clip, vbNewLine)(0)

    On Error Resume Next
    If Mid(Path, 1, 1) = Chr(34) Then Path = Right(Path, Len(Path) - 1)
    If Mid(Path,Len(Path), 1) = Chr(34) Then Path = Left(Path, Len(Path) - 1)
    Path = Trim(Replace(Path, "%%", "%"))

    With CreateObject("Scripting.FileSystemObject")
      If Mid(Path, 1, 1) = "%" Then Path = WScript.CreateObject("WScript.Shell").ExpandEnvironmentStrings(Path)
      If Len(Path) > 2 And Mid(Path, 2, 1) = ":" Then
          If .FileExists(Path) Then Path = .GetParentFolderName(Path)
          If Panel = 0 Then
            Path = Path & Chr(34) & Chr(32) & Chr(34) & Chr(34)
          Else
            Path = Chr(34) & Chr(32) & Chr(34) & Path & Chr(34)
          End If
        CreateObject("WScript.Shell").Exec("%COMMANDER_PATH%\Utilities\TotalCom\TCMC\TCMC.exe " & CD & Chr(32) & Chr(34) & Path)
      Else
       MSBOX
      End if
    End With
    Wscript.Quit

    Sub MSBOX
      MsgBox "Буфер обмена не содержит пути!!!" & vbNewLine &_
      "Скопируйте корректный путь и повторите команду ещё раз!", vbOKOnly &_
        vbInformation , "Переход в каталог, путь которого содержится в буфере обмена"
      Wscript.Quit
    End Sub
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:31

    Читайте: Справочные материалы по работе c TC + Онлайн справка TC

    23 ноября 2011 - 17:17 / #39
  11. Offline

    Andrey_A

    Пользователь

    Posts: 275

    GoCreateFolder.vbs
    Создание папки и вхождение в неё
    Используется TCMC.exe - файл можете скачать в шапке темы

    ' GoCreateFolder.vbs
    '========================   Описание   =====================================
    ' Создание папки и вхождение в неё
    ' Если такая папка существует, до добавится счётчик. (в пустой панели создаётся "Каталог")
    '=======================   Параметры  =====================================
    ' 1-й параметр: Путь\где\создавать\папку
    ' 2-й параметр: Имя папки
    ' 3-й параметр: любой, если он присутствует, то вхождение в папку происходит на противоположной панели
    '========================   Примеры   =====================================
    ' %p "%O" - Создание папки в ТЕКУЩЕЙ ПАНЕЛИ именем файла под курсором и вхождение в неё
    ' %p "%O" 1 - Создание папки в ТЕКУЩЕЙ ПАНЕЛИ ... и открытие её в СОСЕДНЕЙ ПАНЕЛИ
    ' %t "%O" 1 - Создание папки в СОСЕДНЕЙ ПАНЕЛИ именем файла под курсором и вхождение в неё
    ' %t "%O" - Создание папки в СОСЕДНЕЙ ПАНЕЛИ ... и открытие её в ТЕКУЩЕЙ ПАНЕЛИ
    ' %t "%M" 1 Cоздание папки в СОСЕДНЕЙ ПАНЕЛИ ... с именем файла сосед
    ' %p "Имя моей папки"
    ' "c:\Temp\" "12345"
    ' ...
    ' Автор:             Аверин Андрей
    ' Версия:          1.1 (26.10.2011 - 30.10.2011)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '========================================================================
    Panel = 0
    With WScript
      Cnt = .Arguments.Count
      If Cnt > 0 Then
        Path = .Arguments(0)
        If Cnt > 1 Then
          NameFold = .Arguments(1)
          If Cnt > 2 Then Panel  = 1
        End If
      Else
        MsgBox "Не хватает параметров!" & vbNewLine &_
                         "Должен быть как минимум один параметр %p или %t",_
                         vbOKOnly & vbInformation, "Создание папки и вхождение в неё"
        WScript.Quit
      End If
    End With

    With CreateObject("Scripting.FileSystemObject")
      if NameFold = "" Then NameFold = "Каталог"
      NameFold = .GetBaseName(NameFold)
      if Right(Path, 1) <> "\" Then    Path  = .GetParentFolderName(Path) & "\"

      NewFold = Path & NameFold
      Do While .FolderExists(NewFold)
         n = n+ 1
         NewFold = Path & NameFold & "_" & (n Mod 100)\10 & (n Mod 10)
      Loop
      .CreateFolder(NewFold)
    End With
    WScript.Sleep 300
    If Panel = 0 Then
      NewFold = NewFold & "\" & Chr(34) & Chr(32)  & Chr(34) & Chr(34) & Chr(32)
    Else
      NewFold = Chr(34) & Chr(32) & Chr(34) & NewFold & "\" & Chr(34) & Chr(32)
    End If

    CreateObject("WScript.Shell").Exec("%COMMANDER_PATH%\Utilities\TotalCom\TCMC\TCMC.exe 100" & Chr(32) & "CDS" & Chr(32) & Chr(34) & NewFold)
    Wscript.Quit
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:32

    Читайте: Справочные материалы по работе c TC + Онлайн справка TC

    23 ноября 2011 - 17:21 / #40

Статистика форума, пользователей онлайн: 0 (за последние 30 минут)

---
Создано тем
107
Всего сообщений
4048
Пользователей
99000
Новый участник
termojader