Total Commander Knowledge Base

Есть вопрос?

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

Массовая обработка комментариев

04 Ноя, 2009

Скрипт, полезный в случаях, когда необходимо быстро обработать комментарии для группы файлов/каталогов. Может применяться для "быстрой" подсветки файлов/каталогов - в TC настраиваем подсветку файлов с определённым комментарием, и с помощью скрипта этот комментарий вписываем/удаляем. Для работы нужен Script Helper.

'==========================================================================================
' Массовое Добавление\Удаление\Замена комментария (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