Im trying to build my own Obfuscation add-in for my VBA projects.
I started with the easier tasks:
Remove Blank Lines
Remove Indentts
Remove Comments
I could figure out how to do this things, maybe not in the best way, but im stuck in:
Insert Random Break Lines (" _")
I would like to have this working for diferent types of delimiter, for now im only working with "=" signal. By the way, i have problems when i have multiple delimiters in the line (Eg: If bla = "abc" or ble = "acd"). The code causes incorrects splits in my line.
Sub VBE_Break_The_Lines()
Dim VBC As VBComponent
Dim a, i, j, lCount As Long
Dim str As String
Dim temp As Variant
lCount = 0
i = 1
Dim blnStringMode, blnLineContinue As Boolean
For Each VBC In VBProjToClean.VBComponents
blnStringMode = False
i = 1
With VBC.CodeModule
Do Until i > .CountOfLines
If Not .ProcOfLine(i, vbext_pk_Proc) = "VBE_Remove_Comments" Then
str = .Lines(i, 1)
End If
If InStr(1, str, " = ", vbTextCompare) > 0 Then
temp = Split(str, " = ")
.InsertLines i, ""
.ReplaceLine i, temp(0) & " _"
.InsertLines i + 1, "= " & temp(1)
.DeleteLines i + 2
lCount = lCount + 1
'a = InStr(1, str, "=", vbTextCompare)
i = i + 1
End If
i = i + 1
Loop
End With
Next
MsgBox lCount & " LINES BREAKED ( = )", , strFileToClean
End Sub
My next step will be change procedure/variable names, but not sure if REGEX should be the best way, i just read a lot, but not sure yet.
Hope you guys can give me a way to follow
Why not start with this Open Source code and make a new build from that instead of reinventing the wheel?
You need to change all the file extensions in the code from .xls to .xlsm, save the IB_test.xls workbook as a macro-enabled workbook and save the addin as .xlam, not .xla to make this work, but even though the code is 9 years old, it still works in Excel 2013.
If you are into VBA obfuscation, you may want to try out VBASH (www.ayedeal.com/vbash). It is pretty straight forward and powerful.
Related
Need some help writing a regular expression to count the number of words in a string (Please note the data is a html string, which needs to be placed into a spreadsheet) when separated either by any special characters like . , - , +, /, Tab etc. Count should exclude special characters.
**Original String** **End Result**
Ex : One -> 1
One. -> 1
One Two -> 2
One.Two -> 2
One Two. -> 2
One.Two. -> 2
One.Tw.o -> 3
Updated
I think you asked a valuable question and this downvoting is not fair!
Function WCount(ByVal strWrd As String) As Long
'Variable declaration
Dim Delimiters() As Variant
Dim Delimiter As Variant
'Initialization
Delimiters = Array("+", "-", ".", "/", Chr(13), Chr(9)) 'Define your delimiter characters here.
'Core
For Each Delimiter In Delimiters
strWrd = Replace(strWrd, Delimiter, " ")
Next Delimiter
strWrd = Trim(strWrd)
Do While InStr(1, strWrd, " ") > 0
strWrd = Replace(strWrd, " ", " ")
Loop
WCount = UBound(Split(strWrd, " ")) + 1
End Function
________________
You can use this function as a UDF in excel formulas or can use in another VBA codes.
Using in formula
=WCOUNT("One.Two.Three.") or =WCOUNT($A$1") assuming your string is in A1 cell.
Using in VBA
(With assume passing your string with Str argument.)
Sub test()
Debug.Print WCount(Str)
End Sub
Regards.
Update
I have test your text as shown below.
copy your text in a Cell of Excel as shown.
The code updated for Line break and Tab characters and count your string words correctly now.
Try this code, all necessary comments are in code:
Sub SpecialSplit()
Dim i As Long
Dim str As String
Dim arr() As String
Dim delimeters() As String
'here you define all special delimeters you want to use
delimetres = Array(".", "+", "-", "/")
For i = 1 To 9
str = Cells(i, 1).Value
'this will protect us from situation where last character is delimeter and we have additional empty string
str = Left(str, Len(str) - 1)
'here we replace all special delimeters with space to simplify
For Each delimeter In delimetres
str = Replace(str, delimeter, " ")
Next
arr = Split(str)
Cells(i, 2).Value = UBound(arr) - LBound(arr) + 1
Next
End Sub
With your posted data following RegExp is working correctly. Put this in General Module in Visual Basic Editor.
Public Function CountWords(strInput As String) As Long
Dim objMatches
With CreateObject("VBScript.RegExp")
.Global = True
.MultiLine = True
.Pattern = "\w+"
Set objMatches = .Execute(strInput)
CountWords = objMatches.Count
End With
End Function
You have to use it like a normal formula. e.g. assuming data is in cell A1 function would be:
=CountWords(A1)
For your information, it can be also achieved through formula if number of characters are specific like so:
=LEN(TRIM(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(TRIM(A1),"."," "),","," "),"-"," "),"+"," "),"/"," "),"\"," ")))-LEN(SUBSTITUTE(TRIM(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(TRIM(A1),"."," "),","," "),"-"," "),"+"," "),"/"," "),"\"," "))," ",""))+1
I am trying to truncate some data in an excel sheet by removing the second word (if applicable) from each cell. That is, if a cell has two words, I want it to remove the second one. An example would be finding foo bar and replacing it with foo. From research, I found that the following works in Excel 2011 (for Mac), but not other versions:
Find: (*) (*)
Replace with: \1
How can I accomplish this in my version of Excel? Also, is there an alternative method by which I can obtain the same result?
If you want a formula..
=IF(FIND(" ",A2),TRIM(LEFT(A2,FIND(" ",A2))),A2)
or a VBA subroutine..
Sub GetFirstWord()
Application.ScreenUpdating = False
Dim n As Integer
Dim strWord As String
n = 2
Do While Cells(n, 1).Value <> ""
strWord = Cells(n, 1).Value
If InStr(1, strWord, " ") Then
Cells(n, 1).Value = Replace(Left(strWord, InStr(1, strWord, " ")), strWord, "")
End If
n = n + 1
Loop
Application.ScreenUpdating = True
End Sub
Both solutions as written above assume the words are located in Column A.
I have a VBA source code containing many hard coded references to cells. The code is part of the Worksheet_Change sub, so I guess hard coding the range references was necessary and you will see many assignment statements like the following:
Set cell = Range("B7")
If Not Application.Intersect(cell, Range(Target.Address)) Is Nothing Then
I would like insert 2 additional rows on top of the worksheet, so basically all the row references will shift by 2 rows. So for example the above assignment statement will be changed to Set cell = Range("B9").
Given the large number of hard coded row references in the code, I thought of using Regex to increment all the row references by 2. So I have developed the following code.
Sub UpdateVBACode()
'*********************Read Text File Containing VBA code and assign content to string variable*************************
Dim str As String
Dim strFile As String: strFile = "F:\Preprocessed_code.txt"
Open strFile For Input As #1
str = Input$(LOF(1), 1)
Close #1
'*********************Split string variables to lines******************************************************************
Dim vStr As Variant: vStr = Split(str, vbCrLf)
'*********************Regex work***************************************************************************************
Dim rex As New RegExp
rex.Global = True
Dim i As Long
Dim mtch As Object
rex.Pattern = "(""\w)([0-9][0-9])("")" ' 3 capturing groups to reconstruct the replacement string
For i = 0 To UBound(vStr, 1)
If rex.Test(vStr(i)) Then
For Each mtch In rex.Execute(vStr(i))
vStr(i) = rex.Replace(vStr(i), mtch.SubMatches(0) & IncrementString(mtch.SubMatches(1)) & mtch.SubMatches(2))
Next
End If
Next i
'********************Reconstruct String*********************************************************************************
str = ""
For i = 0 To UBound(vStr, 1)
str = str & vbCrLf & vStr(i)
Next i
'********************Write string to text file******************************************************************************
Dim myFile As String
myFile = "F:\Processed_code.txt"
Open myFile For Output As #2
Print #2, str
Close #2
'
End Sub
Function IncrementString(rowNum As String) As String '
Dim num As Integer
num = CInt(rowNum) + 2
IncrementString = CStr(num)
End Function
The above VBA code works, except it fails if there are two row references in the same line, so for instance if we have If Range("B15").Value <> Range("B12").Value Then, after the line gets processed I get If Range("B14").Value <> Range("B14").Value Theninstead of If Range("B17").Value <> Range("B14").Value Then. The problem is in the vStr(i) = rex.Replace(vStr(i), mtch.SubMatches(0) & IncrementString(mtch.SubMatches(1)) & mtch.SubMatches(2)) statement, because it is getting called more than once if a line has more than Regex match.
Any ideas? Thanks in advance
I think what you are trying to do is a bad idea, for two reasons:
Hard-coded cell references are almost always poor practice. A better solution may be to replace hard-coded cell references with named ranges. You can refer to them in the code by name, and the associated references will update automatically if you insert/delete rows or columns. You have some painful upfront work to do but the result will be a much more maintainable spreadsheet.
You are effectively trying to write a VBA parser using regexes. This is pretty much guaranteed not to work in all cases. Your current regex will match lots of things that aren't cell references (e.g. "123", "_12", and "A00") and will also miss lots of hard-coded cell references (e.g. "A1" and Cell(3,7)). That may not matter for your particular code but the only way to be sure it's worked is to check each reference by hand. Which is IMHO not much less effort than refactoring (e.g. replace with named ranges). In my experience you don't fix a regex, you just make the problems more subtle.
That said, since you asked...
<cthulu>
There are only two choices when using RegExp.Replace() - either replace the first match or replace all matches (corresponding to setting RegExp.Global to False or True respectively). You don't have any finer control than that, so your logic has to change. Instead of using Replace() you could write your own code for the replacements, using the FirstIndex property of the Match object, and VBA's string functions to isolate the relevant parts of the string:
Dim rex As Object
Set rex = CreateObject("VBScript.RegExp")
rex.Global = True
Dim i As Long
Dim mtch As Object
Dim newLineText As String
Dim currMatchIndex As Long, prevPosition As Long
rex.Pattern = "(""\w)([0-9][0-9])("")" ' 3 capturing groups to reconstruct the replacement string
For i = 0 To UBound(vStr, 1)
If rex.Test(vStr(i)) Then
currMatchIndex = 0: prevPosition = 1
newLineText = ""
For Each mtch In rex.Execute(vStr(i))
'Note that VBA string functions are indexed from 1 but Match.FirstIndex starts from 0
currMatchIndex = mtch.FirstIndex
newLineText = newLineText & Mid(vStr(i), prevPosition, currMatchIndex - prevPosition + 1) & _
mtch.SubMatches(0) & IncrementString(mtch.SubMatches(1)) & mtch.SubMatches(2)
prevPosition = currMatchIndex + Len(mtch.Value) + 1
Next
vStr(i) = newLineText & Right(vStr(i), Len(vStr(i)) - prevPosition + 1)
End If
Next i
Note that I still haven't fixed the problems with the regex pattern in the first place. I recommend that you just go and use named ranges instead...
Oops, nearly forgot - </cth
I was wondering if there was a way I could start a selection from the Regex string i have in the below example
The below example works exactly how I want it too however if there is text that matches before it on another line it is choosing the wrong text and highlighting it.
What im wondering is if there is a way to get the start index of the regex string?
If Regex.IsMatch(Me.TextBox1.Text, "\b" + Regex.Escape("is") + "\b") Then
Me.TextBox1.SelectionStart = Me.TextBox1.Text.IndexOf("is")
Dim linenumber As Integer = Me.TextBox1.GetLineFromCharIndex(Me.TextBox1.Text.IndexOf("is"))
Me.TextBox1.SelectionLength = Me.TextBox1.Lines(linenumber).Length
Me.TextBox1.Focus()
Me.TextBox1.SelectedText = "is " & Me.TextBox2.Text
The System.Text.RegularExpression.Match object has a property which should help you here: Match.Index. Match.Index will tell you where the capture starts, and Match.Length tells you how long it is. Using those you could change your code to look like this:
If Regex.IsMatch(Me.TextBox1.Text, "\b" + Regex.Escape("is") + "\b") Then
Dim m as Match
m = Regex.Match(Me.TextBox1.Text, "\b" + Regex.Escape("is") + "\b")
Me.TextBox1.SelectionStart = m.Index
Dim linenumber As Integer = Me.TextBox1.GetLineFromCharIndex(m.Index)
Me.TextBox1.SelectionLength = Me.TextBox1.Lines(linenumber).Length
Me.TextBox1.Focus()
Me.TextBox1.SelectedText = "is " & Me.TextBox2.Text
I'm creating a program in VB.NET to output multiple images. Some images will have the same file name. If there is multiple files with the same name I want to add "_1_" to the end of the file name. If the "_1_" file already exists I want to increment the 1 to be "_2_". If this file already exists I want to continue incrementing the number ultil it doesn't exist. So for example "filename", filename_1_", "filename_2_", etc. Here is the code that I have tried
Dim usedFiles As New List(Of String)
While usedFiles.Contains(returnValue)
If Regex.IsMatch(returnValue, "[_]([0-9]{1,})[_]$") Then
returnValue = Regex.Replace(returnValue, "[_]([0-9]{1,})[_]$", "_" + (CType("$1", Integer) + 1).ToString() + "_")
Else
returnValue += "_1_"
End If
End While
usedFiles.Add(returnValue)
The line that isn't working is:
returnValue = Regex.Replace(returnValue, "[_]([0-9]{1,})[_]$", "_" + (CType("$1", Integer) + 1).ToString() + "_")
which outputs "filename_2_" every time. I have also tried:
returnValue = Regex.Replace(returnValue, "[_]([0-9]{1,})[_]$", "_($1+1)_")
however this returns "filename_($1+1)_". I know I could just remove the "_" then add 1 to the number then put the "_" back on both sides, but I also know this can be done in other languages (like php) using the Regex.
Any ideas?
Thanks!
Ryan
I haven't taken the time to figure out what's wrong with your RegEx expression because it just seems silly to me. You're over thinking it. All you need to do is something simple like this:
Dim fileName As String = returnValue
Dim i As Integer = 0
While usedFiles.Contains(returnValue)
i = i + 1
returnValue = fileName + "_" + i.ToString() + "_"
End While