Total Commander

Код: Выделить всё

'===============================================================================
' Добавить/обновить комментарий для объекта под курсором и вышестоящих каталогов
' Условие: в опциях основных операций ТС должен быть снят флаг с "Кодировка DOS"
' а) Для вышестоящих каталогов комментарием является счётчик присвоенных меток.
' б) Для объекта под курсором метасимвол \n может служить переводом строки.
' Параметры: %V [<комментарий к файлу (необ.)>]                 Автор: Flasher ©
'===============================================================================
Option Explicit : Dim Arg, File, Com, Path, Header, ChS, FSO,_
TCIni, Filt, Enc, Key, FCom1, FCom2, H, Sep, N, c, F1, F2, E(0)
Set Arg = WScript.Arguments :  File = Arg(0) : If Arg.Count = 2 Then Com = Arg(1)
Path = File : Header = " Добавление комментария к объекту под курсором"
If Com = "" Then Com = InputBox(vbCr & "Используйте \n в качестве разделителя" &_
vbCr & "текста на строки." & vbCr & vbCr & vbCr & "Введите комментарий:", Header)
If Trim(Com) = "" Then WScript.Quit :End If: ChS = Array("windows-1251", "cp866")
Set FSO = CreateObject("Scripting.FileSystemObject")
TCIni = CreateObject("WScript.Shell").ExpandEnvironmentStrings("%COMMANDER_INI%")
Filt = Filter(Split(FSO.OpenTextFile(TCIni).ReadAll, vbnewline), "CopyComments=")
Enc = ChS(0) : Key = 2 : If Ubound(Filt) = 0 Then Key = Mid(Filt(0), 14)
If Key/2 = Int(Key/2) Then FCom1 = "descript.ion" : FCom2 = "files.bbs"_
Else FCom1 = "files.bbs" : FCom2 = "descript.ion" : Enc = ChS(1) : H = 2
For Each Arg in Split("5 6 13 14 21 22 29 30")
  If Arg = Key Then Arg = 1 : Exit For
Next : Sep = vbNewLine & Space(31) & "| "

For c = 1 to Ubound(Split(File, ""))
  N = FSO.GetFileName(Path) : Path = FSO.GetParentFolderName(Path) & ""
  F1 = Path & FCom1 : F2 = Path & FCom2
  If FSO.FileExists(F1) Then
    AddComment F1, N, c, 1
  ElseIf FSO.FileExists(F2) And Arg = 1 Then AddComment F2, N, c, 0
  Else
    If FCom1 = "files.bbs" Then
      N = UCase(N)
    ElseIf InStr(N, " ") Then N = """" & N & """" End If
    If c = 1 Then
      If FCom1 = "files.bbs" Then Com = Replace(Com, "\n", Sep)
      If FCom1 = "descript.ion" And InStr(Com, "\n") Then Com = Com & "В"
    Else Com = 1 End If
    With CreateObject("ADODB.Stream")
      .Open : .Charset = Enc : .WriteText N & " " & Com & vbNewLine
      .SaveToFile F1, 2 : .Close
    End With : FSO.GetFile(F1).Attributes = 34 - H
  End If
Next : CreateObject("WScript.Shell").SendKeys "^R"

Sub AddComment(F, FN, Level, Test)
  Dim Comt, Fl, Name, En, All, Find, T, NL, Str, Ln, Comm, FiEnd, Cnt, S, L, D
  Comt = Com
  If Test Then
    En = Enc
  ElseIf Enc = ChS(0) Then En = ChS(1) Else En = ChS(0)
  End If : Set Fl = FSO.GetFile(F) : Name = Fl.Name
  If Name = "descript.ion" And InStr(FN, " ") Then FN = """" & FN & """"
  If Name = "files.bbs" Then _
  FN = UCase(FN) : If Level = 1 Then Com = Replace(Com, "\n", Sep)
  With CreateObject("ADODB.Stream")
    .Mode = 3 : .Charset = En : .Open : .LoadFromFile F
    All = .ReadText : Find = InStr(All, FN & " ")
    If Find > 1 Then Find = InStr(All, vbLf & FN & " ") : T = 1
    NL = 0 : If Right(All, 1) <> vbLf Then NL = 1
    If Find Then
      FiEnd = Mid(All, Find + T) : Ln = Len(FN) + 2
      If Name = "descript.ion" Then
        Comm = Mid(FiEnd, Ln, InStr(FiEnd, vbNewLine) - Ln)
        S = "\n" : Ln = S : D = "В"
      Else : FiEnd = Mid(FiEnd, Ln) : D = vbnewline : S = Sep : Ln = vbNewLine
        For Each Str in Split(FiEnd, vbNewLine)
          If Cnt And InStr(Str, Space(31) & "| ") = 0 Then Exit For
          Cnt = Cnt + 1 : If Len(Str) Then L = L + Len(Str) + 2
        Next  : If L Then Comm = Left(FiEnd, L - 2) : L = L - 2
      End If
      If Level = 1 Then
        If FSO.FileExists(F) Or (FSO.FolderExists(F)_
        And Not IsNumeric(Trim(Comm))) Then E(0) = 1
        If Right(Comm, 2) = "В" Then Comm = Left(Comm, Len(Comm) - 2)
        If LCase(Comm) = LCase(Comt) Then .Close : WScript.Quit
        If Comm <> "" Then
          For Each Str in Split(Comm, S)
            Comt = Replace(S & Comt & S, S & Str & S, S)
          Next : Comt = Replace(Comt, S & S, "")
        End If : If Left(Comt, Len(S)) = S Then Comt = Mid(Comt, Len(S) + 1)
        If Right(Comt,Len(S)) = S Then Comt = Left(Comt, Len(Comt) - Len(S))
        If Comt = "" Then .Close : WScript.Quit
        Comm = Comm & S & Comt & D
      Else : Test = ""
        If Name = "files.bbs" Or (S = "\n" And InStr(Comm, "\n")) Then
          If InStr(Comm, Ln) Then Test = Left(Comm, InStr(Comm, Ln) - 1)
        Else Test = Comm End If
        If E(0) = "" Then
          If IsNumeric(Test) Then
             Test = Test + 1 : Comm = Test & Mid(Comm, Len(Test) + 1)
          Else Comm = 1 & S & Comm & D : End If
        End If
      End If : .Position = Find + Len(FN) + T : All = Mid(All, Find + T)
     .SetEOS : .WriteText Comm & Mid(All, InStr(All, vbNewLine) + L)
    Else
      If Level = 1 Then
        If Name = "descript.ion" And InStr(Comt, "\n") Then Comt = Comt & "В"
      Else Comt = 1 End If
      .Position = Len(All) : .WriteText FN & " " & Comt & vbNewLine, NL
    End If : Fl.Attributes = 32 : .SaveToFile F, 2 : .Close
  End With : If Name = "descript.ion" Then Fl.Attributes = 34
End Sub