Скрипты для Total Commander
-
Скрипты - уникальный инструмент для достижения различных целей в работе с файлами и не только, особенно в файловом менеджере, даже если вы раньше об этом ничего не слышали и не знали, то путём простых движений вы можете оптимизировать свои действия
Тема тестирования скриптов создана для увеличения функциональности Total Commander
Всё это делается для тех, кто хочет экономить время и автоматизировать работу
Огромное спасибо участникам, авторам и всем повлиявшим на тему
#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#
В этой теме Каждый может выложить свой скрипт, написанный на любом языке: vbs, js, hta, au3,ahk, bat,cmd... - главное, чтобы он относился как-то к Total Commander, можно было им воспользоваться и к нему было должное описание к применению.
#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#
В теме "Тестирование и заказ скриптов" Каждый может протестировать, дать свой комментарий (все комментарии из этой темы будут удаляться)...если есть интересная идея, вы так же можете поделиться ей в соседней теме и заказать скрипт, а вдруг она покажется интересной для авторов...
#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#Сообщение отредактировал LonerD 25 апреля 2017 - 04:38Читайте: Справочные материалы по работе c TC + Онлайн справка TC
22 ноября 2011 - 13:03 / #1 -
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 -
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 -
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 -
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 -
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 -
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 -
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 -
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 -
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 -
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
Powered by Bullet Energy Forum