VBShaker. Смешать, но не взбалтывать
Пользователи, просматривающие топик: none
|
Зашли как: Guest
|
Имя  |
| Сообщение |
<< Старые топики Новые топики >> |
|
|
VBShaker. Смешать, но не взбалтывать - 2011-08-19 09:02:47.110000
|
|
|
dab00
Сообщений: 13
Оценки: 0
Присоединился: 2011-01-23 17:47:06.350000
|
Представляю VBS-скрипт для преображения кода VB. 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("sсriрting.FileSystemObject")
If Wsсriрt.Arguments.Count = 0 Then
Dim objDialog 'диалог выбора файла
Set objDialog = CreateObject("UserAccounts.CommonDialog")
If Not IsObject(objDialog) Then
MsgBox "Не удалось создать диалоговое окно" & vbCrLf & _
"Используйте консольный режим",vbExclamation
Set fso = Nothing
Wsсriрt.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
Wsсriрt.Quit
End If
'вызываем функцию удаления с массивом имен выбранных файлов
ret = RemComm(Split(Trim(fso.GetFileName(objDialog.FileName))))
Set objDialog = Nothing
Else
'вызываем функцию удаления с коллекцией аргументов скрипта
ret = RemComm(Wsсriрt.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
Как выглядит скрипт после обработки собственного исходного кода - до трансформации и после - можно посмотреть здесь.
Удачи разработчикам :)
|
|
|
|
|
|
