1 (изменено: dab00, 2011-08-07 22:28:09)

Тема: VBS: Удаление комментариев

Представляю вашему вниманию скрипт для удаления апострофа, пробелов, табуляций из файлов исходного кода VB.
Скрипт предлагает выбрать файл в диалоге и создает новый файл с префиксом "New-". Использует регулярные выражения, поэтому довольно шустрый. Может пригодится кому-нибудь.

Option Explicit

Dim ret
Dim objDialog 'диалог выбора файла

Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "Visual Basic files (*.vb;*.vbs)|*.vb;*.vbs|Все файлы (*.*)|*.*"
'открываем диалог
ret = objDialog.ShowOpen
'если файл не выбран - завершаем выполнение скрипта
If ret = 0 Then WScript.Quit 

'вызываем функцию удаления комментариев
ret = RemComm(objDialog.FileName)

Set objDialog = Nothing

'проверяем наличие ошибок
If ret Then
    MsgBox "Удаление комментариев завершено",vbInformation
Else 
    MsgBox "В процессе удаления произошла ошибка",vbExclamation
End If

Function RemComm(strFileName)
    On Error Resume Next
    Const strNewNamePref = "New-" 'префикс нового имени файла    
    Dim strReplPatrn 'щаблон для замены комментов для RexExp    
    Dim strNewFileName 'полное имя нового файла (с префиксом)    
    Dim objFile 'файл с кодом
    Dim objNewFile 'новый файл
    Dim i 'счетчик
    Dim strArr() 'массив для строк из файла с кодом    
    Dim fso 'файловая система
    Dim regEx 'регулярные выражения
    
    'собираем шаблон - комменты или символы табуляции
    strReplPatrn = "'[^" & Chr(34) & "]*$|\t" 
        
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    'открываем файл с кодом для чтения    
    Set objFile = fso.OpenTextFile(strFileName,1) 
    i = 0
    Do While objFile.AtEndOfStream <> True 'читаем файл
        ReDim Preserve strArr(i) 'перебиваем размерность массива        
        strArr(i) = Trim(objFile.ReadLine) 'закидываем строки в массив, удаляем пробелы
        i = i + 1        
    Loop
    objFile.Close 'закрываем файл
    Set objFile = Nothing 'удаляем ссылку на файл
    
    'собираем имя нового файла
    strNewFileName = fso.GetParentFolderName(strFileName) & "\" & strNewNamePref & fso.GetFileName(strFileName)
    
    'создаем новый файл, если существует - заменим    
    Set objNewFile = fso.CreateTextFile(strNewFileName,True)     
    'создаем регулярное выражение
    Set regEx = New RegExp 
    With regEx
        .Pattern = strReplPatrn 'определяем шаблон
        .Global = True   'устанавливаем глобальность применения
        .IgnoreCase = True  'устанавливаем нечувствительность к регистру
    End With        
    For i = 0 To UBound(strArr) 'бежим по массиву строк
        strArr(i) = regEx.Replace(strArr(i),"") 'удаляем комменты
        If strArr(i) <> vbNullString Then objNewFile.WriteLine strArr(i) 'пишем в файл, пропускаем пустые строки        
    Next
    objNewFile.Close 'закрываем файл
    Set objNewFile = Nothing 'удаляем ссылку на файл
    
    Set fso = Nothing
    Set regEx = Nothing
    
    'проверка наличия ошибок
    If Err.Number = 0 Then
        RemComm = True 'если нет ошибок        
    Else
        RemComm = False        
    End If
End Function

Поясню. Раньше удалял все после апострофа. Однако при работе, например, с таким кодом:

wmiServices.ExecQuery("ASSOCIATORS OF {Win32_DiskDrive.DeviceID='" _
        & DevID & "'} WHERE AssocClass = Win32_DiskDriveToDiskPartition")

косяк очевиден. Озадачился этим вопросом, решение выше.

2

Re: VBS: Удаление комментариев

Ну, что сказать? Очень даже неплохой код. Если интересно, на JS могу показать (лаконичнее).

3

Re: VBS: Удаление комментариев

Такой комментарий не будет убран:

'если файл не "выбран" - завершаем выполнение скрипта

Зачем удалять ведущие табуляцию, пробелы и пустые строки? Теряется всё форматирование. А вот оставлять пробелы после кода после удаления комментария не след:

4

Re: VBS: Удаление комментариев

alexii пишет:

Зачем удалять ведущие табуляцию, пробелы и пустые строки? Теряется всё форматирование.

Видимо удаление форматирования кода - попытка обфускации кода, обычно используемая в вебе для снижения трафика.

Может быть стоит сделать скрипт универсальнее? Есть проблема в Windows Vista Enterprise SP2:

Microsoft VBScript runtime error: ActiveX component can't create object: 'UserAccounts.CommonDialog'

Может быть имеет смысл сделать приложение полностью консольным:

cscript RemComm.vbs < commented.vbs > nocomments.vbs

тогда Ваш скрипт будет лаконичнее

( 2 * b ) || ! ( 2 * b )

5 (изменено: dab00, 2011-08-09 09:50:45)

Re: VBS: Удаление комментариев

alexii пишет:

Такой комментарий не будет убран:

'если файл не "выбран" - завершаем выполнение скрипта

Главное (для меня) что такой код останется на месте:

wmiServices.ExecQuery("ASSOCIATORS OF {Win32_DiskDrive.DeviceID='" _
        & DevID & "'} WHERE AssocClass = Win32_DiskDriveToDiskPartition")

Не вижу возможности их различить.
Для меня тут самым непростым была эта строка:

strReplPatrn = "'[^" & Chr(34) & "]*$|\t"

Честно - пару часов сочинял. Регулярные выражения - сила

Rumata пишет:

Видимо удаление форматирования кода - попытка обфускации кода

Видимо да. Если в коде несколько тысяч строк, комменты предпочитаю оставлять себе
В перспективе возможно реализую рандомизирование имен переменных и констант.

Rumata пишет:

Может быть имеет смысл сделать приложение полностью консольным

В своей предыдущей реинкарнации скрипт был в том числе и консольным.
Можно вернуть пару строчек:

Dim ret

If WScript.Arguments.Count = 0 Then
    Dim objDialog 'диалог выбора файла
    Set objDialog = CreateObject("UserAccounts.CommonDialog")
    objDialog.Filter = "Visual Basic files (*.vb;*.vbs)|*.vb;*.vbs|Все файлы (*.*)|*.*"
    'открываем диалог
    ret = objDialog.ShowOpen
    'если файл не выбран - завершаем выполнение скрипта
    If ret = 0 Then WScript.Quit 

    'вызываем функцию удаления комментариев
    'objDialog.FileName - полный путь к файлу
    ret = RemComm(objDialog.FileName)

    Set objDialog = Nothing
