I need to randomize character sets of 0-1, A-Z, -, and _. Lowercase cannot be part of it. Then xor encrypt it then eventually xor decrypt it. I don't have any issues with the xor encrypt logic as it will work fine with standard strconv(text,vbUnicode) - other than I get results that aren't the acceptable characters - but I am having trouble with how to use padding in my character set. Or alternately, I am going about this all wrong and should still use strconv and somehow restrict the results?
So to tackle this I am currently trying to make a custom conversion function that only uses the characters I mentioned. Since I only have 38 characters I know I need to use padding the get it to a factor of 2 but I am completely lost on how that would help. If I add in 26 equals signs as padding to get it to factor of 2 (38->64) I still am not sure what to do when it does a conversion and comes up with 38+ on the 0-63 scale of possibilities. Any help here would definitely be appreciated!
I did try just duplicating the string table for the last 26 characters but that obviously breaks on the decrypt since an A that originated because i was in position 38 would get translated back as having a value of 0.
So I basically have this:
Function Convert(sText As Variant, sDirection As String)
Dim aCharMap() As Variant
Dim aText() As Variant, bText() As String
Dim iText() As Byte, i As Integer, j As Integer, k As Integer
aCharMap = 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", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "-", "_", "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", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "-", "_")
If sDirection = "ToBinary" Then
ReDim aText(Len(sText) - 1)
ReDim iText(Len(sText) - 1)
For i = 1 To Len(sText)
aText(i - 1) = UCase(Mid$(sText, i, 1))
Next
For j = 0 To UBound(aText)
For k = 0 To UBound(aCharMap)
If aCharMap(k) = aText(j) Then
iText(j) = CByte(k)
Exit For
End If
Next k
Next j
Convert = iText()
ElseIf sDirection = "FromBinary" Then
bText = Split(sText, ",")
ReDim aText(LBound(bText) To UBound(bText))
For j = 0 To UBound(bText)
aText(j) = aCharMap(bText(j))
Next
Convert = Join(aText(), "")
End If
End Function
(And just to head off the inevitable question... No, this doesn't need to be secure. It isn't intended as a lock on a door. It is intended to very simply hide the door. I completely understand that if they look for it, it won't be hard to find and it will open right up with a gentle nudge.)
Thanks for any help!
Related
so I am making a decryption software that allows the user to input some text and then they can swap out letters in the program. For example, there is a drop down box that allows you to swap all the "O"'s in a user input to "W". So in the input "Stack overflow" the output would be "Stack wverflww".
However, my problem is is that when the user chooses a second letter to change, that has already been swapped, it causes a problem. For example, after the first above example has occurred, if the user then wanted to then change all the "W"'s in their input to "A"'s the output would be "stack averflaa". However, what I'm looking for the code to do is give an output of "Stack wverflwa". So only the original "W"'s of the user input are changed to the letter "A".
I hope the above makes sense.
Someone suggested using a two dimensional array to reassign the letters new letters and I am able to do this, but I have no idea how to then put this into my code and get it working. Below is my code and thank you to anyone who can help me.
Dim chooseLetter, replaceLetter, words2
chooseLetter = selectLetterCombo.Text
replaceLetter = replaceLetterCombo.Text
words2 = UCase(textInputBox.Text)
Dim replaceList As New List(Of String)
For Each z In words2
If z = chooseLetter Then
replaceList.Add(replaceLetter)
Else
replaceList.Add(z)
End If
Next
letterReplaceBox.Text = ""
For Each f In replaceList
letterReplaceBox.Text = letterReplaceBox.Text & f
Next
note: selectLetterCombo.Text is the letter chosen by the user that they want to replace and replaceLetterCombo.Text is the letter chosen by the user that they want to swap the first chosen letter with. Also, textInputBox.text is the text the user has inputted.
Thank you!
You should be able to keep a list of the index of the character that changed and check that before making another change.
'List to keep track of changed character index
Dim replacedCharsList As New List(Of Integer)'member variable
Dim chooseLetter, replaceLetter, words2
chooseLetter = selectLetterCombo.Text
replaceLetter = replaceLetterCombo.Text
words2 = UCase(textInputBox.Text)
Dim replaceList As New List(Of String)
Dim i As Integer
For i = 1 To Len(words2)
'remove the for each and go with a straight for loop to keep track if the index
If Mid(words2, i, 1) = chooseLetter Then
'check to see if we have already replaced this character via the index position
If replacedCharsList.Contains(i) = False Then
'we have not changed this so add the replacement letter and update our index list
replaceList.Add(replaceLetter)
replacedCharsList.Add(i)
Else
'we have already changed this character so just add it as is
replaceList.Add(Mid(words2, i, 1))
End If
Else
replaceList.Add(Mid(words2, i, 1))
End If
Next
letterReplaceBox.Text = ""
For Each f In replaceList
letterReplaceBox.Text = letterReplaceBox.Text & f
Next
I have an answer, but you're really not going to like it:
Option Infer On
Option Strict On
Imports System.Text.RegularExpressions
Module Module1
Dim swaps As New Dictionary(Of Char, Char)
Function DoSwaps(originalText As String, swapLetters As Dictionary(Of Char, Char)) As String
Dim newText As String = ""
For Each c In originalText
If swapLetters.ContainsKey(c) Then
newText &= swapLetters(c)
Else
newText &= c
End If
Next
Return newText
End Function
Sub Main()
Console.Write("Enter the text to be altered: ")
Dim t = Console.ReadLine()
Dim exitNow = False
Do
Console.Write("Enter the letter to swap from and the letter to swap to, or a blank line to quit: ")
Dim s = Console.ReadLine()
If s.Trim().Length = 0 Then
exitNow = True
Else
Dim parts = Regex.Matches(s, "([A-Za-z])")
If parts.Count >= 2 Then
Dim letter1 = CChar(parts.Item(0).Value)
Dim letter2 = CChar(parts.Item(1).Value)
If swaps.ContainsKey(letter1) Then
swaps.Item(letter1) = letter2
Else
swaps.Add(letter1, letter2)
End If
Console.WriteLine(DoSwaps(t, swaps))
End If
End If
Loop Until exitNow
End Sub
End Module
... unless you'd like to learn about the Dictionary class to understand how it works. I used a simple regular expression to parse the user input, but if you're using dropdowns to select the letters then that would just be bonus learning if you explore it.
The essential feature is that you keep the original string (t in the above code) and apply the transformation (I named it DoSwaps) to that each time, not to the previously transformed string.
These two functions will do the job, although there is no allowance for punctuation, just spaces.
Private Function EncryptText(str As String) As String
Dim swapletters() As String = {"l", "s", "d", "f", "g", "h", "j", "k", "a", "q", "w", "e", "r", "t", "y", "u", "i", "o", "p", "z", "x", "c", "v", "b", "n", "m"}
Dim encryptedText As String = ""
For Each letter As Char In str
If letter = " "c Then
encryptedText = encryptedText & " "
Else
Dim charactercode As Integer = Asc(letter) - 97
encryptedText = encryptedText & swapletters(charactercode)
End If
Next
Return encryptedText
End Function
Private Function DecryptText(str As String) As String
Dim swapletters As New List(Of String) From {"l", "s", "d", "f", "g", "h", "j", "k", "a", "q", "w", "e", "r", "t", "y", "u", "i", "o", "p", "z", "x", "c", "v", "b", "n", "m"}
Dim decryptedText As String = ""
For Each letter As Char In str
If letter = " "c Then
decryptedText = decryptedText & " "
Else
Dim character As String = Chr(swapletters.IndexOf(letter) + 97)
decryptedText = decryptedText & character
End If
Next
Return decryptedText
End Function
To use them, declare a string to hold the return value of each function
Dim etext As String
etext = EncryptText("disambiguation is the root of all evil")
results in etext being "faplrsajxlzayt ap zkg oyyz yh lee gcae"
and
Dim dtext As String
dtext = DecryptText("faplrsajxlzayt ap zkg oyyz yh lee gcae")
results in "disambiguation is the root of all evil"
I am getting run time error 6: Overflow through the below code.
n = (.Cells(Rows.Count, "A").End(xlUp).Row)
FillP = Array("D", "E", "F", "H", "I", "J", "M", "O", "P", "AR", "AS", "BE", "BF", "BG", "BH", "BI", "BJ", "BK", "BL", "BQ", "BR", "BS", "BT", "BU", "BV", "BW", "BX", "BY", "CB", "CC", "CD")
'fill blanks with na
For i = 2 To n
For j = LBound(FillP) To UBound(FillP)
If Trim(.Range(FillP(j) & i)) = "" Then
.Range(FillP(j) & i) = "na"
End If
Next j
Next i
I have Excel 2010, I haven't yet declared any of the above variables yet (will do after testing). Just trying to fill blanks in specific columns with an "na". Nearly identical code appears earlier in my sub and yet it runs fine. No idea where i'm going wrong.
Thanks in advance for any help!
overflow results when you try to assign value to a variable, that exceeds the limitations of the data type.
I am afraid that you might have declared i, j, or n as Interger.
Also you will not need the dot operator before cells & range.
Where does the error specificaally occur? just from inspection, you do not need the dots before Cells and Range. You would only do that in a with statement
This question already has answers here:
How can I delete an item from an array in VB.NET?
(12 answers)
Closed 8 years ago.
I have below variable.
Dim strValues As String() with values "1", "2", "3", "4", "5", "6", "7"
I want to delete "4" from StrValues based on the string index without knowing the string value in vb.net. How can I do this?
I'd use Linq for simplicity:
Dim strValues = {"1", "2", "3", "4", "5", "6", "7"}
strValues = strValues.Where(Function(s) s <> "4").ToArray 'Removes all instances
Better yet, use a list:
Dim strValues = {"1", "2", "3", "4", "5", "6", "7"}.ToList
strValues.Remove("4") 'Removes first instance of "4" only
If you want to do it by value at index you could do something like the following (though these will remove all instances of the value):
Dim index = 3
strValues = strValues.Where(Function(s) s <> strValues(index)).ToArray
or
strValues = strValues.Except({strValues(index)}).ToArray
To remove or skip a given index (single instance only), you could do something like this:
Dim index = 3
strValues = strValues.Take(index).Concat(strValues.Skip(index + 1)).ToArray
Dim strValues As String() = New String() {"1", "2", "3", "4"}
Dim strList As List(Of String) = strValues.ToList()
strList.Remove("4")
strValues = strList.ToArray()
Depending on what you mean by "delete", you could do a couple of things. First, if you're for a dynamically sized array, you may want to look into the ArrayList or List(of T). This class allows you to add and delete objects to an array while resizing for you if necessary. However, if you literally want to delete it from your array, you can set the value to 0 or Nothing or shift all the values in the array after it down one index.
A friend asked me to make a character string randomizer for a game she plays. I got the code working but now she wants to have the characters seperated every third character with a dash (or a space), but I can't get it to work. Any help will be appreciated.
For x As Integer = 1 To 10
strb.Append(chars(Int(Rnd() * UpperBound)))
If x Mod 2 = 0 Then
strb.Append("-")
The characters need to be separated, but how do I prevent the added dash at the end of the randomized characters?
Thanks guys (and girls) for your help it's working
Just append a dash (or whatever) every third character:
For x As Integer = 1 To 5
strb.Append(chars(Int(Rnd() * UpperBound)))
If x Mod 3 = 0 Then
strb.Append("-")
End If
Next
Since i haven't used those old VB function yet, i'll show you how to do it with VB.NET which could also be converted to C# easily:
Private Function RandomString(rnd As Random, size As Integer) As String
Dim chars() As String = {"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", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"}
Dim builder As New System.Text.StringBuilder()
For i As Integer = 0 To size - 1
builder.Append(chars(rnd.Next(0, chars.Length)))
Next
Return builder.ToString()
End Function
Let us generate a random string with 5 chars:
Dim rnd = New Random()
Dim rndString = RandomString(rnd, 5)
Note that i'm passing the random instance since. If i would create it in the method and call it in a loop, it would generate the same strings since the Random would use the same time as seed.
Edit: I've only just seen that you need to separate the result. You could use an overloaded version:
Private Overloads Function RandomString(rnd As Random, size As Integer, separator As String, everyNChar As Int32) As String
Dim builder = New System.Text.StringBuilder()
Dim chars() As String = {"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", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"}
For i As Integer = 0 To size - 1
If i > 0 AndAlso i Mod everyNChar = 0 Then
builder.Append(chars(rnd.Next(0, chars.Length))).Append(separator)
Else
builder.Append(chars(rnd.Next(0, chars.Length)))
End If
Next
Return builder.ToString()
End Function
Note that this will not count the separators.
You can use Regular Expressions to replace strings. It will be simple to change the regex and manage change requests :)
just replace TextBox1.Text = rndstring by :
TextBox1.Text = Regex.Replace(rndstring, "[a-zA-Z0-9]{3}", "$& ")
Note that you need to add Imports System.Text.RegularExpressions if not already done.
EDIT : I have given the above solution to insert a " " (whitespace) after every third character. If you want a hyphen (-) just change the second regex to "$&-"
If I'm understanding you correctly, change the if statement from If x Mod 2 = 0 Then to If x Mod 2 = 0 And x <> 10 Then. That way it wont append the dash if it is on the last element.
I have this 2D array:
Private _Chars As String(,) = {{"`", "1", "2", "3", "4", "5", "6", "7", "8", "9", "0", "-", "="},
{"¬", "!", """", "£", "$", "%", "^", "&", "*", "(", ")", "_", "+"}}
I want to Pass a Dimension (ie. the First Line) into a Function, or the Second Line into a function to switch between these two lists so that the function only requires a String() parameter not a String(,) parameter so I could loop through both like so:
Sub Example(Row as String())
For Index as Integer = 0 To Row.Count - 1
MessageBox.Show(Row(Index))
Next
End Sub
And this function would loop though 12345 etc and !"£$% etc.
If there is way to have the arrays work this was and that works in Silverlight - I would ge very grateful!
You can't do it (easily). Your best option is to create a jagged array (an array of arrays) like this:
Private _Chars String()() = { New String() {"`", "1", "2", "3", "4", "5", "6", "7", "8", "9", "0", "-", "="},
New String() {"¬", "!", """", "£", "$", "%", "^", "&", "*", "(", ")", "_", "+"}}
You could then call your function like this:
Example(_Chars(0))
Example(_Chars(1))
You could use a jagged array instead.