Пишем VBS-приложение для преображения кода VB

Posted by Chas under Basic, Статьи

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

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

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

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

Возможности приложения:

• удаление комментариев, пробелов, табуляций, переноса строк
• переименование функций, процедур, классов, свойств, методов, явно объявленных переменных, констант (только 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 - не создаем

	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) &amp;amp;amp; 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)) &amp;amp;amp; _

					strCrLf1 &amp;amp;amp; GetRandExp(13) &amp;amp;amp; strCrLf2 &amp;amp;amp; strCrLf3 &amp;amp;amp; strCrLf1 &amp;amp;amp; GetRandExp(10) &amp;amp;amp; strCrLf2 &amp;amp;amp; 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 &amp;amp;amp; 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) &amp;amp;amp; ";" &amp;amp;amp; 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 &amp;amp;amp; "chr( " &amp;amp;amp; GetRandExp(Asc(Mid(strInput,i,1)) ) &amp;amp;amp; " ) &amp;amp;amp; "

	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) &amp;amp;amp; "-" &amp;amp;amp; intRandInt

	ElseIf intRandExp = 1 Then

		GetRandExp = (intChr-intRandInt) &amp;amp;amp; "+" &amp;amp;amp; intRandInt

	Else

		GetRandExp = (intChr*intRandInt) &amp;amp;amp; "/" &amp;amp;amp; 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

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

VBShaker.zip (36.6 Кб)

тема на форуме

Похожие статьи

• Стиль кода: фигурные скобки
• Стиль оформления delphi кода
• Рекомендуемые правила оформления кода
• USBMaster. Управляем флешками в офисе