' CopyAllInPanelN.vbs
'========================   Описание   =====================================
' Копирование выделенных файлов\папок в ту же панель с добавлением счётчика
'=======================   Параметры  =====================================
' 1-й параметр: файл-список
' 2-й параметр: минимальное количество цифр номера добавляемое к имени, если таковое уже есть в панели
'     - без параметра будет добавляться: имя_1, имя_2, _3, _4   
'     - при 2 - имя_01, имя_02, _03, _04   
'     - при 3 - имя_001, имя_002 .....
'========================   Примеры   =====================================
' %L   
' %L 2

' Автор:             Аверин Андрей
' Версия:          1.1 (2010 - 28.10.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'======================================================================
Option Explicit
Dim ListFile, SelFile, Name, Ext, Path, FPath, Rank, Delim, n, Num

If WScript.Arguments.Count = 0 Then
    MsgBox "Не заданы параметры!", vbOKOnly + vbCritical, "Копирование"
    WScript.Quit
End If

If WScript.Arguments.Count > 1 Then
    Rank = WScript.Arguments(1)
Else
    Rank = 1
End If
Delim = "_" ' если не нужен замените на Delim = ""

With CreateObject("Scripting.FileSystemObject")
    Set ListFile = .OpenTextFile(WScript.Arguments(0), 1)
    Do While Not ListFile.AtEndOfStream
      SelFile = ListFile.ReadLine
      Path = .GetParentFolderName(SelFile) & "\"
      Name = .GetBaseName(SelFile)
      Ext = .GetExtensionName(SelFile)
      FPath = Path
      
      Do
        n = n + 1
        If n < 10^Rank Then
          Num = Right(String(Rank, "0") & n, Rank)
        Else
          Num = n
        End If
        FPath = Path & Name & Delim & Num & "." & Ext
      Loop While (.FileExists(FPath) Or .FolderExists(FPath))
      
      If .FileExists(SelFile) Then .CopyFile SelFile, FPath
      If .FolderExists(SelFile) Then .CopyFolder Left(SelFile, Len(SelFile) - 1), FPath
    Loop
End With

ListFile.Close : Set ListFile = Nothing
WScript.Quit

' ReplaceTextAss.vbs
'========================   Описание   =====================================
' Быстрое добавление файла в ассоциации ТС + вызов окна ассоциаций TC + ENTER (обновление)
' Заменяет FilterN= на FilterN=Имя или расширение в файле ассоциаций
'=======================   Параметры  =====================================
' 1-й параметр: файл, где прописаны ассоциации
' 2-й параметр: текст для поиска (FilterN=)
' 3-й параметр: текст для замены (FilterN=;%N)
'========================   Примеры   =====================================
' "%%COMMANDER_PATH%%\WinAssociations.ini" "Filter5=" "Filter5=;*.%E"     - Добавление РАСШИРЕНИЯ под курсором в Filter_5
' "%%COMMANDER_PATH%%\Wincmd.ini" "Filter5=" "Filter5=;%N"          - Добавление ИМЕНИ под курсором в Filter_5

' Автор:             Аверин Андрей
' Версия:          1.1 (2010 - 28.10.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'========================================================================
Option Explicit
Dim F, Str1, Str2, Text

With WScript
   If .Arguments.Count < 3 Then
     MsgBox "Не хватает параметров!!!", vbOKOnly & vbInformation,_
     "Добавление файла в ассоциации" : .Quit
   End If
   F = .Arguments(0) : Str1 = .Arguments(1) : Str2 = .Arguments(2)
End With

With CreateObject("Scripting.FileSystemObject")
   F = .GetAbsolutePathName(CreateObject("WScript.Shell").ExpandEnvironmentStrings(F))
   Text = .OpenTextFile(F, 1).ReadAll
   Text = Replace(Text, Str1, Str2, 1, -1, 1)
   .OpenTextFile(F, 2).Write Text
End With

With CreateObject("WScript.Shell")
   WScript.Sleep 100
   .Exec("%COMMANDER_PATH%\Utilities\TotalCom\TCMC\TCMC.exe 150 CM519")
   WScript.Sleep 100 : .SendKeys "{Enter}" : WScript.Quit
End With