Else
    Dim wshShell
    Set wshShell = CreateObject("WScript.Shell")
    'вызываем функцию удаления комментариев
    'собираем путь файлу - добавляем к имени путь к текущему каталогу скрипта
    ret = RemComm(wshShell.CurrentDirectory & "\" & WScript.Arguments(0))
    Set wshShell = Nothing
End If

Наверное Вы правы, нужно вернуть консольный вариант на случай отсутствия диалога.
Предлагаю в консольном варианте в качестве аргумента передавать имя файла в текущем каталоге скрипта.
А если еще добавить проверку наличия файла (пользительно для консольного варианта), то получится вот так:

Option Explicit

Dim ret

If WScript.Arguments.Count = 0 Then
    Dim objDialog 'диалог выбора файла
    Set objDialog = CreateObject("UserAccounts.CommonDialog")
    objDialog.Filter = "Visual Basic files (*.vb;*.vbs)|*.vb;*.vbs|Все файлы (*.*)|*.*"
    'открываем диалог
    ret = objDialog.ShowOpen
    'если файл не выбран - завершаем выполнение скрипта
    If ret = 0 Then WScript.Quit 

    'вызываем функцию удаления комментариев
    'objDialog.FileName - полный путь к файлу
    ret = RemComm(objDialog.FileName)

    Set objDialog = Nothing
Else
    Dim wshShell
    Set wshShell = CreateObject("WScript.Shell")
    'вызываем функцию удаления комментариев
    'собираем путь файлу - добавляем к имени путь к текущему каталогу скрипта
    ret = RemComm(wshShell.CurrentDirectory & "\" & WScript.Arguments(0))
    Set wshShell = Nothing
End If

'проверяем наличие ошибок
If ret Then
    MsgBox "Удаление комментариев завершено",vbInformation
Else 
    MsgBox "В процессе удаления произошла ошибка",vbExclamation
End If

Function RemComm(strFileName)
    On Error Resume Next
    Const strNewNamePref = "New-" 'префикс нового имени файла    
    Dim strReplPatrn 'щаблон для замены комментов для RexExp    
    Dim strNewFileName 'полное имя нового файла (с префиксом)    
    Dim objFile 'файл с кодом
    Dim objNewFile 'новый файл
    Dim i 'счетчик
    Dim strArr() 'массив для строк из файла с кодом    
    Dim fso 'файловая система
    Dim regEx 'регулярные выражения
            
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    'поверяем наличие файла - пользительно для консольного варианта
    If Not fso.FileExists(strFileName) Then 
        RemComm = False
        Exit Function
    End If
    
    'собираем шаблон - комменты или символы табуляции
    strReplPatrn = "'[^" & Chr(34) & "]*$|\t" 
        
    'открываем файл с кодом для чтения    
    Set objFile = fso.OpenTextFile(strFileName,1) 
    i = 0
    Do While objFile.AtEndOfStream <> True 'читаем файл
        ReDim Preserve strArr(i) 'перебиваем размерность массива        
        strArr(i) = Trim(objFile.ReadLine) 'закидываем строки в массив, удаляем пробелы
        i = i + 1        
    Loop
    objFile.Close 'закрываем файл
    Set objFile = Nothing 'удаляем ссылку на файл
    
    'собираем имя нового файла
    strNewFileName = fso.GetParentFolderName(strFileName) & "\" & strNewNamePref & fso.GetFileName(strFileName)
    
    'создаем новый файл, если существует - заменим    
    Set objNewFile = fso.CreateTextFile(strNewFileName,True)     
    'создаем регулярное выражение
    Set regEx = New RegExp 
    With regEx
        .Pattern = strReplPatrn 'определяем шаблон
        .Global = True   'устанавливаем глобальность применения
        .IgnoreCase = True  'устанавливаем нечувствительность к регистру
    End With        
    For i = 0 To UBound(strArr) 'бежим по массиву строк
        strArr(i) = regEx.Replace(strArr(i),"") 'удаляем комменты
        If strArr(i) <> vbNullString Then objNewFile.WriteLine strArr(i) 'пишем в файл, пропускаем пустые строки        
    Next
    objNewFile.Close 'закрываем файл
    Set objNewFile = Nothing 'удаляем ссылку на файл
    
    Set fso = Nothing
    Set regEx = Nothing
    
    'проверка наличия ошибок
    If Err.Number = 0 Then
        RemComm = True 'если нет ошибок        
    Else
        RemComm = False        
    End If
End Function

6

Re: VBS: Удаление комментариев

dab00 пишет:

Не вижу возможности их различить.

В скриптах, чаще всего, комментарии бывают не столько комментарии, как таковые, сколько «отладочные комментарии», наподобие:

'strPath = "C:\Temp"
strPath = WScript.Arguments(0)

Так что — как-то надо.

dab00 пишет:

Предлагаю в консольном варианте в качестве аргумента передавать имя файла в текущем каталоге скрипта.

ret = RemComm(wshShell.CurrentDirectory & "\" & WScript.Arguments(0))

А вот это не надо. Текущий каталог и так будет использован при отсутствии пути. А если, напротив, путь будет указан? Так что — лишнее.

7 (изменено: dab00, 2011-08-09 10:34:56)

Re: VBS: Удаление комментариев

alexii пишет:

Так что — как-то надо.

Как? Есть варианты? Может искать после апострофа знак равенства? Совсем не обязательно...

alexii пишет:

А вот это не надо. Текущий каталог и так будет использован при отсутствии пути. А если, напротив, путь будет указан? Так что — лишнее.

Текущий каталог будет использован, а вот какой каталог будет использован для создания нового файла? Ищи его потом

Rumata пишет:

Есть проблема в Windows Vista Enterprise SP2:

Microsoft VBScript runtime error: ActiveX component can't create object: 'UserAccounts.CommonDialog'

Оказывается в Висте нет CommonDialog, значит здесь косяк - использовал этот диалог для выбора reg-файла. Интересно, а в 7 есть? Надо проверить.

8

Re: VBS: Удаление комментариев

dab00 пишет:

Как? Есть варианты?

Варианты точно есть. Ибо сам WSH умеет определять такую конструкцию, как комментарий. Тот же Colorer так же верно это понимает. Даже прикрученный сюда Geshi не спотыкается на таком комментарии.

dab00 пишет:

Текущий каталог будет использован, а вот какой каталог будет использован для создания нового файла? Ищи его потом

А Вы попробуйте.

9 (изменено: dab00, 2011-08-09 10:39:02)

Re: VBS: Удаление комментариев

alexii пишет:

А Вы попробуйте.

Пробовал, у меня почему-то в корне диска новый файл создается.

Colorer - интересно, спасибо. На счет  Geshi не понял.

10

Re: VBS: Удаление комментариев

dab00 пишет:

Оказывается в Висте нет CommonDialog, значит здесь косяк - использовал этот диалог для выбора reg-файла. Интересно, а в 7 есть? Надо проверить.

Тоже нет.

11

Re: VBS: Удаление комментариев

dab00 пишет:

Пробовал, у меня почему-то в корне диска новый файл создается.

А у меня — всегда в текущем каталоге. Который вполне может отличаться как от каталога скрипта, так и от каталога файла, указанного аргументом скрипта. Если нужно создавать файл в том же каталоге, где находится файл, указанный аргументом скрипта — нужно использовать метод «.GetAbsolutePathName()» объекта «Scripting.FileSystemObject», затем получать от него путь посредством «.GetParentFolderName()» и, наконец, склеивать с именем посредством «.BuildPath()».

12

Re: VBS: Удаление комментариев

alexii пишет:

Тоже нет.

Тогда так:

Dim objDialog 'диалог выбора файла        
    Set objDialog = CreateObject("SAFRCFileDlg.FileOpen")
    
    'открываем диалог    
    ret = objDialog.OpenFileOpenDlg
    
    'если файл не выбран - завершаем выполнение скрипта
    If CInt(ret) = 0 Then WScript.Quit 

    'вызываем функцию удаления комментариев
    'objDialog.FileName - полный путь к файлу
    ret = RemComm(objDialog.FileName)

    Set objDialog = Nothing

Надеюсь SAFRCFileDlg в Висте и 7 есть.

13 (изменено: dab00, 2011-08-09 12:09:15)

Re: VBS: Удаление комментариев

alexii пишет:

и, наконец, склеивать с именем посредством «.BuildPath()».

Странно, заменил

strNewFileName = fso.GetParentFolderName(strFileName) & "\" & strNewNamePref & fso.GetFileName(strFileName)

на

strNewFileName = fso.BuildPath(fso.GetParentFolderName(strFileName), strNewNamePref & fso.GetFileName(strFileName))

, что, как мне кажется, одно и то же, новый файл стал создаваться в правильном каталоге, а до этого в случае консольного запуска создавался в корне.
Спасибо, alexii
Текущий вариант (с учетом замечаний):

Option Explicit

Dim ret

If WScript.Arguments.Count = 0 Then
    Dim objDialog 'диалог выбора файла        
    Set objDialog = CreateObject("SAFRCFileDlg.FileOpen")
    
    'открываем диалог    
    ret = objDialog.OpenFileOpenDlg
    
    'если файл не выбран - завершаем выполнение скрипта
    If CInt(ret) = 0 Then WScript.Quit 

    'вызываем функцию удаления комментариев
    'objDialog.FileName - полный путь к файлу
    ret = RemComm(objDialog.FileName)

    Set objDialog = Nothing
Else    
    'вызываем функцию удаления комментариев с аргументом скрипта        
    ret = RemComm(WScript.Arguments(0))    
End If

'проверяем наличие ошибок
If ret Then
    MsgBox "Удаление комментариев завершено",vbInformation
Else 
    MsgBox "В процессе удаления произошла ошибка",vbExclamation
End If

Function RemComm(strFileName)
    On Error Resume Next
    Const strNewNamePref = "New-" 'префикс нового имени файла    
    Dim strReplPatrn 'щаблон для замены комментов для RexExp    
    Dim strNewFileName 'полное имя нового файла (с префиксом)    
    Dim objFile 'файл с кодом
    Dim objNewFile 'новый файл
    Dim i 'счетчик
    Dim strArr() 'массив для строк из файла с кодом    
    Dim fso 'файловая система
    Dim regEx 'регулярные выражения
            
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    'поверяем наличие файла - пользительно для консольного варианта
    If Not fso.FileExists(strFileName) Then 
        RemComm = False
        Exit Function
    End If
    
    'собираем шаблон - комменты или символы табуляции
    strReplPatrn = "'[^" & Chr(34) & "]*$|\t" 
        
    'открываем файл с кодом для чтения    
    Set objFile = fso.OpenTextFile(strFileName,1) 
    i = 0
    Do While objFile.AtEndOfStream <> True 'читаем файл
        ReDim Preserve strArr(i) 'перебиваем размерность массива        
        strArr(i) = Trim(objFile.ReadLine) 'закидываем строки в массив, удаляем пробелы
        i = i + 1        
    Loop
    objFile.Close 'закрываем файл
    Set objFile = Nothing 'удаляем ссылку на файл
    
    'собираем имя нового файла    
    strNewFileName = fso.BuildPath(fso.GetParentFolderName(strFileName), strNewNamePref & fso.GetFileName(strFileName)) 
    
    'создаем новый файл, если существует - заменим    
    Set objNewFile = fso.CreateTextFile(strNewFileName,True)     
    'создаем регулярное выражение
    Set regEx = New RegExp 
    With regEx
        .Pattern = strReplPatrn 'определяем шаблон
        .Global = True   'устанавливаем глобальность применения
        .IgnoreCase = True  'устанавливаем нечувствительность к регистру
    End With        
    For i = 0 To UBound(strArr) 'бежим по массиву строк
        strArr(i) = regEx.Replace(strArr(i),"") 'удаляем комменты
        If strArr(i) <> vbNullString Then objNewFile.WriteLine strArr(i) 'пишем в файл, пропускаем пустые строки        
    Next
    objNewFile.Close 'закрываем файл
    Set objNewFile = Nothing 'удаляем ссылку на файл
    
    Set fso = Nothing
    Set regEx = Nothing
    
    'проверка наличия ошибок
    If Err.Number = 0 Then
        RemComm = True 'если нет ошибок        
    Else
        RemComm = False        
    End If
End Function

14

Re: VBS: Удаление комментариев

dab00 пишет:

Надеюсь SAFRCFileDlg в Висте и 7 есть.

: VBS: диалоговое окно выбора файла в windows vista & 7

15

Re: VBS: Удаление комментариев

Перед «.GetParentFolderName()» желательно использовать «.GetAbsolutePathName()». Т.е., вместо:

strNewFileName = fso.BuildPath(fso.GetParentFolderName(strFileName), strNewNamePref & fso.GetFileName(strFileName))

примерно на:

strFullFileName = fso.GetAbsolutePathName(strFileName)
strNewFileName = fso.BuildPath(fso.GetParentFolderName(strFullFileName), strNewNamePref & fso.GetFileName(strFullFileName))

потому как аргументом может быть передан полный, относительный путь или вообще без пути (одно имя файла).

16

Re: VBS: Удаление комментариев

Тестовый запуск

cscript vbsqueeze.vbs < vbsqueeze.vbs

Исходный код с некоторой долей комментариев, которые удаляются, пустые строки не сохраняются в выходном потоке, все начальные и конечные пробелы корректно удаляются (в отличие ущербной функции Trim)


Option Explicit

' Функция удаления комментариев из входной строки
'
' @param  String
' @return String
Function NoComments(input)
	Dim parts
	Dim i
	Dim p

	' "Режем" строку по двойным кавычкам...
	parts = Split(input, Chr(34))

	' ... проверяем каждый четный элемент на наличие апострофа
	For i = LBound(parts) To UBound(parts) Step 2
		' ... нашли апостроф - это комментарий
		p = InStr(parts(i), "'")
		If p Then
			' ... удалим остаток строки
			parts(i) = Left(parts(i), p - 1)
			Redim Preserve parts(i)
			Exit For
		End If
	Next

	' Восстановим строку, склеив массив двойными кавычками
	NoComments = Join(parts, Chr(34))
End Function

' Регулярное выражение для удаления всех "проблеов" в строке
' (пробелы, табуляция, переводы строк)
Dim re
Set re = new RegExp
re.Pattern = "^\s+|\s+$"
re.Global = True

Dim inp
Dim out
Dim line

' Работаем со стандартными вводом и выводом
Set inp = WScript.StdIn
Set out = WScript.StdOut

Do While inp.AtEndOfStream <> True
	line = inp.ReadLine

	' Удаляем комментарии
	line = NoComments(line)

	' Функция Trim не работает
	'line = Trim(line)
	line = re.Replace(line, "")

	' Пустые строки не пишем
	If line <> "" Then
		out.WriteLine line
	End If
Loop

WScript.Quit

' Несколько тестовых строк
'Dim test : test = "'" ' комментарий внутри закомментированной тестовой строки
''если файл не "выбран" - завершаем выполнение скрипта

wmiServices.ExecQuery("ASSOCIATORS OF {Win32_DiskDrive.DeviceID='" _
	& DevID & "'} WHERE AssocClass = Win32_DiskDriveToDiskPartition") ' test string

wmiServices.ExecQuery("ASSOCIATORS OF {Win32_DiskDrive.DeviceID='" & DevID & "'} WHERE AssocClass = Win32_DiskDriveToDiskPartition")
( 2 * b ) || ! ( 2 * b )

17 (изменено: dab00, 2011-08-09 12:56:59)

Re: VBS: Удаление комментариев

alexii пишет:
dab00 пишет:

Надеюсь SAFRCFileDlg в Висте и 7 есть.

: VBS: диалоговое окно выбора файла в windows vista & 7

весело

alexii пишет:

Перед «.GetParentFolderName()» желательно использовать «.GetAbsolutePathName()», потому как аргументом может быть передан полный, относительный путь или вообще без пути (одно имя файла).

Попробовал полный, без пути - без проблем. Вы допускаете, что у файла может не оказаться ParentFolder?

18

Re: VBS: Удаление комментариев

dab00 пишет:
wmiServices.ExecQuery("ASSOCIATORS OF {Win32_DiskDrive.DeviceID='" _
        & DevID & "'} WHERE AssocClass = Win32_DiskDriveToDiskPartition")

Не вижу возможности их различить.
Для меня тут самым непростым была эта строка:

strReplPatrn = "'[^" & Chr(34) & "]*$|\t"

Честно - пару часов сочинял. Регулярные выражения - сила

Это тот случай когда регулярное выражение не поможет. Только посимвольный перебор или какие-либо частные решения.

( 2 * b ) || ! ( 2 * b )

19

Re: VBS: Удаление комментариев

Rumata пишет:

Это тот случай когда регулярное выражение не поможет. Только посимвольный перебор или какие-либо частные решения.

Я тоже так думаю.

20

Re: VBS: Удаление комментариев

Rumata пишет:

Исходный код с некоторой долей комментариев, которые удаляются, пустые строки не сохраняются в выходном потоке, все начальные и конечные пробелы корректно удаляются (в отличие ущербной функции Trim)

Не слышал об ущербности Trim, на мой взгляд Trim вполне справляется.

21

Re: VBS: Удаление комментариев

dab00 пишет:

Вы допускаете, что у файла может не оказаться ParentFolder?

Не допускаю:

Option Explicit

Dim strFile
Dim objFSO


strFile = WScript.Arguments(0)
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")


WScript.Echo strFile

With objFSO
    WScript.Echo .GetAbsolutePathName(strFile)
    WScript.Echo .GetParentFolderName(.GetAbsolutePathName(strFile))
End With

WScript.Quit 0
C:\0012>0002.vbs c:\boot.ini
c:\boot.ini
C:\boot.ini
C:\
C:\>C:\0012\0002.vbs boot.ini
boot.ini
C:\boot.ini
C:\

22 (изменено: dab00, 2011-08-09 15:45:05)

Re: VBS: Удаление комментариев

alexii пишет:

Не допускаю:

D:\>D:\0012\0002.vbs boot.ini
boot.ini
D:\boot.ini
D:\

А GetParentFolderName(strFile) дает пустую строку. Похоже Вы правы
Заменил

fso.BuildPath(fso.GetParentFolderName(strFileName), strNewNamePref & fso.GetFileName(strFileName))

на

fso.BuildPath(fso.GetParentFolderName(fso.GetAbsolutePathName(strFileName)), strNewNamePref & fso.GetFileName(strFileName))

Вернулся к варианту использования UserAccounts.CommonDialog
Если правильно понял - проблема может быть в отсутствии COMDLG32.OCX. Проще поймать ошибку и посоветовать использовать консольный режим, чем проверять наличие либы, копировать в случае отсутствия, регистрировать, решать проблему с лицензированием...
Сделал так:

Set objDialog = CreateObject("UserAccounts.CommonDialog")
    If Not IsObject(objDialog) Then 
        MsgBox "Не удалось создать диалоговое окно" & vbCrLf & _
                "Используйте консольный режим",vbExclamation
        WScript.Quit
    End If

23

Re: VBS: Удаление комментариев

dab00 пишет:
Rumata пишет:

Исходный код с некоторой долей комментариев, которые удаляются, пустые строки не сохраняются в выходном потоке, все начальные и конечные пробелы корректно удаляются (в отличие ущербной функции Trim)

Не слышал об ущербности Trim, на мой взгляд Trim вполне справляется.

Перенесите комментарий со строки с Trim на строку re.Replace, сравните результат.

Вот еще описание - сравните (выделено мной)
http://msdn.microsoft.com/en-us/library … 85%29.aspx

Returns a copy of a string without ... leading and trailing spaces (Trim).

http://php.net/trim

trim — Strip whitespace (or other characters) from the beginning and end of a string

Может быть сработал стереотип, и я по привычке считаю, что trim должен удалять все пробельные символы, как это принято в других языках?

( 2 * b ) || ! ( 2 * b )

24 (изменено: dab00, 2011-08-09 14:45:45)

Re: VBS: Удаление комментариев

Rumata пишет:

Может быть сработал стереотип, и я по привычке считаю, что trim должен удалять все пробельные символы, как это принято в других языках?

Trim удаляет пробелы с обоих сторон строки - "leading and trailing", а в Вашем коде испольуется метод регулярного выражения Replace, который заменяет текст, найденный с помощью регулярного выражения - в Вашем случае ВСЕ пробелы в строке удаляются.

25

Re: VBS: Удаление комментариев

Возражу
Я акцентировал внимание на словах space и whitespace. trim удаляет именно whitespaces (пробелы, табуляции, переносы строк), а не только spaces (пробелы). Это - ожидаемое действие, удаление только пробелов - неожиданный результат.

в Вашем случае ВСЕ пробелы в строке удаляются

Нет. Только начальные и конечные.

( 2 * b ) || ! ( 2 * b )

26 (изменено: dab00, 2011-08-09 16:38:11)

Re: VBS: Удаление комментариев

Rumata пишет:

Я акцентировал внимание на словах space и whitespace

по Вашей ссылке - про PHP, по другой - самое оно - "leading and trailing spaces"

Rumata пишет:

Нет. Только начальные и конечные.

Сорри, Pattern не прочитал
Благодаря вашим замечаниям в настоящий момент код такой:

Option Explicit
On Error Resume Next

Dim ret

If WScript.Arguments.Count = 0 Then
    Dim objDialog 'диалог выбора файла        
    'Set objDialog = CreateObject("SAFRCFileDlg.FileOpen")    
    Set objDialog = CreateObject("UserAccounts.CommonDialog")
    If Not IsObject(objDialog) Then 
        MsgBox "Не удалось создать диалоговое окно" & vbCrLf & _
                "Используйте консольный режим",vbExclamation
        WScript.Quit
    End If
    
    objDialog.Filter = "Visual Basic files (*.vb;*.vbs)|*.vb;*.vbs|Все файлы (*.*)|*.*"    
    
    'открываем диалог    
    'ret = objDialog.OpenFileOpenDlg
    ret = objDialog.ShowOpen
    
    'если файл не выбран - завершаем выполнение скрипта
    If CInt(ret) = 0 Then WScript.Quit 

    'вызываем функцию удаления комментариев
    'objDialog.FileName - полный путь к файлу
    ret = RemComm(objDialog.FileName)

    Set objDialog = Nothing    
Else    
    'вызываем функцию удаления комментариев с аргументом скрипта        
    ret = RemComm(WScript.Arguments(0))    
End If

'проверяем наличие ошибок
If ret Then
    MsgBox "Удаление комментариев завершено",vbInformation
Else 
    MsgBox "В процессе удаления произошла ошибка",vbExclamation
End If

Function RemComm(strFileName)
    On Error Resume Next
    Const strNewNamePref = "New-" 'префикс нового имени файла    
    Dim strReplPatrn 'щаблон для замены комментов для RexExp    
    Dim strNewFileName 'полное имя нового файла (с префиксом)    
    Dim objFile 'файл с кодом
    Dim objNewFile 'новый файл
    Dim i 'счетчик
    Dim strArr() 'массив для строк из файла с кодом    
    Dim fso 'файловая система
    Dim regEx 'регулярные выражения
            
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    'поверяем наличие файла - пользительно для консольного варианта
    If Not fso.FileExists(strFileName) Then 
        RemComm = False
        Exit Function
    End If
    
    'собираем шаблон - комменты или символы табуляции
    strReplPatrn = "'[^" & Chr(34) & "]*$|\t" 
        
    'открываем файл с кодом для чтения    
    Set objFile = fso.OpenTextFile(strFileName,1) 
    i = 0
    Do While objFile.AtEndOfStream <> True 'читаем файл
        ReDim Preserve strArr(i) 'перебиваем размерность массива        
        strArr(i) = Trim(objFile.ReadLine) 'закидываем строки в массив, удаляем пробелы
        i = i + 1        
    Loop
    objFile.Close 'закрываем файл
    Set objFile = Nothing 'удаляем ссылку на файл
    
    'собираем имя нового файла    
    'strNewFileName = fso.BuildPath(fso.GetParentFolderName(strFileName), strNewNamePref & fso.GetFileName(strFileName))     
    strNewFileName = fso.BuildPath(fso.GetParentFolderName(fso.GetAbsolutePathName(strFileName)), strNewNamePref & fso.GetFileName(strFileName))     
    
    'создаем новый файл, если существует - заменим    
    Set objNewFile = fso.CreateTextFile(strNewFileName,True)     
    'создаем регулярное выражение
    Set regEx = New RegExp 
    With regEx
        .Pattern = strReplPatrn 'определяем шаблон
        .Global = True   'устанавливаем глобальность применения
        .IgnoreCase = True  'устанавливаем нечувствительность к регистру
    End With        
    For i = 0 To UBound(strArr) 'бежим по массиву строк
        strArr(i) = regEx.Replace(strArr(i),"") 'удаляем комменты
        If strArr(i) <> vbNullString Then objNewFile.WriteLine strArr(i) 'пишем в файл, пропускаем пустые строки        
    Next
    objNewFile.Close 'закрываем файл
    Set objNewFile = Nothing 'удаляем ссылку на файл
    
    Set fso = Nothing
    Set regEx = Nothing
    
    'проверка наличия ошибок
    If Err.Number = 0 Then
        RemComm = True 'если нет ошибок        
    Else
        RemComm = False        
    End If
End Function

27

Re: VBS: Удаление комментариев

Ещё одно есть "замечание": в vbs скриптах комментарий ещё можно указать с помощью слова "Rem". Например:

Rem Wscript.Echo "Это в комментарии"
Wscript.Echo "А это нет"

Но это редкий случай.

В основе всего лежит простота.

28

Re: VBS: Удаление комментариев

Felix Faria, а кстати — да, Вы правы. Странно, что никто об этом донесь не вспомнил.

29 (изменено: dab00, 2011-08-09 20:27:27)

Re: VBS: Удаление комментариев

Felix Faria пишет:

Ещё одно есть "замечание": в vbs скриптах комментарий ещё можно указать с помощью слова "Rem"

Спасибо, я в курсе, для себя скрипт делал - пользуюсь апострофом. Сомневаюсь, что кто-нибудь использует rem.
Хотя в моем любимом Notepad++ есть команда "Добавить/Удалить комментарий" в меню "Правка" и я ее не использую только потому, что блоки кода комментятся именно при помощи rem.
В общем можно добавить в паттерн для RegEx удаление всего после rem.

'собираем шаблон - апостроф (если за ним не следуют кавычки) или символ табуляции или слово rem
    strReplPatrn = "'[^" & Chr(34) & "]*$|\t|\brem\b.*$"

30 (изменено: dab00, 2011-08-10 00:07:49)

Re: VBS: Удаление комментариев

Еще немного подмолодил код. Теперь можно выбрать несколько файлов или прописать имена файлов в аргументе скрипта.
В качестве аргумента можно передавать: полные, относительные пути, только имена файлов - спасибо alexii.
Пробелы теперь удаляются с помощью RegExp - Rumata убедил . На самом деле RegExp по-моему шустрее должен работать.
Комментарии rem тоже удаляются - Felix Faria напомнил о существовании таких.
В завершение работы отображается сообщение с отчетом об удалении комментов из каждого файла.

Option Explicit
On Error Resume Next

Const strNewNamePref = "New-" 'префикс нового имени файла    
Dim strReplPatrn 'шаблон для замены комментов для RexExp

Dim fso, ret
Dim j, mesaga

'собираем шаблон - апостроф (если за ним не следуют кавычки) или символ табуляции или слово rem или пробелы в начале строки или в конце
strReplPatrn = "'[^" & Chr(34) & "]*$|\t|\brem\b.*$|^\s+|\s+$"

Set fso = CreateObject("Scripting.FileSystemObject")

If WScript.Arguments.Count = 0 Then
    Dim objDialog 'диалог выбора файла    
    Set objDialog = CreateObject("UserAccounts.CommonDialog")
    If Not IsObject(objDialog) Then 
        MsgBox "Не удалось создать диалоговое окно" & vbCrLf & _
                "Используйте консольный режим",vbExclamation
        Set fso = Nothing
        WScript.Quit
    End If
    
    objDialog.Flags = &H0200 'возможность выбрать несколько файлов
    objDialog.Filter = "Visual Basic files (*.vb;*.vbs)|*.vb;*.vbs|Все файлы (*.*)|*.*"    
    
    'открываем диалог    
    ret = objDialog.ShowOpen    
    
    'если файл не выбран - завершаем выполнение скрипта    
    If Not ret Then WScript.Quit 
        
    'вызываем функцию удаления комментариев    с массивом имен выбранных файлов
    ret = RemComm(Split(Trim(fso.GetFileName(objDialog.FileName))),fso,strNewNamePref,strReplPatrn)
    
    Set objDialog = Nothing    
Else    
    'вызываем функцию удаления комментариев с коллекцией аргументов скрипта        
    ret = RemComm(WScript.Arguments,fso,strNewNamePref,strReplPatrn)    
End If

Set fso = Nothing

'вывод информации о ходе выполнения
mesaga = "Журнал:"
For j = 0 To UBound(ret,2)
    mesaga = mesaga & vbCrLf & ret(0,j) & " - " & ret(1,j)
Next
MsgBox mesaga,vbInformation

Function RemComm(arrFiles,fso,strNewNamePref,strReplPatrn)
    On Error Resume Next        
    Dim strNewFileName 'полное имя нового файла (с префиксом)    
    Dim objFile 'файл с кодом
    Dim objNewFile 'новый файл    
    Dim strArr() 'массив для строк из файла с кодом    
    Dim arrRemComm() 'массив для лога    
    Dim strFilePath 'путь к файлу кода    
    Dim strFile 'имя файла в коллекции
    Dim i    
    Dim regEx 'регулярные выражения    
    
    'создаем регулярное выражение
    Set regEx = New RegExp 
    With regEx
        .Pattern = strReplPatrn 'определяем шаблон
        .Global = True   'устанавливаем глобальность применения
        .IgnoreCase = True  'устанавливаем нечувствительность к регистру
    End With
    
    j = 0
    For Each strFile In arrFiles
        'собираем путь к файлу
        strFilePath = fso.BuildPath(fso.GetParentFolderName(fso.GetAbsolutePathName(strFile)), fso.GetFileName(strFile))            
        
        'поверяем наличие файла - пользительно для консольного варианта
        If Not fso.FileExists(strFilePath) Then             
            Redim Preserve arrRemComm(1,j)
            arrRemComm(0,j) = strFilePath
            arrRemComm(1,j) = "Файл не найден"
            j = j + 1
        Else                
            'открываем файл с кодом для чтения    
            Set objFile = fso.OpenTextFile(strFilePath,1) 
            i = 0
            Do While objFile.AtEndOfStream <> True 'читаем файл
                ReDim Preserve strArr(i) 'перебиваем размерность массива                
                strArr(i) = objFile.ReadLine 'закидываем строки в массив
                i = i + 1        
            Loop
            objFile.Close 'закрываем файл
            Set objFile = Nothing 'удаляем ссылку на файл
            
            'собираем имя нового файла                    
            strNewFileName = fso.BuildPath(fso.GetParentFolderName(fso.GetAbsolutePathName(strFilePath)), strNewNamePref & fso.GetFileName(strFilePath))     
            
            'создаем новый файл, если существует - заменим    
            Set objNewFile = fso.CreateTextFile(strNewFileName,True)                     
            For i = 0 To UBound(strArr) 'бежим по массиву строк
                strArr(i) = regEx.Replace(strArr(i),"") 'удаляем комменты
                If strArr(i) <> vbNullString Then objNewFile.WriteLine strArr(i) 'пишем в файл, пропускаем пустые строки        
            Next
            objNewFile.Close 'закрываем файл
            Set objNewFile = Nothing 'удаляем ссылку на файл
            
            Redim Preserve arrRemComm(1,j)
            arrRemComm(0,j) = strFilePath
            If Err.Number = 0 Then
                arrRemComm(1,j) = "Успех"
            Else
                arrRemComm(1,j) = "Ошибка"
            End If
            j = j + 1
        End If    
    Next    
    Set regEx = Nothing
    
    RemComm = arrRemComm    
End Function

Скрипт, добавляющий осмысленные комментарии и раскрывающий тайные замыслы создателя мне не по силам

31 (изменено: dab00, 2011-08-14 16:17:11)

Re: VBS: Удаление комментариев

Изменил шаблон на:

strReplPatrn = "^\s*'.*$|'[^" & Chr(34) & "]*$|\brem\b.*$|^\s+|\s+$"

\t был лишний - входитв состав \s
Похоже теперь удаляются все комменты, даже такие:

'если файл не "выбран" - завершаем выполнение скрипта

Время будет - нарисую HTML-приложение.
Добавлю переименование переменных, констант, функций, процедур.
Пока написал функцию получения случайного имени. Осталось написать алгоритм нахождения имени переменной (функции, процедуры) в коде и замены на случайное + нарисовать интерфейс.
Нашел что-то похожее, просят 279 бакинских. Я потрясен

32 (изменено: dab00, 2011-08-18 12:55:40)

Re: VBS: Удаление комментариев

VBShaker. "Смешать, но не взбалтывать"
Представляю очередную реинкарнацию скрипта для преображения кода VB.
Возможности:
- удаление комментариев, пробелов, табуляций, переноса строк
- переименование функций, процедур, классов, свойств, методов, явно объявленных переменных, констант (только VBS)
В графическом режиме позволяет выбрать несколько файлов.
В консольном режиме принимает в качестве аргументов абсолютные, относительные пути или только имена файлов.
В секции объявления переменных можно изменить:
- максимальную длину нового случайного имени в символах
- процент символов алфавита в новом случайном имени
- необходимость переименования переменных и пр.
- необходимость создания файла журнала переименования
- префикс нового имени файла
- суффикс имени файла лога
Скрипт создает в каталоге с файлом исходного кода новый файл с указанным префиксом, а также, в случае необходимости, CSV-файл с отчетом о переименованных переменных и пр., в завершение работы отображает сообщение с отчетом о результате работы с каждым файлом.
Прошу заценить.

Option Explicit
    On Error Resume Next
    Const strNewNamePref = "New" 'префикс нового имени файла    
    Const intMaxLen = 11 'максимальная длина имени в символах (Const-1)
    Const intPro = 60 'процент символов алфавита в новом рандомизированном имени    
    Const bStir = True ' необходимость взбалтывания имен переменных, False - не взбалтываем :)
    Const bWriteLog = False 'необходимость создания файла журнала переименования, False - не создаем    
    Dim fso, ret
    Dim i, mesaga    
    Dim strNewLogSuf 'суффикс имени файла лога
    strNewLogSuf = "-log-" & Date() & ".csv" 
    
    '************** шаблоны **************
    Dim strRemoveCommentsPattern
    'шаблон удаления комментариев
    strRemoveCommentsPattern = _
            "^\s*(?:'|\brem\b).*$|(?:'|\brem\b)[^" & Chr(34) & "]*$|^\s+|\s+$"
    'шаблон объединения строк - символ подчеркивания в конце строки
    Dim strFindJumpPattern
    strFindJumpPattern = "_$" 
    'шаблон для поиска строк с объявлениями
    Dim strGetVarNameTestPattern
    strGetVarNameTestPattern = _
            "\b(?:sub|function|public|static|private|dim|const|class|property)\s+.*"
    'шаблон для удаления из строк с объявлениями
    Dim strGetVarNameReplacePattern
    strGetVarNameReplacePattern = _
            "\b(?:sub|function|public|static|private|dim|const|class|property|get|let|set)\b|\(|\)|,|\t|=.*$"
    
    Const ClassIni = "Class_Initialize" 'строка инициализации класса
    Const ClassTerm = "Class_Terminate" 'строка удаления класса
    '**************************************
    
    Dim strArr() 'массив для строк из файла с кодом    
    Dim strNameArr() 'массив имен переменных
    Redim strNameArr(2,0) 'необходимо инициализировать, переменные начнутся с индекса №1
    Dim CharArray 'массив символов - алфавит :)    
    CharArray = Array("a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z")            

    Set fso = CreateObject("Scripting.FileSystemObject")

    If WScript.Arguments.Count = 0 Then
        Dim objDialog 'диалог выбора файла    
        Set objDialog = CreateObject("UserAccounts.CommonDialog")
        If Not IsObject(objDialog) Then 
            MsgBox "Не удалось создать диалоговое окно" & vbCrLf & _
                    "Используйте консольный режим",vbExclamation
            Set fso = Nothing
            WScript.Quit
        End If
        
        objDialog.Flags = &H0200 'возможность выбрать несколько файлов
        objDialog.Filter = "Visual Basic files (*.vb;*.vbs)|*.vb;*.vbs|Все файлы (*.*)|*.*"    
        
        'открываем диалог    
        ret = objDialog.ShowOpen    
        
        'если файл не выбран - завершаем выполнение скрипта    
        If Not ret Then 
            Set fso = Nothing
            WScript.Quit             
        End If
            
        'вызываем функцию удаления с массивом имен выбранных файлов
        ret = RemComm(Split(Trim(fso.GetFileName(objDialog.FileName))))
        
        Set objDialog = Nothing    
    Else    
        'вызываем функцию удаления с коллекцией аргументов скрипта        
        ret = RemComm(WScript.Arguments)    
    End If
    
    Set fso = Nothing
        
    'вывод информации о ходе выполнения
    mesaga = "Журнал:"
    For i = 0 To UBound(ret,2)
        mesaga = mesaga & vbCrLf & ret(0,i) & " - " & ret(1,i)
    Next
    MsgBox mesaga,vbInformation

'удаление комментариев, переименование переменных и пр.
Function RemComm(arrFiles)
    On Error Resume Next        
    Dim arrRemComm() 'массив для лога    
    Dim strFilePath 'путь к файлу кода    
    Dim strFile 'имя файла в коллекции    
    Dim regEx 'регулярные выражения    
    Dim ret(5) 'возвращенное значение
    Dim i, j
    'создаем регулярное выражение
    Set regEx = New RegExp 
    With regEx        
        .Global = True   'устанавливаем глобальность применения
        .IgnoreCase = True  'устанавливаем нечувствительность к регистру
    End With
    
    i = 0
    For Each strFile In arrFiles
        'собираем путь к файлу
        strFilePath = fso.BuildPath(fso.GetParentFolderName(fso.GetAbsolutePathName(strFile)), fso.GetFileName(strFile))            
        
        'поверяем наличие файла - пользительно для консольного варианта
        If Not fso.FileExists(strFilePath) Then             
            Redim Preserve arrRemComm(1,i)
            arrRemComm(0,i) = strFilePath
            arrRemComm(1,i) = "Файл не найден"            
        Else                
            'читаем файл - отправляем путь
            ret(1) = ReadFile(regEx,strFilePath)            
            
            If bStir Then 'проверяем необходимость переименования переменных
            
                'извлекаем имена функций, процедур, переменных, классов и пр.
                'в public переменную strNameArr
                ret(2) = GetVarName(regEx)            
                
                'переименуем переменные
                ret(3) = RenameVar(regEx)                
            
            End If
            
            'пишем в новый файл
            ret(4) = WriteFile(strFilePath)
            
            'складываем коды выполнения
            Redim Preserve arrRemComm(1,i)
            arrRemComm(0,i) = strFilePath            
            ret(0) = Err.Number
            For j = 1 To UBound(ret)
                ret(0) = ret(0) + ret(j)
            Next            
            'проверяем наличие ошибок
            If Not ret(0) Then
                arrRemComm(1,i) = "Успех"
            Else
                arrRemComm(1,i) = "Ошибка"
            End If            
        End If
        i = i + 1
    Next    
    Set regEx = Nothing
    
    RemComm = arrRemComm    
End Function

'чтение файла и удаление комментариев
Function ReadFile(regEx,strFilePath)
    On Error Resume Next
    Dim objFile 'файл с кодом
    Dim i
    'открываем файл с кодом для чтения    
    Set objFile = fso.OpenTextFile(strFilePath,1) 
    i = 0            
    Do While objFile.AtEndOfStream <> True 'читаем файл                
        ReDim Preserve strArr(i) 'перебиваем размерность массива
        'закидываем строки в массив и по ходу удаляем комменты
        strArr(i) = RemoveComments(regEx,objFile.ReadLine)
        
        If i <> 0 Then
            'если в конце предыдущей строки есть символ переноса строки -
            If FindJump(regEx,strArr(i-1)) Then 
                'объединяем строку с предыдущей
                strArr(i-1) = Left(strArr(i-1),Len(strArr(i-1))-1) & strArr(i) 
                Redim Preserve strArr(i-1) 'уменьшаем массив
            Else 'если нет символа переноса - продолжаем увеличивать массив
                i = i + 1 
            End If
        Else 'первую строку в любом случае читаем и увеличиваем массив
            i = i + 1
        End If                
    Loop
    objFile.Close 'закрываем файл
    Set objFile = Nothing 'удаляем ссылку на файл
    ReadFile = Err.Number
End Function

'удаление комментариев (вызываем из функции чтения файлов)
Function RemoveComments(regEx,strInput)
    On Error Resume Next    
    regEx.Pattern = strRemoveCommentsPattern 'собираем шаблон для удаления     
    RemoveComments = regEx.Replace(strInput,vbNullString) 'удаляем комменты и пр.    
End Function

'проверка наличия переноса строки (вызываем из функции чтения файлов)
Function FindJump(regEx,strInput)
    On Error Resume Next    
    regEx.Pattern = strFindJumpPattern
    If regEx.Test(strInput) Then         
        FindJump = True
    Else
        FindJump = False
    End If    
End Function

'получение имен переменных
Function GetVarName(regEx)
    On Error Resume Next
    Dim strMatchesArr()    'массив совпавших строк
    Dim colMatches', strMatch    
    Dim i, j, k
    Dim strSplitArr
    Dim strFindVarPatternStart 'начало строки шаблона для поиска переменной
    Dim strFindVarPatternEnd 'конец строки шаблона для поиска переменной
    strFindVarPatternStart = "\b"
    strFindVarPatternEnd = "\b(?!" & Chr(34) & ")"
    i = 0
    'шаблон для поиска строк с объявлениями
    regEx.Pattern = strGetVarNameTestPattern    
    For i = 0 To UBound(strArr) 'бежим по массиву строк из файла    
        'проверяем наличие шаблона в строке - наверное так будет быстрее
        If regEx.Test(strArr(i)) Then
            'шаблон для удаления лишнего из строк с объявлениями
            regEx.Pattern = strGetVarNameReplacePattern
            Redim Preserve strMatchesArr(i)
            'заменяем лишнее (согласно шаблону) пробелами
            strMatchesArr(i) = regEx.Replace(strArr(i),Chr(32))    
            'разбиваем строку в массив по пробелу - получаем имена переменных
            strSplitArr = Split(strMatchesArr(i)) 
            'вернули шаблон обратно
            regEx.Pattern = strGetVarNameTestPattern
            'побежали по массиву свежих переменных        
            For j = 0 To UBound(strSplitArr)
                'проверим валидность имени переменной
                If CheckName(strSplitArr(j)) Then
                    'проверим наличие имени переменной в массиве (чтобы не повторяться)                    
                    If Not CheckNameArr(strSplitArr(j),0) Then 
                        k = UBound(strNameArr,2) + 1 'к верхнему индексу добавляем 1
                        Redim Preserve strNameArr(2,k) 'перебиваем размерность
                        'добавляем в массив значения
                        strNameArr(0,k) = strSplitArr(j) 'имя переменной                         
                        strNameArr(1,k) = GetRandomName(CharArray,intMaxLen,intPro) 'новое имя    
                        'проверяем новое имя - возможны повторы
                        Do While CheckNameArr(strNameArr(1,k),1)
                            'если уже есть - формируем новое
                            strNameArr(1,k) = GetRandomName(CharArray,intMaxLen,intPro)
                        Loop
                        'собираем строку шаблона для поиска переменной в строке    
                        strNameArr(2,k) = strFindVarPatternStart & strSplitArr(j) & strFindVarPatternEnd                    
                    End If
                End If
            Next
        End If
    Next    
    GetVarName = Err.Number
End Function

'проверка имени на валидность (вызываем из функции получения имен переменных)
Function CheckName(strName)
    On Error Resume Next    
    'IsNumeric - на случай массивов (число в скобках)    
    If strName = ClassIni Or strName = ClassTerm Or IsNumeric(strName) Then
        CheckName = False
    Else
        CheckName = True
    End If
End Function

'проверка наличия имени переменной в массиве имен переменных
'(вызываем из функции получения имен переменных)
Function CheckNameArr(strName,intIndex)
    On Error Resume Next
    Dim i
    'если проверяем старое имя - вычитаем 0, если новое - 1
    For i = 0 To UBound(strNameArr,2) - intIndex
        If strNameArr(intIndex,i) = strName Then 
            CheckNameArr = True
            Exit Function
        End If
    Next
    CheckNameArr = False
End Function

'получаем случайное имя (вызываем из функции получения имен переменных)
Function GetRandomName(CharArray,intMaxLen,intPro)
    On Error Resume Next
    Dim arrReturnName() 'массив случайных букв и цифр для создания имени
    Dim i, j
    Dim strRandomName
    Randomize
    'рандомизируем количество символов в новом имени от 2 до 10
    j = Int((intMaxLen - 1) * Rnd) + 2
    
    Redim arrReturnName(j)
    
    'первый символ - буква
    arrReturnName(0) = CharArray(Int((UBound(CharArray) + 1) * Rnd))
    For i = 1 To j    
        If Rnd < intPro/100 Then 'вычисляем процент букв
            arrReturnName(i) = CharArray(Int((UBound(CharArray) + 1) * Rnd))
        Else 
            arrReturnName(i) = Int(10 * Rnd)
        End If
    Next
        
    GetRandomName = Join(arrReturnName,vbNullString)
End Function

'переименование переменных
Function RenameVar(regEx)
    On Error Resume Next
    Dim i, j
    For i = 0 To UBound(strArr) 'бежим по массиву строк из файла
        For j = 1 To UBound(strNameArr,2) 'дальше по массиву имен переменных
            'устанавливаем шаблон, заготовленный в 3-й размерности массива
            regEx.Pattern = strNameArr(2,j)
            'сначала проверяем - таким образом сокращаем количество итераций
            If regEx.Test(strArr(i)) Then                 
                strArr(i) = regEx.Replace(strArr(i),strNameArr(1,j))    
            End If
        Next
    Next
    RenameVar = Err.Number
End Function

'пишем новый файл
Function WriteFile(strFilePath)
    On Error Resume Next
    Dim objNewFile 'новый файл    
    Dim strNewFileName 'имя нового файла
    Dim strNewFilePath 'путь к новому файлу(с префиксом)
    Dim i
    
    'собираем имя нового файла
    strNewFileName = strNewNamePref & "-" & fso.GetFileName(strFilePath)    
    'собираем путь к файлу            
    strNewFilePath = fso.BuildPath(fso.GetParentFolderName( _
            fso.GetAbsolutePathName(strFilePath)),strNewFileName)     
    'создаем новый файл, если существует - заменим    
    Set objNewFile = fso.CreateTextFile(strNewFilePath,True) 
    'пишем обновленный массив в новый файл
    For i = 0 To UBound(strArr) 'пропустим пустые строки            
        If strArr(i) <> vbNullString Then objNewFile.WriteLine strArr(i)            
    Next
    objNewFile.Close 'закрываем файл
    Set objNewFile = Nothing 'удаляем ссылку на файл
    
    'запись лога
    If bStir And bWriteLog Then 'проверяем необходимость
        'если нет ошибок - пишем лог
        If Not Err.Number Then 
            'собираем путь к файлу лога
            strNewFilePath = fso.BuildPath(fso.GetParentFolderName( _
                fso.GetAbsolutePathName(strFilePath)),strNewFileName & strNewLogSuf)     
            Set objNewFile = fso.CreateTextFile(strNewFilePath,True) 
            objNewFile.WriteLine "True name;Stirred name"
            'пишем обновленный массив в новый файл
            For i = 0 To UBound(strNameArr,2)         
                objNewFile.WriteLine strNameArr(0,i) & ";" & strNameArr(1,i)
            Next
            objNewFile.Close 'закрываем файл
            Set objNewFile = Nothing 'удаляем ссылку на файл
        End If
    End If
    WriteFile = Err.Number
End Function

Отказался от рисования HTML-приложения. Наверняка разработчикам красота ни к чему.
Как выглядит скрипт после обработки собственного исходного кода можно посмотреть здесь

33 (изменено: Евген, 2011-08-17 15:58:01)

Re: VBS: Удаление комментариев

А-а-а-а !!!
Аттэншн !!!
Жуть дэтэктэд !!!
Обфускация - это детский лепет по сравнению с этой жутью
Код нечитаемый, неразборчивый, глаза разбегаюцца в разные стороны, руки опускаюцца...
все переменные пахожи на пароли добротных юзверей...
олбанский родным кажецца после прочтения этого кода

А обратного лекарства нет ?
Что делать если исходник потерял ?

Времени не хватает... :-(

34

Re: VBS: Удаление комментариев

Евген пишет:

Обфускация - это детский лепет по сравнению с этой жутью

Надеюсь это позитив

Евген пишет:

Что делать если исходник потерял ?

Вариант - использовать csv-файл, если он есть

35

Re: VBS: Удаление комментариев

dab00, Ваш статус на форуме изменён. Добро пожаловать!

Ознакомьтесь, пожалуйста, с Вашими новыми правами.

Было предложение — скрипт в Коллекцию. Имейте в виду: текущий заголовок этой темы уже не отражает сути.

36 (изменено: dab00, 2011-08-17 19:39:25)

Re: VBS: Удаление комментариев

alexii пишет:

dab00, Ваш статус на форуме изменён. Добро пожаловать!

Спасибо, приятно

alexii пишет:

текущий заголовок этой темы уже не отражает сути

Я назвал скрипт VBShaker. Смешать, но не взбалтывать (Бонд, Джеймс... ) - на мой взгляд подходящая аллегория.
Лирика .
Назовите ближе к сути.

37

Re: VBS: Удаление комментариев

По сути Ваша программа - фильтр, который удаляет несущественные символы из исходного кода, сокращает его без изменения функционала.
Так и назовите - Упрощение, сокращение, минификация, обфускация VBScript-кодов. Используйте одно из, либо все сразу.

( 2 * b ) || ! ( 2 * b )

38

Re: VBS: Удаление комментариев

Еще раз подмолодил код - похоже финал: устранил один лишний цикл, вынес последний шаблон в переменную и изменил комменты - теперь разберется кодер любой квалификации, если захочет

Так и назовите - Упрощение, сокращение, минификация, обфускация VBScript-кодов

Наверное "VBS: Обфускация VBScript-кода" подойдет. Если считаете скрипт достойным Коллекции - сообщите, запостю. Или сами, если хотите - не возражаю

39

Re: VBS: Удаление комментариев

Проведите интересный тест: дайте на "съедение" скрипту текст самого скрипта А. Получится сжатый скрипт Б. После этого запустите полученный скрипт Б и передайте ему текст Б. Получите скрипт В. Сравните полученные результаты Б и В.

( 2 * b ) || ! ( 2 * b )

40

Re: VBS: Удаление комментариев

Таким образом я тестил. Есть проблема? По-моему отличаются только именами переменных. Количество строк одинаковое. Функционал на месте.

41

Re: VBS: Удаление комментариев

dab00 пишет:

Если считаете скрипт достойным Коллекции - сообщите, запостю. Или сами, если хотите - не возражаю smile

Теперь это, в основном, как бы Ваша головная боль , коллега — решать, достоин ли Ваш код. Равно как и заботиться о его размещении в Коллекции.

42

Re: VBS: Удаление комментариев

dab00 пишет:

Есть проблема?

Нет проблем. Спасибо.

( 2 * b ) || ! ( 2 * b )

43

Re: VBS: Удаление комментариев

Rumata пишет:
dab00 пишет:

Есть проблема?

Нет проблем. Спасибо.

Я имел ввиду в контексте Вашего совета:

Rumata пишет:

Проведите интересный тест: дайте на "съедение" скрипту...

Как-то пафосно про "проблему" получилось

alexii пишет:

Теперь это, в основном, как бы Ваша головная боль , коллега — решать, достоин ли Ваш код...

Не хотелось бы уважаемой публике фуфло впаривать, поэтому важно мнение специалистов. У кого есть - сообщите.
Кроме того запостил скрипт на ресурсах журналов VR-Online и ПРОграммист (кстати, в последнем публиковался в прошлом году со статьей про управление USB с помощью VBScript, в результате чего потом слепил вот такое HTA).
Я то за свой код, конечно, горой, но, думаю, лучше посмотреть, что люди скажут

44

Re: VBS: Удаление комментариев

Как говорил отец-основатель ресурса, считаете нужным — постите в Коллекцию. Если вдруг что окажется не так. дадут SOS — определимся. Исправить Коллекцию можно всегда, запостив новую версию.

45 (изменено: dab00, 2011-08-20 18:34:44)

Re: VBS: Удаление комментариев

Добавил новую фичу - трансформацию символов.
Делает код еще более нечитабельным, но значительно увеличивает размер файла.
Выложил оба варианта скрипта - с кодом до трансформации и после.

Option Explicit
    On Error Resume Next
    Const strNewNamePref = "New" 'префикс нового имени файла    
    Const intMaxLen = 11 'максимальная длина имени в символах (Const-1)
    Const intPro = 60 'процент символов алфавита в новом рандомизированном имени    
    Const bStir = True ' необходимость взбалтывания имен переменных, False - не взбалтываем :)
    Const bWriteLog = False 'необходимость создания файла журнала переименования, False - не создаем
    Const bTransChr = False 'необходимость трансформации символов, False - не трансформируем
    Dim fso, ret
    Dim i, mesaga    
    Dim strNewLogSuf 'суффикс имени файла лога
    strNewLogSuf = "-log-" & Date() & ".csv" 
    
    '************** шаблоны **************
    Dim strRemoveCommentsPattern
    'шаблон удаления комментариев
    strRemoveCommentsPattern = _
            "^\s*(?:'|\brem\b).*$|(?:'|\brem\b)[^" & Chr(34) & "]*$|^\s+|\s+$"
    'шаблон объединения строк - символ подчеркивания в конце строки
    Dim strFindJumpPattern
    strFindJumpPattern = "_$" 
    'шаблон для поиска строк с объявлениями
    Dim strGetVarNameTestPattern
    strGetVarNameTestPattern = _
            "\b(?:sub|function|public|static|private|dim|const|class|property)\s+.*"
    'шаблон для удаления из строк с объявлениями
    Dim strGetVarNameReplacePattern
    strGetVarNameReplacePattern = _
            "\b(?:sub|function|public|static|private|dim|const|class|property|get|let|set)\b|\(|\)|,|\t|=.*$"
    
    Const ClassIni = "Class_Initialize" 'строка инициализации класса
    Const ClassTerm = "Class_Terminate" 'строка удаления класса
    '**************************************
    
    Dim strArr() 'массив для строк из файла с кодом    
    Dim strNameArr() 'массив имен переменных
    Redim strNameArr(2,0) 'необходимо инициализировать, переменные начнутся с индекса №1
    Dim CharArray 'массив символов - алфавит :)    
    CharArray = Array("a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z")            

    Set fso = CreateObject("Scripting.FileSystemObject")

    If WScript.Arguments.Count = 0 Then
        Dim objDialog 'диалог выбора файла    
        Set objDialog = CreateObject("UserAccounts.CommonDialog")
        If Not IsObject(objDialog) Then 
            MsgBox "Не удалось создать диалоговое окно" & vbCrLf & _
                    "Используйте консольный режим",vbExclamation
            Set fso = Nothing
            WScript.Quit
        End If
        
        objDialog.Flags = &H0200 'возможность выбрать несколько файлов
        objDialog.Filter = "Visual Basic files (*.vb;*.vbs)|*.vb;*.vbs|Все файлы (*.*)|*.*"    
        
        'открываем диалог    
        ret = objDialog.ShowOpen    
        
        'если файл не выбран - завершаем выполнение скрипта    
        If Not ret Then 
            Set fso = Nothing
            WScript.Quit             
        End If
            
        'вызываем функцию удаления с массивом имен выбранных файлов
        ret = RemComm(Split(Trim(fso.GetFileName(objDialog.FileName))))
        
        Set objDialog = Nothing    
    Else    
        'вызываем функцию удаления с коллекцией аргументов скрипта        
        ret = RemComm(WScript.Arguments)    
    End If
    
    Set fso = Nothing
        
    'вывод информации о ходе выполнения
    mesaga = "Журнал:"
    For i = 0 To UBound(ret,2)
        mesaga = mesaga & vbCrLf & ret(0,i) & " - " & ret(1,i)
    Next
    MsgBox mesaga,vbInformation

'удаление комментариев, переименование переменных и пр.
Function RemComm(arrFiles)
    On Error Resume Next        
    Dim arrRemComm() 'массив для лога    
    Dim strFilePath 'путь к файлу кода    
    Dim strFile 'имя файла в коллекции    
    Dim regEx 'регулярные выражения    
    Dim ret(5) 'возвращенное значение
    Dim i, j
    'создаем регулярное выражение
    Set regEx = New RegExp 
    With regEx        
        .Global = True   'устанавливаем глобальность применения
        .IgnoreCase = True  'устанавливаем нечувствительность к регистру
    End With
    
    i = 0
    For Each strFile In arrFiles
        'собираем путь к файлу
        strFilePath = fso.BuildPath(fso.GetParentFolderName(fso.GetAbsolutePathName(strFile)), fso.GetFileName(strFile))            
        
        'поверяем наличие файла - пользительно для консольного варианта
        If Not fso.FileExists(strFilePath) Then             
            Redim Preserve arrRemComm(1,i)
            arrRemComm(0,i) = strFilePath
            arrRemComm(1,i) = "Файл не найден"            
        Else                
            'читаем файл - отправляем путь
            ret(1) = ReadFile(regEx,strFilePath)            
            
            If bStir Then 'проверяем необходимость переименования переменных
            
                'извлекаем имена функций, процедур, переменных, классов и пр.
                'в public переменную strNameArr
                ret(2) = GetVarName(regEx)            
                
                'переименуем переменные
                ret(3) = RenameVar(regEx)                
            
            End If
            
            'пишем в новый файл
            ret(4) = WriteFile(strFilePath)
            
            'складываем коды выполнения
            Redim Preserve arrRemComm(1,i)
            arrRemComm(0,i) = strFilePath            
            ret(0) = Err.Number
            For j = 1 To UBound(ret)
                ret(0) = ret(0) + ret(j)
            Next            
            'проверяем наличие ошибок
            If Not ret(0) Then
                arrRemComm(1,i) = "Успех"
            Else
                arrRemComm(1,i) = "Ошибка"
            End If            
        End If
        i = i + 1
    Next    
    Set regEx = Nothing
    
    RemComm = arrRemComm    
End Function

'чтение файла и удаление комментариев
Function ReadFile(regEx,strFilePath)
    On Error Resume Next
    Dim objFile 'файл с кодом
    Dim i
    'открываем файл с кодом для чтения    
    Set objFile = fso.OpenTextFile(strFilePath,1) 
    i = 0            
    Do While objFile.AtEndOfStream <> True 'читаем файл                
        ReDim Preserve strArr(i) 'перебиваем размерность массива
        'закидываем строки в массив и по ходу удаляем комменты
        strArr(i) = RemoveComments(regEx,objFile.ReadLine)
        
        If i <> 0 Then
            'если в конце предыдущей строки есть символ переноса строки -
            If FindJump(regEx,strArr(i-1)) Then 
                'объединяем строку с предыдущей
                strArr(i-1) = Left(strArr(i-1),Len(strArr(i-1))-1) & strArr(i) 
                Redim Preserve strArr(i-1) 'уменьшаем массив
            Else 'если нет символа переноса - продолжаем увеличивать массив
                i = i + 1 
            End If
        Else 'первую строку в любом случае читаем и увеличиваем массив
            i = i + 1
        End If                
    Loop
    objFile.Close 'закрываем файл
    Set objFile = Nothing 'удаляем ссылку на файл
    ReadFile = Err.Number
End Function

'удаление комментариев (вызываем из функции чтения файлов)
Function RemoveComments(regEx,strInput)
    On Error Resume Next    
    regEx.Pattern = strRemoveCommentsPattern 'собираем шаблон для удаления     
    RemoveComments = regEx.Replace(strInput,vbNullString) 'удаляем комменты и пр.    
End Function

'проверка наличия переноса строки (вызываем из функции чтения файлов)
Function FindJump(regEx,strInput)
    On Error Resume Next    
    regEx.Pattern = strFindJumpPattern
    If regEx.Test(strInput) Then         
        FindJump = True
    Else
        FindJump = False
    End If    
End Function

'получение имен переменных
Function GetVarName(regEx)
    On Error Resume Next
    Dim strMatchesArr()    'массив совпавших строк
    Dim colMatches', strMatch    
    Dim i, j, k
    Dim strSplitArr
    Dim strFindVarPatternStart 'начало строки шаблона для поиска переменной
    Dim strFindVarPatternEnd 'конец строки шаблона для поиска переменной
    strFindVarPatternStart = "\b"
    strFindVarPatternEnd = "\b(?!" & Chr(34) & ")"
    i = 0
    'шаблон для поиска строк с объявлениями
    regEx.Pattern = strGetVarNameTestPattern    
    For i = 0 To UBound(strArr) 'бежим по массиву строк из файла    
        'проверяем наличие шаблона в строке - наверное так будет быстрее
        If regEx.Test(strArr(i)) Then
            'шаблон для удаления лишнего из строк с объявлениями
            regEx.Pattern = strGetVarNameReplacePattern
            Redim Preserve strMatchesArr(i)
            'заменяем лишнее (согласно шаблону) пробелами
            strMatchesArr(i) = regEx.Replace(strArr(i),Chr(32))    
            'разбиваем строку в массив по пробелу - получаем имена переменных
            strSplitArr = Split(strMatchesArr(i)) 
            'вернули шаблон обратно
            regEx.Pattern = strGetVarNameTestPattern
            'побежали по массиву свежих переменных        
            For j = 0 To UBound(strSplitArr)
                'проверим валидность имени переменной
                If CheckName(strSplitArr(j)) Then
                    'проверим наличие имени переменной в массиве (чтобы не повторяться)                    
                    If Not CheckNameArr(strSplitArr(j),0) Then 
                        k = UBound(strNameArr,2) + 1 'к верхнему индексу добавляем 1
                        Redim Preserve strNameArr(2,k) 'перебиваем размерность
                        'добавляем в массив значения
                        strNameArr(0,k) = strSplitArr(j) 'имя переменной                         
                        strNameArr(1,k) = GetRandomName(CharArray,intMaxLen,intPro) 'новое имя    
                        'проверяем новое имя - возможны повторы
                        Do While CheckNameArr(strNameArr(1,k),1)
                            'если уже есть - формируем новое
                            strNameArr(1,k) = GetRandomName(CharArray,intMaxLen,intPro)
                        Loop
                        'собираем строку шаблона для поиска переменной в строке    
                        strNameArr(2,k) = strFindVarPatternStart & strSplitArr(j) & strFindVarPatternEnd                    
                    End If
                End If
            Next
        End If
    Next    
    GetVarName = Err.Number
End Function

'проверка имени на валидность (вызываем из функции получения имен переменных)
Function CheckName(strName)
    On Error Resume Next    
    'IsNumeric - на случай массивов (число в скобках)    
    If strName = ClassIni Or strName = ClassTerm Or IsNumeric(strName) Then
        CheckName = False
    Else
        CheckName = True
    End If
End Function

'проверка наличия имени переменной в массиве имен переменных
'(вызываем из функции получения имен переменных)
Function CheckNameArr(strName,intIndex)
    On Error Resume Next
    Dim i
    'если проверяем старое имя - вычитаем 0, если новое - 1
    For i = 0 To UBound(strNameArr,2) - intIndex
        If strNameArr(intIndex,i) = strName Then 
            CheckNameArr = True
            Exit Function
        End If
    Next
    CheckNameArr = False
End Function

'получаем случайное имя (вызываем из функции получения имен переменных)
Function GetRandomName(CharArray,intMaxLen,intPro)
    On Error Resume Next
    Dim arrReturnName() 'массив случайных букв и цифр для создания имени
    Dim i, j
    Dim strRandomName
    Randomize
    'рандомизируем количество символов в новом имени от 2 до 10
    j = Int((intMaxLen - 1) * Rnd) + 2
    
    Redim arrReturnName(j)
    
    'первый символ - буква
    arrReturnName(0) = CharArray(Int((UBound(CharArray) + 1) * Rnd))
    For i = 1 To j    
        If Rnd < intPro/100 Then 'вычисляем процент букв
            arrReturnName(i) = CharArray(Int((UBound(CharArray) + 1) * Rnd))
        Else 
            arrReturnName(i) = Int(10 * Rnd)
        End If
    Next
        
    GetRandomName = Join(arrReturnName,vbNullString)
End Function

'переименование переменных
Function RenameVar(regEx)
    On Error Resume Next
    Dim i, j
    For i = 0 To UBound(strArr) 'бежим по массиву строк из файла
        For j = 1 To UBound(strNameArr,2) 'дальше по массиву имен переменных
            'устанавливаем шаблон, заготовленный в 3-й размерности массива
            regEx.Pattern = strNameArr(2,j)
            'сначала проверяем - таким образом сокращаем количество итераций
            If regEx.Test(strArr(i)) Then                 
                strArr(i) = regEx.Replace(strArr(i),strNameArr(1,j))    
            End If
        Next
    Next
    RenameVar = Err.Number
End Function

'пишем новый файл
Function WriteFile(strFilePath)
    On Error Resume Next
    Dim objNewFile 'новый файл    
    Dim strNewFileName 'имя нового файла
    Dim strNewFilePath 'путь к новому файлу(с префиксом)
    Dim i
    Dim bTrans 'необходимость трансформации символов
    
    '************** константы для трансформации символов **************
    Const strFirstLine = "Execute(" 'первая строка нового файла
    Const strLastLine = "vbcrlf)" 'последняя строка нового файла    
    'константы для формирования символов новой строки
    Const strCrLf1 = "chr("
    Const strCrLf2 = ")"
    Const strCrLf3 = " & "
    Const strCrLf4 = " & _"
    '******************************************************************
    
    'собираем имя нового файла
    strNewFileName = strNewNamePref & "-" & fso.GetFileName(strFilePath)    
    'собираем путь к файлу            
    strNewFilePath = fso.BuildPath(fso.GetParentFolderName( _
            fso.GetAbsolutePathName(strFilePath)),strNewFileName)     
    'создаем новый файл, если существует - заменим    
    Set objNewFile = fso.CreateTextFile(strNewFilePath,True) 
    
    'собираем признак необходимости трансформации
    bTrans = bTransChr And CheckTransChr(strArr(i),strFirstLine)
    
    'если трансформируем символы - пишем первую строку
    If bTrans Then objNewFile.Write strFirstLine
        
    'пишем обновленный массив в новый файл
    For i = 0 To UBound(strArr) 'пропустим пустые строки            
        If strArr(i) <> vbNullString Then 
            'если трансформируем символы - отправляем строку в функцию трансформации
            If bTrans Then strArr(i) = TransChr(strArr(i)) & _
                    strCrLf1 & GetRandExp(13) & strCrLf2 & strCrLf3 & strCrLf1 & GetRandExp(10) & strCrLf2 & strCrLf4
            objNewFile.WriteLine strArr(i) 'пишем строку в новый файл
        End If
    Next
    
    'если трансформируем символы - пишем последнюю строку
    If bTrans Then objNewFile.WriteLine strLastLine    
    
    objNewFile.Close 'закрываем файл
    Set objNewFile = Nothing 'удаляем ссылку на файл
    
    'запись лога
    If bStir And bWriteLog Then 'проверяем необходимость
        'если нет ошибок - пишем лог
        If Not Err.Number Then 
            'собираем путь к файлу лога
            strNewFilePath = fso.BuildPath(fso.GetParentFolderName( _
                fso.GetAbsolutePathName(strFilePath)),strNewFileName & strNewLogSuf)     
            Set objNewFile = fso.CreateTextFile(strNewFilePath,True) 
            objNewFile.WriteLine "True name;Stirred name"
            'пишем обновленный массив в новый файл
            For i = 0 To UBound(strNameArr,2)         
                objNewFile.WriteLine strNameArr(0,i) & ";" & strNameArr(1,i)
            Next
            objNewFile.Close 'закрываем файл
            Set objNewFile = Nothing 'удаляем ссылку на файл
        End If
    End If
    WriteFile = Err.Number
End Function

'трансформация символов (вызываем из функции записи нового файла)
Function TransChr(strInput)
    Dim ret    
    For i = 1 To Len(strInput)
        ret = ret & "chr( " & GetRandExp(Asc(Mid(strInput,i,1)) ) & " ) & "        
    Next
    TransChr = ret
End Function

'получение случайного выражения 
'(вызываем из функций записи нового файла и трансформации символов)
Function GetRandExp(intChr)
    Dim intRandInt, intRandExp
    Randomize
    intRandInt = Int(rnd * 10000)
    intRandExp = Int(rnd * 3)
    If intRandExp = 0 Then 
        GetRandExp = (intRandInt+intChr) & "-" & intRandInt
    ElseIf intRandExp = 1 Then 
        GetRandExp = (intChr-intRandInt) & "+" & intRandInt
    Else 
        GetRandExp = (intChr*intRandInt) & "/" & intRandInt
    End If
End Function

'проверка файла на необходимость трансформации символов
'False - уже трансформированы
Function CheckTransChr(strInput,strFirstLine)
    If Left(strInput,8) = strFirstLine Then
        CheckTransChr = False
    Else
        CheckTransChr = True
    End If
End Function

Запостил скрипт в Коллекцию.

46

Re: VBS: Удаление комментариев

Меняем Execute на WScript.Echo и получаем исходный код.

47

Re: VBS: Удаление комментариев

JSman пишет:

Меняем Execute на WScript.Echo и получаем исходный код.

Не совсем исходный. Считаете фичу с трансформацией символов лишней?

48

Re: VBS: Удаление комментариев

Меня немного смущает увеличение кода. В любом случае профи сразу разгадает в чем подвох, если код целиком шифрован. Уж лучше остановиться на VBS.Encode. Можно долго обсуждать об алгоритмах обфускации, о том как один код может формировать другой, использовании мусорных конструкций и тому подобное. Мне больше в последнее время нравится использование фишки как социальная инженерия. Я имею в виду, что биты кода можно представить в виде пробела (1) и табуляции (0) и прятать его в комментариях. Пробельные символы могут сбить с толку даже спеца. Правда увеличение шифрованной части в 8 раз, но тем не менее, так можно скрыть парольную информацию.

49

Re: VBS: Удаление комментариев

Попалась история по теме "Заблудиться в трёх килососнах".
Можно доделать обфускацию с заменой имён переменных на графически схожие символы.

50

Re: VBS: Удаление комментариев

Vladimir пишет:

Можно доделать обфускацию с заменой имён переменных на графически схожие символы.

ОК, растолкуйте каким образом - доделаем.

51

Re: VBS: Удаление комментариев

Случайно попалось на глаза. Программа, судя по названию, делает обратную задачу - структурирует и форматирует текст: VbsBeautifier. Сам не проверял, понравилась задумка.

( 2 * b ) || ! ( 2 * b )

52 (изменено: dab00, 2012-09-30 10:15:04)

Re: VBS: Удаление комментариев

Спасибо, Rumata. Напомнил тему.
Написал сервис по мотивам задачи. Если есть желание можно на script-coding страничку разместить. Замечания принимаются.
HTA:


<html>
<head>
	<title>VBShaker - VBScript code obfuscation</title>
	<meta http-equiv=content-type content="text-html; charset=windows-1251">
    <meta http-equiv=MSThemeCompatible content=yes>
    <hta:application              
		icon=wscript.exe
        scroll=no
		windowstate=maximize
		version="1.0"
    >
</head>
<style type="text/css">
	textarea {width:49%; height:93%; font: normal 12px sans-serif}
	#scr1 {float:left;}
	#scr2 {float:right;}
	#btn,#btn1 {position:relative; font: bold 12px sans-serif; width:100px; height:25px; cursor:hand;}
	#btn {float:left; margin:0px 3px 3px 0px;}
	#btn1 {float:right; margin:0px 0px 3px 3px;}
	#tip {display:none; position:absolute; background:#fff; top:3px;left:110px; color:#000; padding:3px; font: bold italic 12px sans-serif;	filter:alpha(opacity=80);}
	#clr {clear:both;}
	#chk{float:left; position:relative;font: bold italic 12px sans-serif;}
	input {vertical-align:middle; margin:4px;}
	#min1,#max1,#proc1,#proc2 {height:18px; width:25px; font: bold 12px sans-serif;}
	#cr {font: bold italic 12px sans-serif; text-align: center;}
	
</style>

<script language="JavaScript">	
	function mainFunction() {
		var arrLines;		
		if (document.all){
			arrLines = scr1.value.split("\r\n");
		}
		else {
			arrLines = scr1.value.split("\n");
		}
		var ret = validateValues();
		if (ret != "") {
			alert(ret);
			return;
		}		
		if (chk1.checked) {
			removeComments(arrLines);
		}		
		if (chk2.checked) {
			var nameArr = getVarName(arrLines);
			if (log1.checked) {
				var log = open("","","height=400,width=600");
				if (log != null) {
					var logHTML = ""
					for(var i=0; i<nameArr.length; i++) {			
						logHTML += nameArr[i][0] + " = " + nameArr[i][1] + "<br/>";				
					}				
					log.document.write(logHTML);
					log.focus();
				}
			}
		}
		scr2.value = "";		
		scr2.value = arrLines.join("\n");		
	}	
	function validateValues() {	
		var ret = "";		
		var temp = parseInt(min1.value);
		if (min1.value.search(/\D/)!=-1 || temp < 2 || temp > 255) {
			ret += "min char should be an integer between 2 and 255 \n";
		}
		temp = parseInt(max1.value);
		if (max1.value.search(/\D/)!=-1 || temp < 2 || temp > 255) {
			ret += "max char should be an integer between 2 and 255 \n";
		}
		temp = parseInt(proc1.value);
		if (proc1.value.search(/\D/)!=-1 || temp < 0 || temp > 100) {
			ret += "% letters should be an integer between 0 and 100 \n";
		}
		temp = parseInt(proc2.value);
		if (proc2.value.search(/\D/)!=-1  || temp < 0 || temp > 100) {
			ret += "% upper case should be an integer between 0 and 100 \n";
		}		
		return ret;
	}
	function getVarName(arrLines) {
		var nameArr = [];
		for(var i=0; i<arrLines.length; i++) {			
			if (arrLines[i].search(/\b(?:dim|const|sub|function|public|private|class|property)\b[^(?:\"|_$)]/i)!=-1 && 
				arrLines[i].search(/\b(?:end|class_initialize|class_terminate)\b/i)==-1) {				
				var temp = arrLines[i].replace(/\b(?:dim|const|public|private|sub|function|class|property|get|let|set)\b|\(|\)|,|\d|=.*?(?:,|'.*$|\brem\b.*$|$)/gi," ")
					.replace(/^\s+|\s+$/g,"").split(/\s+/);				
				for(var j=0; j<temp.length; j++) {					
					var nameFound = false;
						for(var k=0; k<nameArr.length; k++) {
							if(temp[j] == nameArr[k][0]) {
								nameFound = true;
								break;
							}
						}
					if(!nameFound) {						
						var newnameFound = true;
						while(newnameFound) {
							var tempName = getRandomName();
							for(var k=0; k<nameArr.length; k++) {
								if (tempName == nameArr[k][1]) {									
									break;
								}
							}
							if (checkRandomName(tempName)) {
								newnameFound = false;
							}
						}						
						nameArr.push([temp[j],tempName,new RegExp('\\b'+temp[j]+'\\b(?!")','g')]);											
					}
				}							
			}			
		}
		for(var i=0; i<arrLines.length; i++) {			
			for(var j=0; j<nameArr.length; j++) {
				arrLines[i] = arrLines[i].replace(nameArr[j][2],nameArr[j][1]);
			}
		}
		return nameArr;
	}
	function getRandomName() {
		var max = parseInt(max1.value);
		var min = parseInt(min1.value);
		var proc = parseInt(proc1.value);
		var procU = parseInt(proc2.value);
		var charArray = ["a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z","_"]		
		if (Math.random() < procU/100) {
			var retArr = [charArray[Math.floor(Math.random() * 26)].toUpperCase()];
		}
		else {
			var retArr = [charArray[Math.floor(Math.random() * 26)]];
		}
		var varLen = Math.floor(Math.random() * (max - min + 1)) + min;		
		for (i=1; i<varLen; i++) {
			if (Math.random() < proc/100) {
				if (Math.random() < procU/100) {
					retArr.push(charArray[Math.floor(Math.random() * 27)].toUpperCase());					
				}
				else {					
					retArr.push(charArray[Math.floor(Math.random() * 27)]);
				}				
			}
			else {
				retArr.push(Math.floor(Math.random() * 10));
			}
		}
		return retArr.join("");
	}
	function checkRandomName(name) {		
		if (name.substring(0,1) == "vb") {
			return false;
		}		
		var arr = ["dim","const","public","private","sub","function","class","property","get","let","set","class_initialize","class_terminate",
			"if","or","and","not","then","else","elseif","end","for","each","in","to","step","next","do","while","loop","until","wend","select","case","exit","with",
			"xor","err","call","on","error","resume","goto","redim","preserve","me","mod","rem","new","true","false","option","explicit",
			"date","dateadd","datediff","datepart","dateserial","datevalue","day","formatdatetime","hour","isdate","minute","month","monthname",
			"now","second","time","timer","timeserial","timevalue","weekday","weekdayname","year",
			"asc","cbool","cbyte","ccur","cdate","cdbl","chr","cint","clng","csng","cstr","hex","oct",
			"formatcurrency","formatdatetime","formatnumber","formatpercent",
			"abs","atn","cos","exp","int","fix","log","oct","rnd","sgn","sin","sqr","tan",
			"array","filter","isarray","join","lbound","split","ubound",
			"instr","instrrev","lcase","left","len","ltrim","rtrim","trim","mid","replace","right","space","strcomp","string","strreverse","ucase",
			"createobject","eval","getlocale","getobject","getref","inputbox","isempty","isnull","isnumeric","isobject","loadpicture","msgbox",
			"rgb","round","scriptengine","scriptenginebuildversion","scriptenginemajorversion","scriptengineminorversion","setlocale","typename","vartype"];					
		for(var i=0; i<arr.length; i++) {
			if(name == arr[i]) {
				return false;
			}
		}		
		return true;
	}
	function removeComments(arrLines) {		
		for(var i=0; i<arrLines.length; i++) {						
			arrLines[i] = arrLines[i].replace(/^\s+|^\s*(?:'|\brem\b).*$|(?:'|\brem\b)[^(?:\"|_$)].*$|\s+$/gi,"");						
			if (arrLines[i].search(/^\s*$/)!=-1) {
				arrLines.splice(i,1);
				i--;				
			}
		}	
	}	
	function clearFunction() {
		scr1.value = "";
		scr2.value = "";
		min1.value = "2";
		max1.value = "10";
		proc1.value = "60";
		proc2.value = "40";
		log1.checked = false;
	}
</script>

<body>
	<button id="btn" onclick="mainFunction()" onmouseover="tip.style.display = 'block'" onmouseout="tip.style.display = 'none'">S H A K E &nbsp;&nbsp;I T</button>	
	<div id="chk">
		<input id="chk1" type="checkbox" checked="checked" />remove comments
		<input id="chk2" type="checkbox" checked="checked" />rename explicitly declared variables
		<input id="min1" type="text" value="2" />min char
		<input id="max1" type="text" value="10" />max char
		<input id="proc1" type="text" value="60" />% letters
		<input id="proc2" type="text" value="40" />% upper case
		<input id="log1" type="checkbox" />log
	</div>
	<button id="btn1" onclick="clearFunction()">C L E A R</button>
	<span id="tip">don't break it, took me time to make it</span>
	<div id="clr"></div>
	<textarea id="scr1"></textarea>
	<textarea id="scr2"></textarea>
	<div id="cr">Copyright © by  <a href="http://www.daspot.ru">Anatoly Demidovich</a></div>
</body>
</html>