Скрипт, полезный в случаях, когда необходимо быстро обработать комментарии для группы файлов/каталогов. Может применяться для "быстрой" подсветки файлов/каталогов - в 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
