Total Commander Knowledge Base

Есть вопрос?

Поищите ответ в самой большой русскоязычной базе знаний по Total Commander!

Быстрая подсветка файлов и каталогов

02 Ноя, 2009

Иногда возникает потребность быстро выделить цветом какой-либо файл. Придумано несколько способов реализации этой функции, но, к сожалению, каждый имеет свои недостатки.

Способ с использованием комментариев descript.ion

Пошаговая инструкция

  1. Сделать кнопку или команду
  2. Настроить шаблон для раскраски
  3. Сохранить скрипт где-то в папке ТС
  4. По желанию настроить горячую клавишу

Кнопка

Иконку выбираете любую, путь прописываете свой. Параметры выбираете по своему усмотрению.

Код кнопки
TOTALCMD#BAR#DATA:
%COMMANDER_PATH%\scripts\CommentEdit.vbs
%L "%Pdescript.ion" "####" 3 2
%COMMANDER_PATH%\WCMICONS.DLL
Пометить файл/папку

-1

Шаблон поиска

DefineSelection.png

Configuration -> Color -> Define colors by file type -> Add... -> Define...

Скрипт

Сохранить, например, тут:
%COMMANDER_PATH%\scripts\CommentEdit.vbs 

'========================================================================================== 
' Массовое Добавление\Удаление\Замена комментария (descript.ion), переданного параметром 
' 
' В качестве параметров указать: 
' %L "%Pdescript.ion" {Комментарий} {Режим работы с комментарием} {Режим места комментария} 
' Если в качестве комментария передать "", то для комментария будет использоваться 
'   содержимое буфера обмена 
' Режим работы с комментарием: 
' 1 - Добавление 
' 2 - Удаление 
' 3 - Инверсия 
' Режим места комментария (можно не указывать, по умолчанию - 1): 
' 1 - Начало 
' 2 - Конец 
' 3 - Полностью 
' Пример параметров для добавления комментария "####" в начало: 
' %L "%Pdescript.ion" "####" 1 1 
'========================================================================================== 
Option Explicit 

If WScript.Arguments.Count < 4  Then 
  MsgBox "Неправильно указаны параметры", _ 
         vbOKOnly + vbExclamation, _ 
         "Работа с комментариями" 
  WScript.Quit 
End If 
If WScript.Arguments(3) < 1 Or WScript.Arguments(3) > 3 Then 
  MsgBox "Неправильно указан режим работы с комментарием", _ 
         vbOKOnly + vbExclamation, _ 
         "Работа с комментариями" 
  WScript.Quit 
End If 
Dim Mode2 
If WScript.Arguments.Count < 5  Then 
  Mode2 = 1 
Else 
  Mode2 = WScript.Arguments(4) 
End If 
If Mode2 < 1 Or Mode2 > 3 Then 
  MsgBox "Неправильно указан режим места комментария", _ 
         vbOKOnly + vbExclamation, _ 
         "Работа с комментариями" 
  WScript.Quit 
End If 
Dim CommLabel 
CommLabel = WScript.Arguments(2) 
If CommLabel = "" Then 
  Dim TCS 
  Set TCS   = CreateObject("TCScript.Helper") 
  CommLabel = TCS.GetTextFromClip 
  Set TCS   = Nothing 
  If CommLabel = "" Then 
    MsgBox "Не определен комментарий", _ 
           vbOKOnly + vbExclamation, _ 
           "Работа с комментариями" 
    WScript.Quit 
  End If 
  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(1) 
Mode1    = WScript.Arguments(3) 
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 
    Set oCommFile = FSO.GetFile(CommFile) 
    oCommFile.Attributes = oCommFile.Attributes Or 2 'Hidden 
    Set oCommFile = Nothing 
    AllText = "" 
  Else 
    MsgBox "Создание " & CommFile & " невозможно из-за ошибки:" & vbNewLine & Err.Description, _ 
           vbOKOnly + vbCritical, _ 
           "Работа с комментариями" 
    Err.Clear 
    Set oTextFile = Nothing 
    Set FSO       = Nothing 
    WScript.Quit 
  End If 