' BigFilesCopyInBigFolders.vbs
'========================   Описание   =====================================
' Копирование любого количества файлов и папок в любое количество папок.
' В параметры %L
'====================   Как работает скрипт   ================================
' 1. Выделяем объекты (файлы, папки) "что копировать", жмем кнопку.
' 2. Далее выделяем папки "куда копировать", жмем кнопку.
' Если при выделении папок "куда копировать" ничего не выделено,
' скрипт прекращает работу. Или если при выделении папок
' "куда копировать" выделены файлы, то они игнорируются.
' Автор:             jehaz & Аверин Андрей
' Версия:          1.1 (16.08.2007 - 28.10.2011)
' Site:                  http://tc-image.3dn.ru
'========================================================================
Option Explicit
Dim Tempdir, PathTempFile, FolderList, FileList, MsgFoldersStr, MsgFileText, MsgFolders
Dim Argument, MsgFoldersText, StrFolder, StrFiles, CopyFileName, MsgFileStr
Dim Lenstr, LastChar, Result, TextStreamFL, TextStream

With CreateObject("Scripting.FileSystemObject")
   If WScript.Arguments.Count>0 Then
     Argument = WScript.Arguments(0)
     Tempdir = CreateObject("WScript.Shell").Environment("Process")("TEMP")
     PathTempFile = Tempdir & "\FileListTemp.txt"
     If .FileExists(PathTempFile) then
       Set FolderList = .GetFile(Argument) : Set FileList = .GetFile(PathTempFile)
       Set TextStream = FolderList.OpenAsTextStream(1)
       MsgFoldersStr = vbNullString : MsgFoldersText = vbNullString
       While Not TextStream.AtEndOfStream
         MsgFoldersStr = TextStream.ReadLine()
         If .FolderExists(MsgFoldersStr) Then MsgFoldersText = MsgFoldersText & MsgFoldersStr & vbCrLf
       Wend
       TextStream.Close
       Set MsgFileStr = FileList.OpenAsTextStream(1)
       MsgFileText = MsgFileStr.ReadAll()
       If MsgFoldersText <> "" then
         Result = MsgBox("Будем копировать?" & vbCrLf & "объекты:"_
         & vbCrLf & MsgFileText & vbCrLf & "в папки:" & vbCrLf & _
         MsgFoldersText, vbYesNo+vbQuestion, "Внимание!")
       Else
         MsgBox "Не выделены папки для для копирования!!! " & vbCrLf & _
         "Временные файлы удалены! " & vbCrLf & "Работа скрипта завершена! "_
         , vbExclamation,"Отмена!!! "
       End If
       MsgFileStr.Close
       If Result = 6 Then
         Set TextStream = FolderList.OpenAsTextStream(1) : StrFolder = vbNullString
         While Not TextStream.AtEndOfStream
           StrFolder = TextStream.ReadLine()
           Set TextStreamFL = FileList.OpenAsTextStream(1) : StrFiles = vbNullString
           While Not TextStreamFL.AtEndOfStream
             StrFiles = TextStreamFL.ReadLine()
             If .FolderExists(StrFolder) Then CreateObject("Shell.Application").NameSpace(StrFolder).CopyHere StrFiles, 20
           Wend
           TextStreamFL.Close
         Wend
         TextStream.Close
         MsgBox "Копирование удачно выполнено!!! ",vbExclamation,"Скопировано! "
       End If
       .DeleteFile PathTempFile, 0
     Else
       .GetFile(Argument).Copy Tempdir & "\FileListTemp.txt"
       MsgBox " Создан список выделенных файлов\папок для копирования!" & vbNewLine &_
        "Теперь перейдите в другую панель и выделите папки," & vbNewLine &_
        "в которые необходимо скопировать выделенное  и ещё раз нажмите кнопку ", _
        vbExclamation ,"Копирование выделенного в группу выделенных папок "
     End If
   End If
End With
Set TextStreamFL = Nothing : Set MsgFileStr = Nothing : Set TextStream = Nothing
Set FolderList = Nothing : Set FileList = Nothing : WScript.Quit

' 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

' 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

' 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

' 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

