Скрипты для 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 -
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 -
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 & " " & ts.ReadLine & " " & 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 -
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 -
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 -
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 -
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 -
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 -
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 -
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 -
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
Powered by Bullet Energy Forum