' FoldersGroupIcon.vbs
'=========================================================================
' Групповое назначение иконок у выделенных папок (создание файлов desktop.ini)
' Назначить выделенным папкам значков из exe, ico, icl файлов в папках
'=======================   Параметры  =====================================
' 1-й параметр: папка|файл-список папок
' 2-й параметр: файл с иконкой
' 3-й параметр: режим поиска файла с иконкой, где режим поиска файла с иконкой может принимать значения:
'   0 - обязательно должен быть задан файл с иконкой;
'   1 - если не задан файл с иконкой, выполняется автоматический поиск;
'   2 - если автоматически файл не найден, предлагается указать его вручную;
'   3 - всегда предлагается указать файл вручную (по умолчанию).
' 4-й параметр: любой, означает, что если в папке уже есть desctop.ini - он будет заменён
' 5-й параметр: любой, означает, что в desctop.ini будет прописано только имя файла
'========================   Примеры   =====================================
' "%P" "%N"
' %P%N %T%M
' %L "" 2
' %L "" 1 1 1
' Автор:       Batya & Аверин Андрей
' Версия:    1.1 (16.04.2009 - 20.10.2011)
' Site:                  http://tc-image.3dn.ru
'=========================================================================
Option Explicit
'======== Изменяемые параметры ===========================================
Const DefaultMode = 3    'Режим поиска файла с иконкой по умолчанию
Const FoldAttr = 1             'Атрибуты папки - "Только чтение"
Const FileAttr = 38            'Атрибуты файла - "Скрытый", "Системный", "Архивный"
'=========================================================================
Dim Mess, FSO, ListFlag, FF, IconFile, F, Errors, Mode, Cnt, Des

Set Errors = CreateObject("Scripting.Dictionary")
Set FSO = CreateObject("Scripting.FileSystemObject")
SetMess : CheckParam

If ListFlag Then
   For Each F In Split(FSO.OpenTextFile(FF).ReadAll, vbNewLine)
     If FSO.FolderExists(F) Then Main F
   Next
Else
   Main FF
End If

If Errors.Count > 0 Then MessBox JoinErr(Errors), 2
Quit

Sub SetMess
   Set Mess = CreateObject("Scripting.Dictionary")
   With Mess
     .Add 0,  " для папки"
     .Add 1,  "Не указаны параметры!"
     .Add 2,  "Первый параметр не является папкой или файлом-списком!"
     .Add 3,  "Указанный файл с иконкой не существует!"
     .Add 4,  "Не является папкой!"
     .Add 5,  "Файл с иконкой не найден!"
     .Add 6,  "Файл Desktop.ini уже существует!"
     .Add 7,  "Операция завершена."
     .Add 8,  "Операция завершена с ошибками." & vbNewLine
     .Add 9,  "Укажите файл иконок для папки "
     .Add 10, "Исполняемые файлы (*.exe)|*.exe|Файлы иконок (*.ico)|*.ico|Все файлы (*.*)|*.*"
     .Add 11, "Неправильно указан режим поиска файла иконок!"
     .Add 12, "В данном режиме файл с иконкой должен быть указан обязательно!"
   End With
End Sub

Sub Main(pF)
   Dim lF, lIF
   lF = GetPath(pF)
   If Not FSO.FolderExists(lF) Then Errors.Add lF, lF & " - " & Mess(4) : Exit Sub End If
   lIF = GetIconFile(lF, IconFile)
   If lIF = "" Then Errors.Add lF, lF & " - " & Mess(5) : Exit Sub End If
   With FSO.GetFolder(lF) .Attributes = .Attributes or FoldAttr End With   'Установим атрибуты папки
   Des = lF & "\Desktop.ini"
   If Not FSO.FileExists(Des) Or Cnt > 3 Then
     If FSO.FileExists(Des) Then FSO.DeleteFile Des
     CreateDesktopFile Des, lIF
   Else
     Errors.Add lF, lF & " - " & Mess(6) : Exit Sub
   End If
End Sub

