Single Post - Добавить комментарий ко всем папкам с учётом пути

AddCommentToSelectedItemAndParentFolders.vbs

Code:

'===============================================================================
' Добавить/обновить комментарий для объекта под курсором и вышестоящих каталогов
' Условие: в опциях основных операций ТС должен быть снят флаг с "Кодировка 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