'==========================================================================================
' Массовое Добавление\Удаление\Замена комментария (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) And (AllText <> "") 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, какой раз выручаешь... 
Просто камменты порой к файлам по размерам больше самого файла!