End If 

Set OTF = FSO.OpenTextFile(WScript.Arguments(0), 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 & """" 
  End If 
  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) 
      End If 
    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) 
      End If 
    Else 'FindComm = 2 - Существующий комментарий равен указанному 
      If Mode1 = 2 Or Mode1 = 3 Then 'Удаляем комментарий 
        AllText = DelLine(AllText, BegFile, EndFileComm) 
      End If 
    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) 
      End If 
      'Удаление пустых комментариев 
      If Instr(BegFile, AllText & vbNewLine, FileName & " " & vbNewLine) > 0 Then 
        AllText = Left(AllText, BegFile - 1) & Mid(AllText, BegFile + Len(FileName & " " & vbNewLine)) 
      End If 
      'Удаление лишних концевых строк 
      If Right(AllText, Len(vbNewLine)) = vbNewLine Then 
        AllText = Left(AllText, Len(AllText) - Len(vbNewLine)) 
      End If 
      'Повторим, на всякий случай 
      If Right(AllText, Len(vbNewLine)) = vbNewLine Then 
        AllText = Left(AllText, Len(AllText) - Len(vbNewLine)) 
      End If 
      If Len(AllText) = 0 Then 
        FSO.DeleteFile(CommFile) 
      End If 
    End If 
    If Len(AllText) > 0 Then 
      On Error Resume Next 
      Set oTextFile = FSO.OpenTextFile(CommFile, 2) 
      If Err.Number = 0 Then 
        oTextFile.Write AllText 
        oTextFile.Close 
      Else 
        MsgBox "Запись в " & CommFile & " невозможна из-за ошибки:" & vbNewLine & Err.Description, _ 
               vbOKOnly + vbCritical, _ 
               "Работа с комментариями" 
        Err.Clear 
        Exit Do 
      End If 
      On Error GoTo 0 
    End If 
  Else 'Нет комментариев для файла 
    If Mode1 = 1 Or Mode1 = 3 Then 'Добавляем комментарий 
      On Error Resume Next 
      Set oTextFile = FSO.OpenTextFile(CommFile, 8, 2) 
      If Err.Number = 0 Then 
        If Right(AllText, Len(vbNewLine)) <> vbNewLine Then 
          oTextFile.WriteLine 
          AllText = AllText & vbNewLine 
        End If 
        oTextFile.Write FileName & " " & CommLabel 
        oTextFile.Close 
        AllText = AllText & FileName & " " & CommLabel 
      Else 
        MsgBox "Запись в " & CommFile & " невозможна из-за ошибки:" & vbNewLine & Err.Description, _ 
               vbOKOnly + vbCritical, _ 
               "Работа с комментариями" 
        Err.Clear 
        Exit Do 
      End If 
      On Error GoTo 0 
    End If 
  End If 
Loop 

OTF.Close 
Set oTextFile = Nothing 
Set oCommFile = 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

Автор скрипта - Batya.

Настройка горячей клавиши (по желанию)

HKey.png

Если хотите, вы можете повесить выделение цветом на горячую клавишу.

Configuration -> Options -> Misc. -> Redefine hotkeys (Keyboard remapping)

Недостатки

  • Используются комментарии
  • Невозможно пометить файлы в виртуальных папках и сетевых шарах без права записи

Способ с использованием NTFS потоков

DefineSelection ntfsdiz.png

Nfts diz atr.png

Можно использовать WDX-плагин NTFS_diz.

Пошаговая инструкция

  1. Установить плагин NTFS_diz
  2. Настроить раскраску файлов.
  3. Помечать файл через диалог смены атрибутов

Недостатки

  • Неудобно "помечать".
  • Сейчас Total Commander не умеет копировать NTFS потоки каталогов, поэтому после копирования раскраска пропадет. Но можно такие папки копировать проводником или по Ctrl+C, Ctrl+V.
  • Невозможно пометить файлы в виртуальных папках и сетевых шарах без права записи.}}