Скрипты для 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

    CopyGroupFileInFolders.vbs
    Копирование выделенных файлов\папок по заданному количеству в отдельные (создаваемые) папки

    ' CopyGroupFileInFolders.vbs
    '========================   Описание   =====================================
    ' Копирование выделенных файлов\папок по заданному количеству в отдельные (создаваемые) папки
    '=======================   Параметры  =====================================
    ' 1-й параметр: файл-список
    ' 2-й параметр: папка\куда\копируются\файлы
    ' 3-й параметр: количество копируемых файлов в каждую папку
    '   если параметр отсутствует или параметр = 0 , то выводится диалог ввода
    '========================   Примеры   =====================================
    ' %L %t 50
    ' %L %p 50
    ' %L %t

    ' Автор:             Batya & Аверин Андрей
    ' Версия:          1.1 (07.09.2010 - 29.10.2011)
    ' Site:                  http://tc-image.3dn.ru
    '========================================================================
    Option Explicit
    '================= Изменяемые параметры =================================
    Const Rank = 3  'Минимальное количество цифр в создаваемых папках
    '========================================================================
    Dim FileList, List, F, Folder, Count, i, n, Path, Cnt, Mess
    Mess = "Копия выделенных файлов по заданному к-ву"
    With WScript
      Cnt = .Arguments.Count
      If Cnt < 2 Then
        MsgBox "Не хватает параметров! Должно быть минимум Два параметра" & vbNewLine &_
        "пример: %L %p", vbOKOnly & vbInformation, Mess
       .Quit
      End If
      FileList = .Arguments(0) : Folder = .Arguments(1)
      If Cnt > 2 Then
        Count = CInt(.Arguments(2))
      Else
        InputNumer
      End If
      If Count <= 0 Then InputNumer
    End With

    With CreateObject("Scripting.FileSystemObject")
      List = Split(.OpenTextFile(FileList).ReadAll, vbNewLine)
      If Right(Folder, 1) <> "\" Then Folder = Folder & "\"
      n = 1 : i = Count

      For Each F In List
        If F <> "" Then
          If i >= Count Then
            If Len(CStr(n)) < Rank Then
              Path = Folder & Right(String(Rank, "0") & CStr(n), Rank) & "\"
            Else
              Path = Folder & CStr(n) & "\"
            End If
            If Not .FolderExists(Path) Then .CreateFolder(Path)
            i = 1 : n = n + 1
          Else
            i = i + 1
          End If
          If .FileExists(F) Then .CopyFile F, Path
          If .FolderExists(F) Then
            If Right(F, 1) = "\" Then F = Left(F, Len(F) - 1)
            .CopyFolder F, Path
          End If
        End If
      Next
    End With
    Wscript.Quit

    Sub InputNumer
       Count = InputBox("Введите ЧИСЛО по СКОЛЬКО" & vbNewLine &_
       "файлов копировать в отдельные папки", Mess, 3)
       If Len(Count) = 0 Then WScript.Quit
       Count = CInt(Count)
       If Count = 0 Then Count = 3
    End Sub
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:22

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

    23 ноября 2011 - 09:09 / #21
  3. Offline

    Andrey_A

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

    Posts: 275

    CopyInEveryOneNameFolder.vbs
    Копирование выделенных файлов каждый в отдельную именную папку

    ' CopyInEveryOneNameFolder.vbs
    '========================   Описание   =============================
    ' Копирование выделенных файлов каждый в отдельную именную папку
    '=======================   Параметры  =============================
    ' {список файлов} {"путь\копирования\"}
    ' %L %p
    ' %L %t
    ' Автор:             Аверин Андрей
    ' Версия:          1.1 (2010 - 29.10.2011
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '================================================================
    If WScript.Arguments.Count > 1 Then
      With CreateObject("Scripting.FileSystemObject")
        Set ListFile = .OpenTextFile(WScript.Arguments(0), 1)
        tPath = WScript.Arguments(1)
        Do While Not ListFile.AtEndOfStream
            SelFile = ListFile.ReadLine :     Name = .GetBaseName(SelFile)
            If Not .FolderExists(tPath & Name) Then .CreateFolder(tPath & Name)
          .CopyFile SelFile, tPath & Name & "\"
        Loop
      End With
      Set ListFile = Nothing
    Else
      MsgBox "Не заданы параметры!" & vbNewLine &_
      "Должно быть ДВА параметра. Пример: %L %t",_
      vbOKOnly + vbInformation, "Копирование файлов каждый в именную папку"
    End If
    WScript.Quit
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:23

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

    23 ноября 2011 - 09:14 / #22
  4. Offline

    Andrey_A

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

    Posts: 275

    CopySelectFilesInFolder.vbs
    Копирование выделенных файлов или из файл списка в создаваемую папку
    ' CopySelectFilesInFolder.vbs
    '========================   Описание   =====================================
    ' Копирование выделенных файлов или из файл списка в создаваемую папку,
    ' если такая папка существует, ей присваивается счётчик _0N
    ' если такой файл существует, при копировании ему так же  присваивается счётчик _0N
    '========================  Параметры =====================================
    ' 1-й параметр: список файлов
    ' 2-й параметр: путь\копирования\
    ' 3-й параметр: "Имя создаваемой папки" (если параметр отсутствует, то имя="Каталог")
    '========================    Примеры    ======================================
    ' %L %p            - копия выделенных файлов в папку "Каталог" в текущей панели
    ' %L %p "%O" - копия выделенных файлов в папку имя под курсором в текущей панели
    ' %L %t            - копия выделенных файлов в папку "Каталог" в соседней панели
    ' %L %t "%O" - копия выделенных файлов в папку имя под курсором в соседней панели
    ' "%%COMMANDER_PATH%%\Files\Lists\MarkerList.txt" %t "Папка"
    ' %P%N %t "Папка" - копия всех файлов из файл списка под курсором в соседнюю панель в "Папку"
    ' (%P%N %t  - очень помогает копирование из M3U листа музыкальных композиций...)

    ' Автор:             Аверин Андрей
    ' Версия:          1.3 (28.09.2010 - 28.10.2011)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '======================================================================
    With WScript
      Cnt = .Arguments.Count
      If Cnt < 2 Then
        MsgBox "Не хватает параметров! Должно быть минимум Два параметра" & vbNewLine &_
        "пример: %L %p", vbOKOnly & vbInformation, "Копия выделенных файлов в создаваемую папку"
       .Quit
      End If
      FF = CreateObject("WScript.Shell").ExpandEnvironmentStrings(.Arguments(0))
    MsgBox "Переменная FF =" & vbNewLine & "<" & FF & ">"
      Path = CreateObject("Shell.Application").NameSpace(.Arguments(1)).Self.Path & "\"
    MsgBox "Переменная Path =" & vbNewLine & "<" & Path & ">"
      If Cnt > 2 Then Name = .Arguments(2)
    MsgBox "Переменная Name =" & vbNewLine & "<" & Name & ">"
    End With

    If Len(Name) = 0 Then Name = "Каталог"
    FPath = Path & Name
    MsgBox "Переменная FPath =" & vbNewLine & "<" & FPath & ">"

    With CreateObject("Scripting.FileSystemObject")
      Do While .FolderExists(FPath)
        i = i + 1 : FPath = Path & Name & Numer(i)
      Loop
      .CreateFolder(FPath)
      Set ListFile = .OpenTextFile(FF, 1)
      Do While Not ListFile.AtEndOfStream
        SelFile = ListFile.ReadLine
        If .FileExists(SelFile) Then
          Path  = .GetParentFolderName(SelFile)
          FName = .GetFileName(SelFile)
          Do While .FileExists(FPath & "\" & FName)
            i = i + 1 : FName = Name & Numer(i)
          Loop
          .CopyFile SelFile, FPath & "\" & FName
        End if
      Loop
    End With
    ListFile.Close : Set ListFile = Nothing : WScript.Quit
    Function Numer(ii) : Numer = "_" & (ii Mod 100)\10 & (ii Mod 10) : End Function
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:23

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

    23 ноября 2011 - 09:18 / #23
  5. Offline

    Andrey_A

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

    Posts: 275

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

    ' CopyTemplateExt.vbs
    '========================   Описание   =====================================
    ' Создание для выделенных файлов "пустых" файлов путём копирования их
    ' из папки с шаблонами Template,  с добавлением счётчика _0N, если таковые уже имеются
    ' + их открытие в программе ассоциированной в ТС
    ' + создание одиночного пустого файла
    ' Предварительно необходимо создать  в папке Template файлы Template.txt , Template.doc ...
    ' Пути в скрипте измените под себя, если это необходимо
    '========================  Параметры =====================================
    ' 1-й параметр: файл список - Первый параметр обязателен!!!
    ' 2-й параметр: путь\куда\копировать\файл
    ' 3-й параметр: расширение копируемого файла
    ' 4-й параметр: новое имя файла
    ' 5-й параметр: любой(означает, что файл надо открыть в программе ассоциированной в ТС
    '========================  Примеры   ======================================
    ' %L                                                    - создание файлов в текущей панели Template.(расширение под курсором)
    ' %L     %t                                        - создание файлов в соседней панели Template.(расширение подкурором)
    ' %L "C:\" "doc"                      - cоздание doc файлов с именем Template.doc
    ' %L "%%WINDIR%%\" "xlsx" "%O" - создание xlsx файлов с именем файла под курсорм
    ' %L %t "txt" "Read_Me"      - создание файлов Read_Me.txt (без открытия)
    ' %L %t "txt" "Read_Me" 1   - создание файлов Read_Me.txt + открытие в ассоциированний программе
    ' %L %p "%E" "" 1                 - открывает вновь созданные файл в текущей панели с именем и расширением файла под курсором
    ' ( выше описанные Параметры не работают в пустой папке\панели из-за %L )
    ' "" "%P" "txt" "%O" 1           - создание одного файла, но работает и в пустой панели
    '=======================   Дополнение   ====================================
    ' Кроме выше описанных примеров можно создавать "пустые" файлы из файл списка
    ' К примеру: Создайте файл Spisok.txt в папке Тотала и пропишите в нём нужный вам список ИМЁН:
    ' File1.txt
    ' File2.doc
    ' File3.vbs
    ' ...
    ' В параметрах: %%COMMANDER_PATH%%\Spisok.txt "%P" "FileList"
    ' т.е. если в 3-й параметр вписать вместо расширения "FileList" то будут создаваться именные пустые файлы
    '==========================================================================
    '
    ' Автор:             Аверин Андрей
    ' Версия:          1.8 (28.10.2010 - 14.11.2011)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '========================  Изменяемые пути  =====================================
    TemplatePath = "%COMMANDER_PATH%\Files\TempLate\" ' папка хранения файлов-шаблонов Temlate.xxx
    FileAss = "%COMMANDER_PATH%\WinAssociations.ini"           ' файл ассоциаций ТС, секция вынесена из Wincmd.ini
    '===========================================================================
    Cnt = WScript.Arguments.Count
    If Cnt = 0 Then
      MsgBox "Не заданы параметры!" & vbNewLine &_
       "Должен быть как минимум один параметр %L",_
        vbOKOnly + vbInformation, "Создание ''пустых'' файлов"
      WScript.Quit
    End If

    Dim WSH, FSO, FPath
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set WSH = WScript.CreateObject("WScript.Shell")
    TemplatePath = GetPath(TemplatePath) : FileAss = GetPath(FileAss)

    If WScript.Arguments(0) = "" Then
         PP ="" :     FCreateFile
         If Cnt > 4 Then RunFileAssociationsTC
      WsEnd
    End If

    Set ListFile = FSO.OpenTextFile(GetPath(WScript.Arguments(0)), 1)
    Do While Not ListFile.AtEndOfStream
        PP = ListFile.ReadLine : FCreateFile
      If Cnt > 4 Then RunFileAssociationsTC
    Loop

    RereadSource
    ListFile.Close : Set ListFile = Nothing : WsEnd

    Function FCreateFile
        If Cnt > 1 Then
          Path = WScript.Arguments(1)
        Else
          Path  = FSO.GetParentFolderName(PP)
        End If

      If Path = "" Then Path = FSO.GetParentFolderName(PP)
      Path = GetPath(Path)
      If Right(Path, 1) <> "\" Then Path = Path & "\"
         If Cnt > 2 Then Ext = WScript.Arguments(2)
      If Ext = "" Then Ext = FSO.GetExtensionName(PP)
      If Ext = "" Then Ext = "txt"

      If Cnt > 3 Then Name = WScript.Arguments(3) Else Name = "Template"
      If Name = "" Then Name = FSO.GetBaseName(PP)
      If Name = "" Then Name = "Template"

      If Cnt > 2 Then
        If UCase(WScript.Arguments(2)) = UCase("FileList") Then
             Ext = FSO.GetExtensionName(PP) : Name = FSO.GetBaseName(PP)
              End If
         End If

         FPath = Path & Name & "." & Ext : ImPath = TemplatePath & "\Template" & "." & Ext

        If Not FSO.FileExists(ImPath) Then
        MsgBox "Файл ''Template." &  Ext & "'' в папке " & vbNewLine &_
        TemplatePath & "    не обнаружен! " & vbNewLine &_
        "Создайте шаблон файла  -  Template.xxx  -  файл с нужным расширением в данной папке!"&_
        "  И будет Вам счастье!" , vbOKOnly & vbInformation, "Создание ''пустых'' файлов"
         WsEnd
      End If

        i = 0
        Do While FSO.FileExists(FPath)
          i = i + 1 : FPath = Path & Name & "_" & (i Mod 100)\10 & (i Mod 10) & "." & Ext
        Loop

      On Error Resume Next
         FSO.CopyFile ImPath, FPath : RereadSource
    End Function

    ' Процедура запуска файла ассоциированной программой в Total Commander
    Sub RunFileAssociationsTC()
      Param = FPath : Ext = UCase("*." & FSO.GetExtensionName(Param) & ";")
      ListAss =  Split(FSO.OpenTextFile(FileAss).ReadAll, vbNewLine)
      For i = 0 To Ubound(ListAss)
          If Len(ListAss(i)) > 0 Then
            If  InStr(1,ListAss(i),"|") > 1 Then
                Stroka = UCase(Left(ListAss(i), InStr(1,ListAss(i),"|")))
            Else
                Stroka = UCase(ListAss(i))
            End If
            If InStr(1,Stroka,Ext) > 1 Then  ' Ищем номер строки и затем ассоциированную программу
              la = ListAss(i + 1) : Program = Mid(la, InStr(1, la, Chr(34)) + 2 , Len(la) - InStr(1, la, Chr(34)) - 8) : Exit For
          End If
        End If
      Next
      WSH.Run Chr(34) & GetPath(Program) & Chr(34) & Chr(32) & Chr(34) & GetPath(Param) & Chr(34) ,Okno , FileRun
    End Sub

    Function GetPath(pPath) : GetPath = WSH.ExpandEnvironmentStrings(pPath) : End Function
    Sub RereadSource : WSH.Exec("%COMMANDER_PATH%\Utilities\TotalCom\TCMC\TCMC.exe 100 CM540") : End Sub
    Sub WsEnd : Set WSH = Nothing : Set FSO = Nothing : WScript.Quit : End Sub
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:24

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

    23 ноября 2011 - 09:24 / #24
  6. Offline

    Andrey_A

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

    Posts: 275

    M3u-Skaner.vbs
    Проверка путей файлов (mp3, wma) в выделенных M3U листах

    ' M3u-Skaner.vbs
    '========================   Описание   =====================================
    ' Проверка путей файлов (mp3, wma) в выделенных M3U листах
    '=======================   Параметры  =====================================
    ' 1-й параметр: Список .M3U файлов
    ' 2-й параметр: Папка музыкальной библиотеки
    ' 3-й параметр:
    '    0 - Проверяет M3U файлы (по умолчанию)
    '    1 - Обновляет или создаёт файл-список из всех треков музыкальной библиотеки
    '    2 - Обновляет файл-список всех треков библиотеки + Проверяет M3U файлы
    '    3 - Открывает файл-список всех треков музыкальной библиотеки в редакторе
    '========================   Примеры   =====================================
    ' %L "d:\Музыка"    - Проверка M3U файлов
    ' %L "d:\Музыка" 1 - Обновить или создать файл-список из всей музыкальной библиотеки
    '====================   Как работает скрипт   ================================
    ' Создаётся список всех треков музыкальных файлов из заданной папки
    ' Сравниваются имена из M3U листов с созданным списком
    ' Существующий M3U копируется в M3U.bak,
    ' на его месте создаётся новый .M3U лист из найденных в списке имён.
    ' Не найденные имена треков записываются в файл M3U.not
    ' (время создании списка зависит от к-ва композиций, в моей ~50000 - создаётся несколько минут)
    ' Автор:             Аверин Андрей
    ' Версия:          1.5 (28.04.2011 - 14.11.2011)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '========================================================================

    Cnt = WScript.Arguments.Count
    If Cnt < 1 Then
      MsgBox "Не хватает параметров!!!", vbOKOnly & vbCritical, "Проверка путей mp3 файлов"
      WScript.Quit
    Else
    '====================   Изменяемые пути   ==================================
    Program = "%COMMANDER_PATH%\AkelPad.exe" ' текстовый редактор
    FileListMus = "%COMMANDER_PATH%\Files\Lists\MusicList\MusicList.txt" ' файл-список всех треков музыкальной библиотеки
    IncorrectNameArtistsRu = "%COMMANDER_PATH%\Files\Lists\MusicList\IncorrectNameArtistsRu.txt"
    IncorrectNameArtistsEn = "%COMMANDER_PATH%\Files\Lists\MusicList\IncorrectNameArtistsEn.txt"
    FullNameArtiists = "%COMMANDER_PATH%\Files\Lists\MusicList\FullNameArtiists.txt"
    FuncPlus = "%COMMANDER_PATH%\Scripts\Include\FunctionsPlus.vbs"  ' файл с дополнительными функциями
    '========================================================================
      Dim FSO
      Set FSO = CreateObject("Scripting.FileSystemObject")
      Execute FSO.OpenTextFile(GetPath(FuncPlus)).ReadAll ' добавление функций из файла
      mListFile = GetPath(FileListMus) : pMusic = GetPath(WScript.Arguments(1))
      nCount = 0
      If Cnt > 2 Then nCount = WScript.Arguments(2)
      If Cnt = 0 Or Cnt = 2 Then
        FindStr = Array("mptri.net"," new."," - Zzzz","Www.Notamusic.Net","Www.Foxplay.Biz","mp3ostrov.com","Mp3wall.Ru","[Www.Djpypsik.Jino-Net.Ru]","(Mp3ex.Net)","!!!","!!","(Www.Primemusic.Ru)"," hes "," ant "," dont ","Mcs'","Instr.","&&","& &","-.","»","«"," -.","dj.","Pres.","Caucasus.Net","Www.Mp3s.Su","Smotra.RuWap.Kengu.Ru","Muslimusic.Net","(Malinki.Ru)","(Www.Mp3sfinder.Com)","(Tutfree.Ru)","(Www.Pctrecords.Com)","(Zvukoff.Ru)"," !","D.J.","Феат.","Www.Russianrap.Info","djs","(Muzofon.Com)","#","''"," , ","mr..","mr.","mr","_","Rmx","Dr.","- -","Didj ","-and-"," and ","Dj","  's"," 's","- ","..."," -","----","---","--","vsdj"," vs.."," vs."," vs ","&"," ft..","ft."," ft ",",","`","~","Feat..","Feat."," Feat ","(",")","––","–","    ","   ","  "," .","+","[","]","modj o","gadj o",")..","w & w","- Remix","( Feat"," )","( ",". mp3","Mcs","vs. e ","a - via ","–","(& "," ()",".agr."," its "," mr. "," Prod.)",")(",") ("," im ","Pri Uchastii","Pri Uch"," - blap.","Dj ’s","feat. "," При Участии ",", "," ft. "," pres "," pres. "," present "," feat "," vs "," vs. ","ft. ","vs. "," ft ","(vs ",";","уч.", "’", "feat", " Vs. ", "Ремикс", "Ремих")
        NewStr = Array("",".","","","","","","","","","",""," he's "," an't "," don't "," Mc's ","Instrumental"," & "," & ",".","'","'",".","Dj"," Pres. ","","","","","","","","","","!","Dj","&","","Dj's","","","'",", "," mr. ","mr "," mr. "," ","Remix","Dr. "," - ","Dj "," & "," & ","Dj ","'s ","'s "," - ","... "," - ","-","-","-"," & Dj "," & "," & "," & "," & "," & "," & "," & ",", ","'",""," & "," & "," & "," (",") ","-","-"," "," "," ",".","&","(",")","modjo","gadjo",").","w&w","Remix","(&",")","(",".mp3","Mc's","vse ","a-via ","-","(","","."," it's ","mr. ",")"," & "," & "," i'm ","&","&",".","Dj's","& "," & "," & "," & "," & "," & "," & "," & "," & "," & ","& ","& "," & ","(& "," &","&","'", " ", " & ", "Remix", "Remix")
      End If
      Select Case nCount
        Case 0 Call ScanerM3u
        Case 1 Call CreateMusicList(mListFile, pMusic)
        Case 2 Call CreateMusicList(mListFile, pMusic) : Call ScanerM3u
        Case 3
          CreateObject("WScript.Shell").Run Chr(34) & GetPath(Program) & Chr(34) & Chr(32) & Chr(34) & mListFile & Chr(34)
          Call WsEnd
      End Select
    End If

    WsEnd

    Sub ScanerM3u
      If Not FSO.FileExists(mListFile) Then CreateMusicList
      On Error Resume Next
      Text = FSO.OpenTextFile(mListFile, 1).ReadAll
      If InStr(Text, vbNewLine) = 0 Then Text = FSO.OpenTextFile(mListFile, 1, False, -1).ReadAll
      Set ListFile = FSO.OpenTextFile(GetPath(WScript.Arguments(0)), 1)
      Do While Not ListFile.AtEndOfStream
        noName = "" : noText = "" : mText = "" : m3uFile = ListFile.ReadLine
        If LCase(FSO.GetExtensionName(m3uFile)) = "m3u" Then
          m3uText = FSO.OpenTextFile(m3uFile).ReadAll
          m3uText = RegExpReplace(m3uText, "(\n)(#extinf)(.*)(\n)", "$1", 0, 1, 1)
          List = Split(m3uText, vbNewLine) : List = DelDublicateArr(List)
          For i = 0 To Ubound(List)
            If InStr(List(i), ":\") > 0 Or InStr(List(i), ".") > 0 Then
              If FSO.FileExists(List(i)) Then
                mText = mText & List(i) & vbNewLine
              Else
                NameExt = FSO.GetFileName(List(i)) : inNe = InStr(LCase(Text), LCase(NameExt))
                If inNe > 0 Then
                  LeftText = Left(Text, inNe - 1)
                  NewPath = Mid(LeftText, InStrRev(LeftText, vbNewLine) + 2) & NameExt
                  mText = mText & NewPath & vbNewLine
                Else
                  NameExt = RegExpReplace(NameExt, "^[\d]*", "", 0, 1, 1) ' удаление начальных цифр в треках
                  NameExt = Trim(RegExpReplace(NameExt, "^[-. !;:,#№&@*_+='~`%$^()[]*", "", 0, 1, 1)) ' удаление мусора в начале треков
                  inNe = InStr(LCase(Text), LCase(NameExt))
                  If inNe > 0 Then
                    LeftText = Left(Text, inNe - 1)
                    NewPath = Mid(LeftText, InStrRev(LeftText, vbNewLine) + 2) & NameExt
                    mText = mText & NewPath & vbNewLine
                  Else
                    noText = noText & List(i) & vbNewLine : noName = noName & NameExt & vbNewLine
                  End If
                End If
              End If
            End If
          Next
        End If
    ' исправление названий треков
        If Len(noText) > 0 Then
          nText = noText : noText = "" : nName = noName : noName = ""
          For i = 0 To Ubound(FindStr)
            nName = Replace(nName, FindStr(i), NewStr(i))
          Next
          nTxt = Split(nText, vbNewLine) : nNm = Split(nName, vbNewLine)

          For i = 0 To Ubound(nNm)
            NameExt = nNm(i) : inNe = InStr(LCase(Text), LCase(NameExt))
            If inNe > 0 Then
              LeftText = Left(Text, inNe - 1)
              NewPath = Mid(LeftText, InStrRev(LeftText, vbNewLine) + 2) & NameExt
              mText = mText & NewPath & vbNewLine
            Else
              inn = InStr(NameExt, " - ")
              If inn > 0 Then
                Lef = Left(NameExt, inn - 1)
                Lef = RegExpReplace(Lef, " и ", " & ", 0, 1, 1)
                Lef = RegExpReplace(Lef, " i ", " & ", 0, 1, 1)
                NameExt = Lef & Mid(NameExt, inn)
                inNe = InStr(LCase(Text), LCase(NameExt))
                If inNe > 0 Then
                  LeftText = Left(Text, inNe - 1)
                  NewPath = Mid(LeftText, InStrRev(LeftText, vbNewLine) + 2) & NameExt
                  mText = mText & NewPath & vbNewLine
                Else
                  noText = noText & nTxt(i) & vbNewLine
                  noName = noName & NameExt & vbNewLine
                End If
              End If
            End If
          Next
        End If
    ' исправление имён артистов
        If Len(noText) > 0 Then
          nText = noText : noText = "" : nName = noName : noName = ""
          nName = SearchAndReplaceFileList(nName, IncorrectNameArtistsRu)
          nName = SearchAndReplaceFileList(nName, IncorrectNameArtistsEn)
          nTxt = Split(nText, vbNewLine) : nNm = Split(nName, vbNewLine)

          For i = 0 To Ubound(nNm)
            NameExt = nNm(i) : inNe = InStr(LCase(Text), LCase(NameExt))
            If inNe > 0 Then
              LeftText = Left(Text, inNe - 1)
              NewPath = Mid(LeftText, InStrRev(LeftText, vbNewLine) + 2) & NameExt
              mText = mText & NewPath & vbNewLine
            Else
              inn = InStr(NameExt, " - ")
              If inn > 0 Then
                Lef = Left(NameExt, inn - 1) : sp = InStr(Lef, Chr(32))
                If sp = 0 Then
                  Lef = Lef & Chr(32)
                  Lef = SearchAndReplaceFileList(Lef, FullNameArtiists)
                  NameExt = Lef & Mid(NameExt, inn + 1)
                  inNe = InStr(LCase(Text), LCase(NameExt))
                  If inNe > 0 Then
                    LeftText = Left(Text, inNe - 1)
                    NewPath = Mid(LeftText, InStrRev(LeftText, vbNewLine) + 2) & NameExt
                    mText = mText & NewPath & vbNewLine
                  Else
                    noText = noText & nTxt(i) & vbNewLine : noName = noName & NameExt & vbNewLine
                  End If
                End If
              End If
            End If
          Next
        End If

        mText = Join(DelDublicateArr(Split(mText, vbNewLine)), vbNewLine)
        FSO.CopyFile m3uFile, m3uFile & ".bak"
        FSO.OpenTextFile(m3uFile, 2).Write mText
        FSO.CreateTextFile(m3uFile & ".not").Write noText
        FSO.CreateTextFile(m3uFile & "_Name.not").Write noName
      Loop
      Set ListFile = Nothing : Call WsEnd
    End Sub

    Function GetPath(pPath) : GetPath = CreateObject("WScript.Shell").ExpandEnvironmentStrings(pPath) : End Function
    Sub WsEnd : Set FSO = Nothing : WScript.Quit : End Sub


    пример FullNameArtiists.txt
    пример IncorrectNameArtistsEn.txt
    пример IncorrectNameArtistsRu.txt
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:25

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

    23 ноября 2011 - 14:36 / #25
  7. Offline

    Andrey_A

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

    Posts: 275

    CreateFileAllCmdTC.vbs
    Создание общего файла с пользовательскими и встроенными командами Total Commander
    Используются FunctionsPlus.vbs и FunctionsINIRWS.vbs - файлы можете скачать в шапке темы

    ' CreateFileAllCmdTC.vbs
    '========================   Описание   =====================================
    ' Создание общего файла с пользовательскими и встроенными командами Total Commander
    '=======================  Дополнение  =====================================
    ' Используются FunctionsPlus.vbs и FunctionsINIRWS.vbs
    '========================================================================
    ' Автор:             Аверин Андрей
    ' Версия:          1.2 (25.06.2011 - 25.10.2011)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '====================   Изменяемые пути   ===================================
    TC = CreateObject("WScript.Shell").ExpandEnvironmentStrings("%COMMANDER_PATH%")
    ComFile = TC & "\Files\Help\TCInfo\Commands.tcinfo"' файл для записи всех команд
    UserComm1 = TC & "\UserCmd.ini" ' файл пользовательских команд
    UserComm2 = TC & "\Language\Wcmd_Rus.ini" ' файл пользовательских команд 2
    TComands = TC & "\TOTALCMD.INC" ' файл встроенных команд Total Commander'a
    TComlng = TC & "\Language\Wcmd_Rus.inc" ' файл перевода встроенных команд Total Commander'a
    Wcmicons = TC & "\Wcmicons.inc" ' файл сопоставления значков Total Commander'a
    Wincmd = TC & "\Wincmd.ini" ' главный файл конфигурации Total Commander'a
    FuncPlus = TC & "\Scripts\Include\FunctionsPlus.vbs"  ' файл с дополнительными функциями
    INI = TC & "\Scripts\Include\FunctionsINIRWS.vbs" ' файл с функциями чтения\записи Ini файлов
    '========================================================================
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FileExists(UserComm2) Then Text = FSO.OpenTextFile(UserComm2).ReadAll
    If FSO.FileExists(UserComm1) Then Text = Text & vbNewLine & FSO.OpenTextFile(UserComm1).ReadAll
    If FSO.FileExists(TComlng) Then Wcmd = FSO.OpenTextFile(TComlng).ReadAll
    If FSO.FileExists(Wcmicons) Then Wcic = FSO.OpenTextFile(Wcmicons).ReadAll
    If FSO.FileExists(TComands) Then Txt = Split(FSO.OpenTextFile(TComands).ReadAll, vbNewLine)

    For i = 0 To Ubound(Txt)
      button = ""
      nn = InStr(Txt(i), "=")
      If Len(Txt(i)) > 0 And nn > 0 And InStr(Txt(i), "-1111111") = 0 And InStr(Txt(i), "[") = 0 Then
        cmd = Left(Txt(i),InStr(Txt(i), "=") - 1)
        num = Mid(Txt(i), nn + 1, InStr(Txt(i), ";") - nn - 1)
        menueng = Trim(Mid(Txt(i), InStr(Txt(i), ";") + 1))
        stbb = vbNewLine & num & "="
        bb = InStr(Wcic, stbb)
        If bb > 0 Then
          lbut = Mid(Wcic, bb + Len(stbb))
          button = Left(lbut, InStr(lbut, vbNewLine) - 1)
        End If
        wText = wText & "[" & cmd & "]" & vbNewLine &_
                    "numcmd=" & num & vbNewLine &_
                    "hex=" & "$" & Hex(num) & vbNewLine &_
                    "menu=" & WcmdInc(num) & vbNewLine &_
                    "menueng=" & Chr(34) & menueng & Chr(34) & vbNewLine &_
                    "button=" & button & vbNewLine
      End If
    Next

    Execute FSO.OpenTextFile(FuncPlus).ReadAll
    Execute FSO.OpenTextFile(INI).ReadAll

    Text = Text & vbNewLine & wText
    Text = RegExpReplace(Text, "(" & vbNewLine & ")+", "$1",0, 1, 1)
    Text = RegExpReplace(Text, ".*=" & vbNewLine, "",0, 1, 1)

    Call ArrHotkey(ReadINISection(Wincmd, "Shortcuts"), "")
    Call ArrHotkey(ReadINISection(Wincmd, "ShortcutsWin"), "Win + ")
    Call FSO.CreateTextFile(ComFile, True).Write(Text)

    Set FSO = Nothing : WScript.Quit

    ' считает секции [Shortcuts] и [ShortcutsWin] из Wincmd.ini
    ' и записывает в файл ComFile командам соответствующие горячие клавиши
    Sub ArrHotkey(arrText, Insert)
      aTxt = Split(arrText, vbNewLine)
      For i = 0 To Ubound(aTxt)
        nn = InStr(aTxt(i), "=")
        If Len(aTxt(i)) > 0 And nn > 0 Then
          hot = Left(aTxt(i), nn - 1)
          hot = Replace(hot, "CSA+", "Ctrl + Shift + Alt + ")
          hot = Replace(hot, "AS+", "Alt + Shift +")
          hot = Replace(hot, "CA+", "Ctrl + Alt + ")
          hot = Replace(hot, "CS+", "Ctrl + Shift + ")
          hot = Replace(hot, "A+", "Alt + ")
          hot = Replace(hot, "S+", "Shift + ")
          hot = Replace(hot, "C+", "Ctrl + ")
          hot = Replace(hot, "CAlt", "Ctrl + Alt")
          hot = Insert & hot
          hcmd = Mid(aTxt(i), nn + 1)
          Text = RegExpReplace(Text, "(" & hcmd & ")(\])((.*\n)+?)(\[)", "$1$2$3hotkey=" & hot & vbNewLine & "[",0, 1, 1)
        End If
      Next
    End Sub

    ' счтитывает из Wcmd_Rus.inc -  возвращает русский перевод команды по вхождённому номеру команды
    Function WcmdInc(Number)
      nnStr = vbNewLine & Number & "="
      If InStr(Wcmd, nnStr) > 0 Then
        ttt = Mid(Wcmd, InStr(Wcmd, nnStr) + Len(nnStr))
        WcmdInc = Left(ttt, InStr(ttt, vbNewLine))
      Else
        WcmdInc = ""
      End If
    End Function
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:25

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

    23 ноября 2011 - 15:30 / #26
  8. Offline

    Andrey_A

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

    Posts: 275

    InfoPluginsTC.vbs
    Полная информация о встроенных плагинах Total Commander'a

    ' InfoPluginsTC.vbs
    '========================   Описание   =====================================
    ' Полная информация о встроенных плагинах Total Commander'a
    '
    ' Автор:             Аверин Андрей
    ' Версия:          1.1 (15.08.2011 - 16.01.2012)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '========================================================================
    Dim FSO, WSH
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set WSH = CreateObject("WScript.Shell")
    Insert = ""
    Plug = Array("WCX", "WDX", "WFX", "WLX")
    '====================   Изменяемые пути   ===================================
    FilePlug = GetPath("%COMMANDER_PATH%\Files\Help\TCInfo\AllPlugins.tcinfo") ' файл для записи информации о плагинах
    Program = GetPath("%COMMANDER_PATH%\AkelPad.exe") ' текстовый редактор
    '=========================================================================
    For i = 0 To Ubound(Plug)
      cn = 0 : Wxx = Plug(i)
      Text = Text & Insert & String(46, "=") & Chr(32) & Wxx & " Плагины " & String(46, "=") & vbNewLine &_
                  "Имя                      Версия                     Путь                                            Комментарии" & vbNewLine &_
                   String(105, "=") & vbNewLine
      Selected = GetPath("%COMMANDER_PATH%\Plugins\" & Wxx)
      desPaht = Selected & "\descript.ion"
      If FSO.FileExists(desPaht) Then
        On Error Resume Next
        dText = FSO.OpenTextFile(desPaht).ReadAll
        If Len(dText) > 0 Then cn = 1
      End If
      If FSO.FolderExists(Selected) Then
        Set CurrFolder = FSO.GetFolder(Selected)
        FolderProcess(CurrFolder)
      End If
      Insert = vbNewLine
    Next

    Call FSO.OpenTextFile(FilePlug, 2, True).Write(Text)
    WSH.Run Chr(34) & Program & Chr(34) & Chr(32) & Chr(34) & FilePlug & Chr(34)

    Set CurrFolder = Nothing : Set FSO = Nothing : Set WSH = Nothing : WScript.Quit

    ' сканирует все файлы в папках и подпапках, извлекается необходимая информация
    Sub FolderProcess(CurrFolder)
      For Each sf in CurrFolder.SubFolders
        FolderProcess(sf)
      Next
      For Each f in CurrFolder.Files
        File = f.Path
        If Wxx = UCase(FSO.GetExtensionName(File)) Then
          plFile = Replace(File, GetPath("%COMMANDER_PATH%\"), "")
          'plFile = Replace(File, GetPath("%COMMANDER_PATH%"), "%COMMANDER_PATH%")
          On Error Resume Next
          NameExt = FSO.GetFileName(File) : Version = FSO.GetFileVersion(File)
          pName = Replace(FSO.GetParentFolderName(File), FSO.GetParentFolderName(FSO.GetParentFolderName(File)), "")
          pName = Mid(pName, 2) : InfDes = DescriptInfo(pName)
          Text = Text & NameExt & Space(25 - Len(NameExt)) &_
                                    Version & Space(10 - Len(Version)) &_
                                    plFile & Space(50 - Len(plFile)) &_
                                    InfDes & vbNewLine
        End If
      Next
    End Sub

    ' возвращает комментарий для имени
    Function DescriptInfo(dName)
      DescriptInfo = "---"
      ind = InStr(LCase(dText), LCase(dName))
      If ind > 0 Then
        dsText = Mid(dText, ind + Len(dName) + 1)
        vbn = InStr(dsText, vbNewLine)
        If vbn > 0 Then dsText = Left(dsText, vbn - 1)
          dsText = Replace(dsText, "\nВ", "")
          dsText = Replace(dsText, "В", "")
          dsText = Trim(Replace(dsText, "\n", Chr(32)))
          If Left(dsText, 1) = "'" Then dsText = Trim(Mid(dsText, 2))
          dsText = Replace(dsText, "' ", "")
      End If
      DescriptInfo = dsText
    End Function

    ' Возвращает полный путь для заданного относительного пути
    Function GetPath(pPath) : GetPath = WSH.ExpandEnvironmentStrings(pPath) : End Function
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:26

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

    23 ноября 2011 - 15:33 / #27
  9. Offline

    Andrey_A

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

    Posts: 275

    MakePlayLists.vbs
    Создает M3U в текущей и в каждой в нее вложенной папке, если найдет в них файлы MP3 или WMA

    ' MakePlayLists.vbs
    '========================   Описание   =====================================
    ' Создает M3U в текущей и в каждой в нее вложенной папке, если найдет в них файлы MP3 или WMA
    '=======================   Параметры  =====================================
    ' 1-й параметр: папка\с\музыкальными\файлами
    ' 2-й параметр: любой, если он присутствует, то плейлисты будут созданы с полными путями
    '========================   Примеры   =====================================
    ' "%p"     - создаются плейлисты с именами
    ' "%p" 1  - создаются плейлисты с полными путями

    ' Автор:             Volniy & Аверин Андрей
    ' Версия:          1.1 (2004 - 25.10.2011)
    ' Site:                  http://tc-image.3dn.ru
    '=======================================================================
    Option Explicit
    Dim FSO, Cnt, CntF, NP
    Set FSO = CreateObject("Scripting.FileSystemObject")

    If FSO.FolderExists(WScript.Arguments(0)) = False Then
       MsgBox "Указана неверная директория!", vbCritical, "Ошибка"
    Else
       Call ScanFolderForMP3(FSO.GetFolder(WScript.Arguments(0)))
       MsgBox Cnt & " плейлист(а,ов) с " & CntF &  " файлами создано.", vbInformation, "Завершено"
    End If

    Set FSO = Nothing : WScript.Quit

    Sub ScanFolderForMP3(curFolder)
      Dim SF
      For Each SF In curFolder.SubFolders
        ScanFolderForMP3 SF
      Next
      Call MakeM3U(curFolder)
    End Sub

    Sub MakeM3U(curFolder)
      Dim F, List, m3uFile, fExt
      On Error Resume Next
      For Each F In curFolder.Files
        fExt = UCase(FSO.GetExtensionName(F.Name))
        If fExt = "MP3" Or fExt = "WMA" Then
          If WScript.Arguments.Count > 1 Then
            NP = F.Path
          Else
            NP = F.Name
          End If
          List = List & NP & vbCrLf : CntF = CntF + 1
        End If
      Next
      If Len(List) Then
        Set F = curFolder.CreateTextFile(curFolder.Name & ".m3u", True)
            F.Write List : F.Close: Cnt = Cnt + 1
      End If
    End Sub
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:26

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

    23 ноября 2011 - 15:35 / #28
  10. Offline

    Andrey_A

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

    Posts: 275

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

    ' MakePlayListsAll.vbs
    '========================   Описание   =====================================
    ' Создание плейлиста всех музыкальных треков в папке и подпапках
    '========================  Параметры =====================================
    ' 1-й параметр: Папка\с\треками
    ' 2-й параметр: Куда\сохранять\список
    '========================   Примеры   =====================================
    ' %P%N %t%O.m3u - создать в соседней панели плейлист M3U всех треков в папки под курсором
    ' Автор:             Аверин Андрей
    ' Версия:          1.0 (24.10.2011)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '====================   Изменяемые пути   ===================================
    FuncPlus = "%COMMANDER_PATH%\Scripts\Include\FunctionsPlus.vbs"  ' файл с дополнительными функциями
    '========================================================================
    With WScript
      Cnt = .Arguments.Count
      If Cnt > 1 Then
        Set FSO = CreateObject("Scripting.FileSystemObject")
        pMusic = .Arguments(0) : mFile = .Arguments(1)
        Execute FSO.OpenTextFile(CreateObject("WScript.Shell").ExpandEnvironmentStrings(FuncPlus)).ReadAll ' добавление функций из файла
        Call CreateMusicList(mFile, pMusic)
        Set FSO = Nothing : WScript.Quit
      End If
    End With
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:26

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

    23 ноября 2011 - 15:48 / #29
  11. Offline

    Andrey_A

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

    Posts: 275

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

    ' SpisokHtml.vbs
    '========================   Описание   =============
    ' Создание списка файлов в html формате
    '=======================   Параметры  =============
    ' 1-й параметр: список файлов
    ' 2-й параметр: путь сохранения
    ' 3-й параметр: текст до
    ' 4-й параметр: текст после
    '========================   Примеры   =============
    ' %UL %t   - Создать HTML список ИМЁН выделенного..
    ' %UF %t   - Создать HTML список ПУТЕЙ выделенного...
    ' Автор:             Аверин Андрей
    ' Версия:          1.1 (2010 - 23.11.2011)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '================================================
    With WScript
      Cnt = .Arguments.Count
      If Cnt < 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
    Line = "<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</h1>" & vbNewLine &_
                "<hr />" & vbNewLine &_
                "<ol>" & vbNewLine
    Do Until ts.AtEndOfStream
      Line = Line & "    <li>" & Text1 & ts.ReadLine & Text2 & "</li>" & vbNewLine
    Loop

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

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

    23 ноября 2011 - 16:32 / #30

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

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