' CopyDubleDate.vbs
'========================   Описание   =====================================
' Копирование выделенных файлов\папок в текущий каталог с добавлением текущей даты
' Параметр %L
' Автор:             Аверин Андрей
' Версия:          1.1 (2010 - 29.10.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'========================================================================
Option Explicit
Dim List, F, Cnt
If WScript.Arguments.Count = 0 Then
   MsgBox "Не заданы параметры!" & vbNewLine &_
    "Должен быть минимум ОДИН параметр %L",_
     vbOKOnly + vbInformation, "Копирование с добавлением даты"
   WScript.Quit
End If
With CreateObject("Scripting.FileSystemObject")
   List = .OpenTextFile(WScript.Arguments(0), 1, False).ReadAll
   For Each F In Split(List, vbNewLine)
     If .FileExists(F) Then
        .CopyFile F, .GetFile(F).ParentFolder.Path & "\" &_
        .GetBaseName(F) & " " & DateTime & "." & .GetExtensionName(F)
     End If
     If .FolderExists(F) Then
        .CopyFolder Left(F, Len(F) - 1), Left(F, Len(F) - 1) & Chr(32) & DateTime
     End If
   Next
End With
WScript.Quit

Function DateTime
   Dim YY, MM, DD, H, M, S
   YY = Year(date) : MM = Month(date) : DD = Day(date)
   H = Hour(time) : M = Minute(time) : S = Second(time)
   DateTime = "[" & Right("0" & YY, 2)  & "." & Right("0" & MM, 2)  & "." & Right("0" & DD, 2)  &_
                         " - " & Right("0" & H, 2)  & "." & Right("0" & M, 2)  & "." & Right("0" & S, 2)  & "]"
End Function

' CopyFilesSkobaN.vbs
'================================================================
' Создает копию выделенных файлов\папок, добавляя к имени порядковый номер
' в скобках (идентично TC). Если в имени уже присутствует порядковый номер в скобках,
' то увеличивает нумерацию до появления незанятого номера.
' Параметры %L

' Автор:             jehaz & Аверин Андрей
' Версия:          1.2 (17.08.2007 - 29.10.2011)
' Site:                  http://tc-image.3dn.ru
'================================================================
Option Explicit
Dim FSO, FileList, FileStr, FullName, Counter
Dim FileName, Ext, Count, BetSkoba, OpenSkoba, BefSkoba, BetSkobaInt, TextStream

If WScript.Arguments.Count < 1 Then
   MsgBox "Неправильно указано количество параметров!" & vbNewLine &_
   "Должен быть минимум ОДИН параметр  %L", _
   vbOKOnly & vbInformation, "Копирование файлов\папок с добавлением (N)"
    WScript.Quit
End If

Set FSO = CreateObject("Scripting.FilesystemObject")
Set FileList = FSO.GetFile(WScript.Arguments(0))
Set TextStream = FileList.OpenAsTextStream(1)
FileStr = vbNullString

While Not TextStream.AtEndOfStream
   FileStr = TextStream.ReadLine()
   Counter = 1 : FileName = FSO.GetBaseName(FileStr) : Count = Len(FileName)

   Do
    If Mid(FileName, Len(FileName),1) = ")" Then
       Do While Count <> 0
        If Mid(FileName, Count,1) = "(" Then
           OpenSkoba = Count
           BetSkoba = Mid(FileName, OpenSkoba + 1, Len(FileName) - Count-1)
           BefSkoba = Mid(FileName, 1, OpenSkoba - 1) : Count = 0
        Else
           Count = Count - 1
        End If
       Loop

       On Error Resume Next
       BetSkobaInt = FormatNumber(BetSkoba, 0)
       If Err.Number = 0 Then
         If BetSkoba - BetSkobaInt = 0 Then FileName = BefSkoba : Counter = Counter + BetSkobaInt - 1
       End If
     End If
     Count = 0 : Counter = Counter + 1 : Ext = FSO.GetExtensionName(FileStr)
     FullName = FSO.GetParentFolderName(FileStr) & "\" & FileName & "(" & Counter & ")"
     If Ext <> "" Then FullName = FullName & "." & Ext
   Loop until Not (FSO.FileExists(FullName) Or FSO.FolderExists(FullName))

   If FSO.FileExists(FileStr) Then FSO.CopyFile FileStr, FullName
   If FSO.FolderExists(FileStr) Then FSO.CopyFolder Left(FileStr, Len(FileStr) - 1), FullName
Wend