Sub CheckParam
   Cnt = WScript.Arguments.Count
   If Cnt = 0 Then MessBox Mess(1), 1 : Call Quit End If
   FF = WScript.Arguments(0) : ListFlag = FSO.FileExists(FF)
   If (Not ListFlag) And (Not FSO.FolderExists(FF)) Then MessBox Mess(2), 1 : Call Quit End If
   If Cnt > 1 Then
     IconFile = WScript.Arguments(1)
     If IconFile <> "" Then IconFile = GetPath(IconFile)
   Else
     IconFile = ""
   End If
   If Cnt > 2 Then
     Mode = WScript.Arguments(2)
     If Mode = "" Then
       Mode = DefaultMode
     Else
       If IsNumeric(Mode) Then
         Mode = CInt(Mode)
       Else
         MessBox Mess(11), 1 : Call Quit
       End If
       If Not((Mode = 0) Or (Mode = 1) Or (Mode = 2) Or (Mode = 3)) Then MessBox Mess(11), 1 : Call Quit End If
     End If
   Else
     Mode = DefaultMode
   End If
   If (Mode = 0) And (IconFile = "") Then MessBox Mess(12), 1 : Call Quit End If
   If (IconFile <> "") And (Not FSO.FileExists(IconFile)) Then MessBox Mess(3), 1 : Call Quit End If
End Sub

Sub Quit : Set Errors = Nothing : Set FSO = Nothing : WScript.Quit : End Sub

Function MessBox(pMess, pMode)
   Dim lIcon
   Select Case pMode
     Case 1 lIcon = vbCritical + vbOKOnly
     Case 2 lIcon = vbExclamation + vbOKOnly
     Case 3 lIcon = vbInformation + vbOKOnly
   End Select
   MessBox = MsgBox(pMess, lIcon, Mess(0))
End Function

Function JoinErr(pDic)
   Dim lKey
   For Each lKey In pDic
     JoinErr = JoinErr & vbNewLine & vbNewLine & pDic(lKey)
   Next
   JoinErr = Mess(8) & JoinErr
End Function

Sub CreateDesktopFile(pFile, pIconFile)
   If Cnt > 4 Then pIconFile = FSO.GetFileName(pIconFile)
   With FSO.CreateTextFile(pFile)
     .WriteLine "[.ShellClassInfo]"
     .WriteLine "IconResource=" & pIconFile
     .WriteLine "IconFile=" & pIconFile
     .WriteLine "IconIndex=0"
     .Close
   End With
   With FSO.GetFile(pFile) .Attributes = .Attributes or FileAttr End With
End Sub

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

Function GetIconFile(pFolder, pFile)
   Dim lFile, Ext, i
   If Mode = 0 Then GetIconFile = pFile : Exit Function End If
   If Mode < 3 Then
     If pFile <> "" Then
       GetIconFile = pFile : Exit Function
     Else
       lFile = pFolder & "\" & FSO.GetBaseName(pFolder) & ".exe"
       If FSO.FileExists(lFile) Then
         GetIconFile = lFile : Exit Function
       End If
       For Each lFile In FSO.GetFolder(pFolder).Files
         If UCase(FSO.GetExtensionName(lFile)) = "EXE" Then
           If (UCase(Left(lFile, 5)) <> "UNINS") Or (UCase(FSO.GetBaseName(lFile)) <> "UNWISE") Then
             GetIconFile = lFile : Exit Function
           End If
         End If
       Next
       Ext = Array("ICO", "ICL") ' если .exe не найдено (можно вписать другие раксширения имеющие значки)
       For i = 0 To Ubound(Ext)
         For Each lFile In FSO.GetFolder(pFolder).Files
           If UCase(FSO.GetExtensionName(lFile)) = Ext(i) Then GetIconFile = lFile : Exit Function End If
         Next
       Next
       If Mode = 2 Then
         GetIconFile = OpenFile(pFolder)
       Else
         GetIconFile = ""
       End If
     End If
   Else
     GetIconFile = OpenFile(pFolder)
   End If
End Function

