Re: VBS: Обфускация VBScript-кода

null@example.com (dab00) — Sat, 29 Sep 2012 21:15:01 +0000

Сервис по мотивам скрипта.
HTA:




    VBShaker - VBScript code obfuscation
    
    
    






        
    
        remove comments
        rename explicitly declared variables
        min char
        max char
        % letters
        % upper case
        log
    
    
    don't break it, took me time to make it
    
    
    
    Copyright © by  Anatoly Demidovich

upd: В свете последних событий с народом, сервис на Google Drive.

Re: VBS: Обфускация VBScript-кода

null@example.com (dab00) — Fri, 06 Jan 2012 15:08:10 +0000

- Исправил баг. Скрипт объединяет строки, перенесенные с помощь символа нижнего подчеркивания - "_". Встречаются методы объектов, название которых заканчивается этим символом - например SpawnInstance_. Изменил шаблон объединения строк: strFindJumpPattern = " _$" - добавил пробел

- Исправил преамбулу поста с "VBS-скрипт для преображения кода VB" на "VBS-скрипт для преображения кода VBScript", т.к. скрипт работает только с кодом VBScript (согласно заголовку).

VBS: Обфускация VBScript-кода

null@example.com (dab00) — Sat, 20 Aug 2011 13:17:31 +0000

VBS-скрипт для преображения кода VBScript.
Возможности:
- удаление комментариев, пробелов, табуляций, переноса строк
- переименование функций, процедур, классов, свойств, методов, явно объявленных переменных, констант (только 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) & 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

Как выглядит скрипт после преображения собственного исходного кода с трансформацией символов и без - во вложении.
По причине нежного отношения к обфусцированному коду некоторых параноидальных антивирусов, пароль на архив - script-coding.com.

Серый форум — VBS: Обфускация VBScript-кода

Re: VBS: Обфускация VBScript-кода

Re: VBS: Обфускация VBScript-кода

VBS: Обфускация VBScript-кода