Пишем VBS-приложение для преображения кода VB [статья]

[dab00]

Наверное каждый разработчик, написав несколько тысяч строчек некомпилируемого кода рано или поздно начинает задумываться о том, как защитить свои "уникальные" творения .
В один прекрасный день пришел и мой черед.

В сети я не нашел ничего, кроме одной программы, за которую просят 279 бакинских, что меня, разумеется, ни разу не устроило. Поэтому я принял решение написать свой обфускатор.

Для реализации выбрал все тот же VBS + регулярные выражения. Жуткая смесь .
Во многом за счет использования регулярных выражений приложение получилось довольно шустрым. От рисования интерфейса отказался. Наверняка разработчикам красота ни к чему.

Ladies and gentlemen... da440dil project proudly presents...VBShaker! For developers only .

Возможности приложения:
- удаление комментариев, пробелов, табуляций, переноса строк
- переименование функций, процедур, классов, свойств, методов, явно объявленных переменных, констант (только VBS)

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

В секции объявления переменных можно изменить:
- максимальную длину нового случайного имени в символах
- процент символов алфавита в новом случайном имени
- необходимость переименования переменных и пр.
- необходимость создания файла журнала переименования
- необходимость трансформации символов (значительно увеличивает размер файла)
- префикс нового имени файла
- суффикс имени файла лога

Приложение создает в каталоге с файлом исходного кода новый файл с указанным префиксом, а также, в случае необходимости, CSV-файл с отчетом о переименованных переменных и пр.
В завершение работы отображает сообщение с отчетом о результате работы с каждым файлом.

Исходный код подробно закомментирован, разберется кодер любой квалификации:

[dab00]

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

[dab00]

'удаление комментариев, переименование переменных и пр.
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

[dab00]

'получение имен переменных
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

[dab00]

'пишем новый файл
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

Что получилось - на скриншоте. Как выглядит код после обфускации собственного кода - во вложении.

[nerv]

ну Вы даете) В хорошем смысле : )

Если можно, хотел бы задать несколько вопросов по вложениям и не только:
1. VBShaker.vbs - это я так понимаю уже после обфускации? ибо там очень странные имена переменных, констант, функций...
2. VBShaker-2.vbs - мама дорогая!) Тогда что это такое?

[dab00]

Сообщение от nerv

Если можно, хотел бы задать несколько вопросов по вложениям и не только:
1. VBShaker.vbs - это я так понимаю уже после обфускации? ибо там очень странные имена переменных, констант, функций...
2. VBShaker-2.vbs - мама дорогая!) Тогда что это такое?

VBShaker.vbs - код после "взбалтывания" имен переменных
VBShaker-2.vbs - код после "взбалтывания" + трансформация
Все работает. Исходник - в статье.
Изменяете значения констант - True-False, в зависимости от того, до какой степени Вам необходимо "избезобразить" код и запускаете .
Script Encoder отдыхает .

[nerv]

Благодарю за разъяснение)

Позвольте поинтересоваться еще: сам я с VBS дело не имел, но на VBA шлепаю относительно недавно и вроде как немного знаком с объектной моделью Excel. Может ли Ваш Шейкер взболтать код VBA?)

попробовал - вроде как нет...
Если интересно, то эксперимент проводил над простенькой функцией:

'=========================================================
' Author: nerv            | E-mail: nerv-net@yandex.ru
' Last Update: 20/09/2011 | Яндекс.Деньги: 41001156540584
'=========================================================
' Example: =USUM("B1:B5;C5;D1;Лист2!B2")

Public Function USUM#(ByVal Argument As String)
Dim x, v
On Error Resume Next
For Each v In Split(Argument, ";")
    If Range(v).Count = 1 Then x = Range(v).Value
    For Each x In Range(v).Value
        If IsNumeric(x) Then USUM = USUM + x
    Next
Next
End Function

[dab00]

2 nerv: Пожалуй с заголовком статьи лоханулся я - рисовал для VBS - не предусмотрел для RegExp наличие ByVal, ByRef, As и прочих конструкций - так я их и не планировал. Есть интерес - добейте - Вам спасибо скажут

[dab00]

Написал сервис обфускации VBScript кода. На JavaScript.