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

AddOrRenewComments.vbs

Code:

'===============================================================================
' Добавить/обновить комментарий для объекта под курсором и вышестоящих каталогов

' Параметр: %V [<комментарий к выш. каталогам>] [<комментарий к объекту(необ.)>]
' Примеры: %V select | %V <--> Green | %V >>>> "Red Color"

' Автор: Flasher ©
'===============================================================================
Option Explicit : Dim Arg, File, Com, ComC, Header, ChS, FiSplit, FSO,_
TCIni, Filt, Enc, Key, FCom1, FCom2, H, N, Path, c, F1, F2, ComF, PPath
Set Arg = WScript.Arguments : File = Arg(0) : If Arg.Count = 3 Then Com = Arg(2)
ComC = Arg(1) : Header = " Добавление комментария к файлу под курсором"
If Com = "" Then Com = InputBox(String(5, vbCr) & "Введите комментарий:", Header)
If Trim(Com) = "" Then WScript.Quit :End If: ChS = Array("windows-1251", "cp866")
FiSplit = Split(File, "\") : 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 N in FiSplit
Path = FSO.BuildPath(Path, N) & "\"
If Not IsEmpty(PPath) Then
c = c + 1 : F1 = PPath & FCom1 : F2 = PPath & FCom2
If c < Ubound(FiSplit) Then ComF = ComC Else ComF = Com
If FSO.FileExists(F1) Then
AddComment F1, N, 0
ElseIf FSO.FileExists(F2) Then AddComment F2, N, 1
Else
If FCom1 = "files.bbs" Then
N = UCase(N)
ElseIf InStr(N, " ") Then N = """" & N & """" End If
With CreateObject("ADODB.Stream")
.Open : .Charset = Enc : .WriteText N & " " & ComF & vbNewLine
.SaveToFile F1, 2 : .Close
End With : FSO.GetFile(F1).Attributes = 34 - H
End If
End If : PPath = Path
Next

Sub AddComment(F, FN, Test)
Dim Fl, Name, All, Find, Find2, T, NL
If Test Then
Select Case Enc : Case ChS(0) Enc = ChS(1)
Case ChS(1) Enc = ChS(0) End Select
End If : Set Fl = FSO.GetFile(F) : Fl.Attributes = 32 : Name = Fl.Name
If Name = "descript.ion" And InStr(FN, " ") Then FN = """" & FN & """"
If Name = "files.bbs" Then FN = UCase(FN)
With CreateObject("ADODB.Stream")
.Mode = 3 : .Charset = Enc : .Open
.LoadFromFile F : All = .ReadText : Find2 = InStr(All, FN & " " & ComF)
If Not Find2 Then
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
.Position = Find + Len(FN) + T : All = Mid(All, Find)
.SetEOS : .WriteText ComF & Mid(All, InStr(All, vbNewLine))
Else .Position = Len(All) : .WriteText FN & " " & ComF & vbNewLine, NL
End If : .SaveToFile F, 2
End If : .Close
End With : If Name = "descript.ion" Then Fl.Attributes = 34
End Sub