Set TextStream = Nothing : Set FileList = Nothing : Set FSO = Nothing : WScript.Quit

' InstalFontInWincmd.vbs
'======================================================================
' Установить Шрифт для Total Commander
' можно использовать со скриптом ListFontBar.au3
'========================  Параметры ===================================
' В параметрах вызова из TC должно быть прописанo {имя шрифта}
'========================    Примеры    ===================================
' "Courier New"
'
' Автор:             Аверин Андрей
' Версия:          1.2 (07.01.2011 - 08.03.2012)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'=================   Изменяемые параметры   ================================
TCINI = "%COMMANDER_PATH%\Wincmd.ini"
INI = "%COMMANDER_PATH%\Scripts\Include\FunctionsINIRWS.vbs"
TCMC = "%COMMANDER_PATH%\Utilities\TotalCom\TCMC\TCMC.exe"
'========================================================================
If WScript.Arguments.Count < 1 Then
   MsgBox "Не хватает параметров!" & vbNewLine & "Должно быть ОДИН параметр!  Имя Шрифта", vbOKOnly &_
   vbCritical, "Установка шрифта в Total Commander" : Wscript.Quit
End If

Dim WSH
Set WSH = CreateObject("WScript.Shell")
FontName = WScript.Arguments(0) : FontKey = "FontName" : TCINI = GetPath(TCINI)
Execute CreateObject("Scripting.FileSystemObject").OpenTextFile(GetPath(INI)).ReadAll
SC = Array("800x600 (8x16)", "960x600 (8x16)", "1024x768 (8x16)", "1088x612 (8x16)", "1152x864 (8x16)", "1280x720 (8x16)", _
                      "1280x768 (8x16)", "1280x800 (8x16)", "1280x960 (8x16)", "1280x1024 (8x16)", "1360x768 (8x16)", "1440x900 (8x16)")
For i = 0 To Ubound(SC)
   WriteINI RedirectSection(TCINI, SC(i)), SC(i), FontKey, FontName
Next
'WScript.Sleep 100
WSH.Exec(Chr(34) & TCMC & Chr(34) & "CM492") : WScript.Sleep 100
WSH.SendKeys "{TAB}" & "{ENTER}" & "{ENTER}" & "{TAB}" & "{TAB 5}" & "{ENTER}" & "{ENTER}"

Set WSH = Nothing : WScript.Quit
Function GetPath(pPath) : GetPath = WSH.ExpandEnvironmentStrings(pPath) : End Function

' 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

' 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

' 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

' StructuraNul.vbs
'========================   Описание   ============================
' Создание в соседней панели пустой структуры выделенных папок и файлов
'=======================   Параметры  ============================
' 1-й параметр: список файлов\папок
' 2-й параметр: куда\сохранять\пустую\структуру
' 3-й параметр: любой, означает, что создаваться будет только структура папок
'========================   Примеры   ============================
' %L %t    - пустая структура папок и файлов
' %L %t 1 - пустая структура папок

' Автор:             Batya & Аверин Андрей
' Версия:          1.2 (4.11.2009 - 30.10.2011)
' Site:                  http://tc-image.3dn.ru
'===============================================================
Option Explicit
Dim FSO, OTF, Target, NewTar, Name, Ext, Selected, Cnt

Set FSO = CreateObject("Scripting.FileSystemObject")
With WScript
   Cnt = .Arguments.Count
   If Cnt < 2 Then
     MsgBox "Не хватает параметров!" & vbNewLine &_
     "Должно быть прописано минимум 2 параметра %L %t",_
     vbOKOnly & vbInformation, "Создание пустой структуры файлов"
     .Quit
   End If
   Set OTF = FSO.OpenTextFile(.Arguments(0), 1)
   Target  = CreateObject("Shell.Application").NameSpace(.Arguments(1)).Self.Path & "\"
End With
Do While Not OTF.AtEndOfStream
   Selected = OTF.ReadLine
   If FSO.FileExists(Selected) Then FSO.CreateTextFile(Target & FSO.GetFileName(Selected))
   If FSO.FolderExists(Selected) Then
     NewTar = Target & FSO.GetFolder(Selected).Name
     If Not FSO.FolderExists(NewTar) Then FSO.CreateFolder(NewTar)
     FolderProcess FSO.GetFolder(Selected), NewTar & "\"
   End If