Function OpenFile(pFolder)
   Dim Dlg
   On Error Resume Next
   Set Dlg = CreateObject("MSComDlg.CommonDialog")
   If Err.Number = 0 Then
     On Error GoTo 0
     With Dlg
       .InitDir = pFolder
       .Filter = Mess(10)
       .Flags = &H4; + &H8; + &H400; + &H1000; + &H80000;
       .FilterIndex = 1
       .MaxFileSize = 32000
       .CancelError = True
       .DialogTitle = Mess(9) & """" & pFolder & """"
       On Error Resume Next
       .ShowOpen
     End With
     If Err.Number = 0 Then
       OpenFile = Dlg.FileName
     Else
       OpenFile = ""
     End If
     On Error GoTo 0
     Set Dlg = Nothing
   Else
     On Error GoTo 0
     Dlg = InputBox(Mess(9) & """" & pFolder & """", Mess(0), pFolder & "\")
     If Dlg <> "" Then Dlg = GetPath(Dlg)
     If Not FSO.FileExists(Dlg) Then Dlg = ""
     OpenFile = Dlg
   End If
End Function

' DeleteDesktopInI.vbs
'========================   Описание   =====================================
' Удаление в выделенных папках файла Desktop.ini и снятие атрибута с папки "Только чтение"
'=======================   Параметры  =====================================
' 1-й параметр: Список файлов
' 2-й параметр: необязательный битовый флаг атрибута, который необходимо снять с папки
' (по умолчанию снимается с папки атрибут "Только чтение")
'========================   Примеры   =====================================
' %L    - удалить Desktop.ini и снять атрибут "Только чтение"
' %L 0 - удалить Desktop.ini и снять все атрибуты
'=======================   Дополнение   ====================================
' Иногда desktop.ini содержит иную информацию помимо пути и индекса иконки,
' поэтому  используйте этот скрипт разумно!!!

' Автор:             Аверин Андрей
' Версия:          1.1 (14.11.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'========================================================================
If WScript.Arguments.Count > 0 Then
   With CreateObject("Scripting.FileSystemObject")
     Attr = 1
     If WScript.Arguments.Count > 1 Then Attr = WScript.Arguments(1)
     Set ListFile = .OpenTextFile(WScript.Arguments(0), 1)
     Do While Not ListFile.AtEndOfStream
       Dir = ListFile.ReadLine
       If .FolderExists(Dir)Then
         If Right(Dir, 1) <> "\" Then Dir = Dir & "\"
         Des = Dir & "Desktop.ini"
         If .FileExists(Des) Then
           .GetFolder(Dir).Attributes = Attr ' Снимаем у папки атрибут
           .DeleteFile Des
         End If
       End If
     Loop
   End With
Else
   MsgBox "Не хватает параметров!", vbOKOnly & vbCritical, "Удаление Desktop.ini"
End If
WScript.Quit

' IconsOnAssFolders.vbs
'======================================================================
' Присвоение значков выделенным Папкам по содержимому
' Ассоциированные значкам папки и расширения считываются из файла
' Синтаксис файла:
' Путь\к\значку{библиотека,номер}=;Папка1;Папка2;расширение1;расширение2;...
' d:\Картинки\Иконки\Архив.ico=;Архивы;Архив;7z;7zip;rar;
' %SystemRoot%\system32\shell32.dll,-236=;Музыка;mp3;wal;
' %COMMANDER_PATH%\Wcmicons.icl,1854=;Текст;Документы;doc;docx;txt;
' %WINDIR%\Wcmicons.dll,1457=;TC Image;Total Commander;
'========================  Параметры ===================================
' В параметрах вызова из TC должно быть прописанo 2 параметра:
' {Cписок файлов} {путь\к\файлу_ассоциаций}
' {любой 3-й параметр означает, что если в папке уже есть desctop.ini - он будет заменён}
'========================    Примеры    ===================================
' %L "%%COMMANDER_PATH%%\Scripts\AddIcons\IconsOnAssFolders.txt"
' %L "%%COMMANDER_PATH%%\Scripts\AddIcons\IconsOnAssFolders.txt" 1
' Автор:             Аверин Андрей
' Версия:          1.2 (30.12.2010 - 21.10.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'======================================================================
Cnt = WScript.Arguments.Count
If Cnt < 2 Then
   MsgBox "Не хватает параметров!" & vbNewLine &_
   "Должно быть минимум Два параметра!" & vbNewLine &_
   "%L ''Путь\к\IconsOnAssFolers.txt''", vbOKOnly &_
   vbCritical, "Присвоение значков Папкам по содержимому"
   Wscript.Quit
End If

Dim FSO, ExtLine
Set FSO = CreateObject("Scripting.FileSystemObject")
Set List = FSO.OpenTextFile(GetPath(WScript.Arguments(0)), 1)
ExtLine = Split(FSO.OpenTextFile(GetPath(WScript.Arguments(1)), 1).ReadAll, vbNewLine)

Do While Not List.AtEndOfStream
   fF = GetPath(List.ReadLine) : ll = 0
   If FSO.FolderExists(fF) Then
     Ext = Split(";" & FSO.GetBaseName(fF) & ";" & ExtStr(fF), ";")
     For i = 0 To Ubound(Ext)
       For k = 0 To Ubound(ExtLine)
         If InStr(1, UCase(Mid(ExtLine(k), Instr(ExtLine(k), "=") + 1, Len(ExtLine(k)))), ";" & UCase(Ext(i)) & ";") >  0 Then
           If Right(fF, 1) <> "\" Then fF = fF & "\"
           IC = GetPath(Mid(ExtLine(k), 1, Instr(ExtLine(k), "=") - 1))
           If Instr(IC, ",") > 0 Then
             IC = GetPath(Mid(ExtLine(k), 1, Instr(ExtLine(k), ",") - 1))
             NN = Mid(ExtLine(k), Instr(ExtLine(k), ",") + 1, Instr(ExtLine(k), "=") - Instr(ExtLine(k), ",") - 1)
           Else
             NN = "0"
           End If
          Desktop fF, IC, NN : ll = 1 : Exit For
         End If
       Next
       If ll = 1 Then Exit For
     Next
   End If
Loop

List.Close : Set List = Nothing : Set Folder = Nothing : Set FSO = Nothing : Wscript.Quit
Function GetPath(pPath) : GetPath = CreateObject("WScript.Shell").ExpandEnvironmentStrings(pPath) : End Function

Function ExtStr(fFolder)
   Dim Folder
   Set Folder = FSO.GetFolder(fFolder)
   For Each Files In Folder.Files
     If InStr(";descript.ion;desktop.ini;", LCase(FSO.GetFileName(Files))) = 0 Then
       Ext  = FSO.GetExtensionName(Files)
       If InStr(UCase(ExtStr), UCase(Ext)) < 1 Then ExtStr = ExtStr & Ext & ";"
     End If
   Next
End Function

Sub Desktop(TargetDir,IconFile, Number)
   FileName = TargetDir & "Desktop.ini"
   If Not FSO.FileExists(FileName) Or Cnt > 2 Then
     If FSO.FileExists(FileName) Then FSO.DeleteFile(FileName)
     With FSO.CreateTextFile(FileName)
       .WriteLine "[.ShellClassInfo]"
       .WriteLine "IconFile=" & IconFile
       .WriteLine "IconIndex=" & Number
       .WriteLine "IconResource=" & IconFile & "," & Number
       .Close
     End With
     With FSO.GetFile(FileName) .Attributes = .Attributes Or 38 End With
     With FSO.GetFolder(TargetDir) .Attributes = .Attributes Or 33 End With
   End If
End Sub

' Attributes.vbs
'========================   Описание   =====================================
' Установка\Снятие атрибутов у выделенных файлов\папок без рекурсии
' (без подпапок и файлов в них)
'=======================   Параметры  =====================================
' 1-й параметр: список файлов\папок
' 2-й параметр: 0 - снятие атрибута; 1 - установка атрибута
' 3-й параметр: битовый флаг атрибута
'========================================================================
'Normal          0     Normal file. No attributes are set.                          Нет атрибутов
'ReadOnly     1     Read-only file. Attribute is read/write.                   Только чтение
'Hidden          2     Hidden file. Attribute is read/write.                        Скрытый
'System         4     System file. Attribute is read/write.                        Системный
'Volume         8     Disk drive volume label. Attribute is read-only.  Метка диска
'Directory     16    Folder or directory. Attribute is read-only.          Каталог
'Archive        32    File has changed since last backup. Attribute is read/write.  Архивный
'Alias             64    Link or shortcut. Attribute is read-only.               Ярлык
'Compressed  128     Compressed file. Attribute is read-only.       Сжатый
'========================================================================
' %L 1 38

' Автор:             Аверин Андрей
' Версия:          1.0 (28.04.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'========================================================================
Dim FSO, FF, Line, sFile
Set FSO = CreateObject("Scripting.FileSystemObject")

If WScript.Arguments.Count > 1 Then
   Set sFile = FSO.OpenTextFile(WScript.Arguments(0), 1)
   m = WScript.Arguments(1) : Atrib = WScript.Arguments(2)
Else
   MsgBox "Не хватает параметров!!!", vbOKOnly & vbCritical, "Установка\Снятие Атрибутов"
   WScript.Quit
End If

Do While Not sFile.AtEndOfStream
   Line = sFile.ReadLine
   if FSO.FileExists(Line) Then Set FF = FSO.GetFile(Line)
   if FSO.FolderExists(Line) Then Set FF = FSO.GetFolder(Line)
   If m = 0 Then
     FF.Attributes = FF.Attributes And Not Atrib
   Else
     FF.Attributes = FF.Attributes Or Atrib
   End If
Loop

Set sFile = Nothing : Set FF = Nothing : Set FSO = Nothing : WScript.Quit

' 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

' 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

' 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

' NIconFolderInBuffer.vbs
'========================   Описание   =====================================
' Послать в буфер информацию о значке, присвоенном папки под курсором
'========================  Параметры =====================================
' 1-й параметр: {путь\к\папке}
' 2-й параметр: 1 - путь значка
'                            2 - путь+номер значка
'                            3 - номер значка
'                            4 - открытьDesktop.ini
'========================   Примеры   =====================================
' %P%N 1
' используется FunctionsINIRWS.vbs
' Автор:       Аверин Андрей
' Версия:    1.2 (07.01.2011 - 14.11.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'========================================================================
Option Explicit
'====================   Изменяемые пути   ==================================
Const INI = "%COMMANDER_PATH%\Scripts\Include\FunctionsINIRWS.vbs"
Const NirCmd = "%COMMANDER_PATH%\NirCmd.exe"
'========================================================================
Const Titles = "Оправить информацию значка папки в буфер"
If WScript.Arguments.Count < 2 Then
   WScript.Quit
   MsgBox "Не хватает параметров!" & vbNewLine &_
   "Должно быть минимум Два параметра!" & vbNewLine &_
   "%P%N 1", vbOKOnly & vbCritical, Titles
End if

Dim FSO, WSH, Des, Icon, Path, PathIc, Param, Str, Folder, Tmp
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
Execute FSO.OpenTextFile(GetPath(INI)).ReadAll

Folder = WScript.Arguments(0)
If Right(Folder, 1 ) <> "\" Then Folder = Folder & "\"
Des = Folder & "Desktop.ini"

Param = CInt(WScript.Arguments(1))
If Param = 4 Then
   WSH.Run Chr(34) & Des & Chr(34) : WSFSEnd
End If

If FSO.FileExists(Des) Then
   Icon = ReadINI(Des, ".ShellClassInfo", "IconIndex")
   Path = ReadINI(Des, ".ShellClassInfo", "IconFile")
   PathIc = Path & "," & Icon
   If Icon = "" Or Path = "" Then
     Icon = ReadINI(Des, ".ShellClassInfo", "IconResource")
     If Icon <> "" Then
       If InStr(Icon, ",") > 0 Then
         PathIc = Icon
         Icon = Mid(Icon, InStrRev(Icon, ",") + 1)
         Path = Left(PathIc, InStrRev(PathIc, ",") - 1)
       End if
     Else
       MsgBox "Нет номера значка в стандартных местах Desktop.ini", vbOKOnly &_
       vbCritical, Titles :WSFSEnd
     End if
   End if
Else
   MsgBox "В папке "  & Folder & " нет файла Desktop.ini", vbOKOnly &_
   vbCritical, Titles : WSFSEnd
End if

Select Case Param
   Case 1 Str = Path
   Case 2 Str = PathIc
   Case 3 Str = Icon
End Select

Tmp = FSO.GetSpecialFolder(2) & "\" & FSO.GetTempName()
FSO.CreateTextFile(Tmp, True).Write Str
WSH.Run Chr(34) & GetPath(NirCmd) & Chr(34) & " " & "clipboard readfile " & Tmp , 2,True
WScript.Sleep 1000 : FSO.DeleteFile Tmp : WSFSEnd

Sub WSFSEnd : Set WSH = Nothing : Set FSO = Nothing : Wscript.Quit : End Sub
Function GetPath(pPath) : GetPath = WSH.ExpandEnvironmentStrings(pPath) : End Function

' ChangeAttributes.vbs
'=====================================================================
' http://forum.wincmd.ru/viewtopic.php?p=77300#77300
' http://tc-image.3dn.ru
' Изменение атрибута у отмеченных файлов и папок (файлов в них)
' Параметры:
' {файл-список} {битовый флаг атрибута} [{режим}]
' где {режим} может принимать значения:
'     0 - смена атрибута (по умолчанию),
'     1 - установка атрибута,
'     2 - снятие атрибута.
' Наиболее часто используемые значения {битовый флаг атрибута}:
'     1 - только чтение,
'     2 - скрытый,
'     4 - системный,
'     32 - архивный.

' Пример параметров вызова из TC (установка атрибута "Скрытый"):
' %L 2 1

' Автор:             Batya
' Версия:          1.0 (26.04.2011)
'=====================================================================
Option Explicit
Dim FSO, StreamFile, Selected, CurrFolder, Attr, Mode
Set FSO = CreateObject("Scripting.FileSystemObject")
With WScript
   Set StreamFile = FSO.OpenTextFile(.Arguments(0), 1)
   Attr = .Arguments(1)
   If .Arguments.Count < 3 Then
     Mode = 0
   Else
     Mode = CInt(.Arguments(2))
   End If
End With
Do While Not StreamFile.AtEndOfStream
   Selected = StreamFile.ReadLine
   If FSO.FileExists(Selected) Then
     ChangeAttr FSO.GetFile(Selected)
   End If
   If FSO.FolderExists(Selected) Then
     Set CurrFolder = FSO.GetFolder(Selected)
     ChangeAttr CurrFolder
     FolderProcess CurrFolder
   End If
Loop
'MsgBox("Выполнено!")
Set FSO = Nothing : Set StreamFile = Nothing : Set CurrFolder = Nothing : Wscript.Quit

Sub FolderProcess(CurrFolder)
   Dim f
   For Each f in CurrFolder.SubFolders
     ChangeAttr f
     FolderProcess f
   Next
   For Each f in CurrFolder.Files
     ChangeAttr f
   Next
End Sub

Sub ChangeAttr(pFObj)
   With pFObj
     Select Case Mode
       Case 0 .Attributes = .Attributes Xor Attr
       Case 1 .Attributes = .Attributes Or Attr
       Case 2 .Attributes = .Attributes And Not Attr
     End Select
   End With
End Sub

' 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

'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

' 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

' 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

' PathFolderLevelN.vbs
'======================================================================
' Сканирование путей папок до N уровня из файл списка и запись результата в файл
'========================  Параметры ===================================
' В параметрах вызова из TC должно быть прописанo 3 параметра:
' {путь\к\списку папок.txt} {путь\сохранения\файла.txt}
'=======================  Дополнение =====================================
' Ситаксис списка папок
' "путь\к\папке" N ( N - число уровеней, в которых требуется найти все папки)
' "%COMMANDER_PATH%\Plugins" 2
' "%COMMANDER_PATH%\Programs" 2
' "%COMMANDER_PATH%\Scripts" 1
'========================    Примеры    ===================================
' "%%COMMANDER_PATH%%\Files\Lists\PathList.txt" "c:\12345.txt"
'
' Автор:             Аверин Андрей
' Версия:          1.2 (24.12.2010 - 28.08.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'======================================================================
Option Explicit
If WScript.Arguments.Count < 2 Then
   MsgBox "Не хватает параметров!!!", vbOKOnly & vbCritical, "Создание списков папок"
   WScript.Quit
End If

Dim FSO, MyFile, List, Folder, PathLines, PathList, Level, Text, SubFolder, FF, i
Set FSO = CreateObject("Scripting.FileSystemObject")

PathList = FSO.OpenTextFile(GetPath(WScript.Arguments(0)), 1).ReadAll
PathLines = Split(PathList, vbNewLine)

For i = 0 To Ubound(PathLines)
   Level = CInt(Right(PathLines(i), Len(PathLines(i)) - InStrRev(PathLines(i), " ")))
   Folder = GetPath(Replace(Left(PathLines(i), InStrRev(PathLines(i), " ") - 1), """", ""))
   Text = Text & Folder & vbNewLine
   If Level > 0 Then ScanFolders(0)
   Set FF = Nothing
Next

FSO.CreateTextFile(WScript.Arguments(1), True).Write(Text)
Set FSO = Nothing : Wscript.Quit

Sub ScanFolders(n)
   Set FF = FSO.GetFolder(Folder)
     For Each SubFolder In FF.SubFolders
       Text = Text & SubFolder.Path & vbNewLine : Folder = SubFolder.Path
       if Level > n Then ScanFolders(n + 1)
     Next
End Sub

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

"%COMMANDER_PATH%\Backup" 0
"%COMMANDER_PATH%\BAR" 1
"%COMMANDER_PATH%\Files" 2
"%COMMANDER_PATH%\Games" 1
"%COMMANDER_PATH%\Keys" 1
"%COMMANDER_PATH%\LANGUAGE" 0
"%COMMANDER_PATH%\Plugins" 2
"%COMMANDER_PATH%\Programs" 2
"%COMMANDER_PATH%\Scripts" 1
"%COMMANDER_PATH%\Utilities" 2