Loop

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

Function FolderProcess(Fold, Tar)
   Dim sf, f, NewF
   For Each sf in Fold.SubFolders
     NewF = Tar & sf.Name
     If Not FSO.FolderExists(NewF) Then FSO.CreateFolder(NewF)
     FolderProcess sf, NewF & "\"
   Next
   If Cnt < 3 Then
     For Each f in Fold.Files
       FSO.CreateTextFile(Tar & FSO.GetFile(f).Name)
     Next
   End If
End Function

' 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

' 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

' LinkFromBufferButtonTC.vbs
'========================   Описание   ===============================
' Создание ярлыка из кнопки Total Commander'a на панели инструментов
' Предварительно необходимо скопировать кнопку в буфер обмена
'========================  Параметры ===============================
' Параметры {"Путь\сохранения\ярлыка\"}
' %p
' "%%USERPROFILE%%\Desktop\" - Сохранить на рабочий стол
' "%%APPDATA%%\Microsoft\Internet Explorer\Quick Launch\" - Сохранить в быстрый запуск

' Автор:             Аверин Андрей
' Версия:          2.1 (08.08.10 - 03.11.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'==================================================================
Titles = "Создание ярлыка из кнопки Total Commander'a"
If WScript.Arguments.Count > 0 Then
   tPath= GetPath(WScript.Arguments(0))
Else
   MsgBox "Не хватает параметров! Должен быть один параметр %p", vbOKOnly & vbInformation,Titles : WScript.Quit
End If
Clip = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text") : Desc = ""
If Len(Clip) = 0 Or InStr(Clip, vbNewLine) = 0 Then WsEnd

On Error Resume Next
Button = Split(Clip, vbNewLine)
If Button(0) <> "TOTALCMD#BAR#DATA" Then WsEnd
Trg = Trim(GetPath(Button(1))) : Arg = Trim(GetPath(Button(2))) : Icon = Trim(GetPath(Button(3))) : fName = Button(4)
If Len(Trg) < 3 Then WsEnd
pr = LCase(Mid(Trg, 1, 3))
If pr = "cm_" Or pr = "em_" Then WsEnd
If Left(Trg, 1) = Chr(34) Then Trg = Mid(Trg, 2)
If Right(Trg, 1) = Chr(34) Then Trg = Mid(Trg, 1, Len(Trg) - 1)

If Len(fName) > 0 Then
   Delim = InStr(fName, Chr(32) & "-" & Chr(32))
   If Delim > 0 Then
     Desc = Mid(fName, Delim + 3) : fName = Left(fName, Delim - 1)
   End If
End If

' Проверка содержит ли путь вначале CD
If UCase(Mid(Trg,1,3)) = "CD " Then
   Trg = Right(Trg, Len(Trg) - 3) : Icon = ",0"
End If

If fName <> "" Then
   NoSym = "\/?:*><|" & Chr(34)
   For i = 1 To Len(NoSym)
     sym = Mid(NoSym,i,1)
     If InStr(1,fName, sym) > 0 Then fName = Replace(fName, sym ,"_")
   Next
End If

If InStrRev(Trg,"\") = Len(Trg) Then Trg = Left(Trg,Len(Trg) - 1)
If fName = "" Then fName = Right(Trg, Len(Trg) - InStrRev(Trg, "\"))

With CreateObject("WScript.Shell").CreateShortcut(tPath & "\" & fName & ".lnk")
   .Arguments = Arg
   .Description = Desc
   '.HotKey = "CTRL+ALT+SHIFT+X" ' Присвоение горячей клавиши, если надо - убрать ' в начале строки
   .IconLocation = Icon
   .TargetPath = Trg
   .WindowStyle = 1
   .WorkingDirectory = CreateObject("Scripting.FileSystemObject").GetParentFolderName(Trg)
   .Save
End With
WScript.Quit

Sub WsEnd
  MsgBox "В буфере обмена находятся некоректные данные" & vbNewLine &_
  "Выделите кнопку на панели TC и повторите заново", vbOKOnly & vbInformation, Titles : WScript.Quit
End Sub

Function GetPath(pPath) : GetPath = CreateObject("WScript.Shell").ExpandEnvironmentStrings(pPath) : End Function