I have a stack overflow question regarding the following code:
For Each DeltaCharB As Char In DeltaString
If DeltaCharB = "[" Then
Dim DeltaIndexB As Integer = TB8.IndexOf("[B|")
Dim DeltaStringB As String = TB8.Substring(DeltaIndexB + 3, TB8.IndexOf("]", DeltaIndexB + 1) - DeltaIndexB - 3)
MsgBox(DeltaStringB)
Else
'Do nothing
End If
Next
The issue created is that if the code is run X number of times that the character "[" is found, The string is displayed the same X amount of times in a messagebox.
However I only want to have it processed 1X. I have tried to change the following line but as i expected only one character at a time is permitted.
If DeltaCharB = "[B|" Then
Typically the string used to search in would be as follows:
{[A|Text belonging to entry A][B|Text belonging to entry B][C|Text belonging to entry C]}.... ect...ect
Dose anybody know how to resolve this?
Why do you need a loop? Your delimiters are well defined, you can just do this:
Function GetContent(byval input as string, byval delimiter as string) as string
Dim fullDelimiter = "["& delimiter &"|"
Dim BeginPosition as Integer = input.IndexOf(fullDelimiter)
if BeginPosition > -1 then
BeginPosition += fullDelimiter.Length
Dim EndPosition = input.IndexOf("][", BeginPosition)
if EndPosition > -1 then
return input.SubString(BeginPosition, EndPosition - BeginPosition)
end if
end if
return ""
End Function
And the usage:
Dim s as string = "[A|Text belonging to entry A][B|Text belonging to entry B][C|Text belonging to entry C]"
Dim content = GetContent(s, "B")
content now contains "Text belonging to entry B"
Note that with this code, the delimiter can by a string of any length between [ and |.
A more general solution that will fit any input format would mean to also accept the end delimiter in the function:
Function GetContent(byval input as string, byval FromDelimiter as string, byval ToDelimiter as string) as string
Dim BeginPosition as Integer = input.IndexOf(FromDelimiter)
if BeginPosition > -1 then
BeginPosition += FromDelimiter.Length
Dim EndPosition = input.IndexOf(ToDelimiter, BeginPosition)
if EndPosition > -1 then
return input.SubString(BeginPosition, EndPosition - BeginPosition)
end if
end if
return ""
End Function
Related
I would like all possible combinations from two string arrays.
Both arrays must have same length.
Result must keep order
For example :
dim lStr1() as string = {"One", "Two", "Three"}
dim lStr2() as string = {"EditOne", "EditTwo", "EditThree"}
dim res() as string = myAwesomeFunction(lStr1, lStr2)
// res :
One Two Three
One Two EditThree
One EditTwo Three
One EditTwo EditThree
EditOne Two Three
EditOne Two EditThree
EditOne EditTwo Three
EditOne EditTwo EditThree
It's like the binary composition of 2 arrays of strings.
Here's another solution. Since only 2 arrays are involved, we can bit-fiddle to get all of the "combinations". The & " " is just to format the output to match the example.
Private Function myAwesomeFunction(Array1() As String, Array2() As String) As String()
If Array1.Length <> Array2.Length Then
Throw New ArgumentException("Array lengths must be equal.")
End If
Dim combos(CInt(2 ^ Array1.Length) - 1) As String
For i As Integer = 0 To combos.Count - 1
For j = 0 To Array1.Length - 1
If (i And (1 << j)) > 0 Then
combos(i) += Array2(j) & " "
Else
combos(i) += Array1(j) & " "
End If
Next
Next
Return combos
End Function
The following code will produce the array in your example. It should work for any pair of input arrays. The function checks that the input arrays are of the same length.
The GetPermutations function is taken from a more general class I use for generating permutations of numbers. It returns arrays of total Integers between 0 and choose - 1, and being an Iterator function, it returns the next array each time it is called.
In order to match your example, I returned an array of String where each element is a single string consisting of each of the selected strings separated by spaces. You may find it more useful to return a List(Of String()) or even a List(Of List(Of String))
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim lStr1() As String = {"One", "Two", "Three"}
Dim lStr2() As String = {"EditOne", "EditTwo", "EditThree"}
Dim res() As String = myAwesomeFunction(lStr1, lStr2)
End Sub
Function MyAwesomeFunction(lStr1() As String, lStr2() As String) As String()
Dim combos As New List(Of String)
If lStr1.Length <> lStr2.Length Then Throw New ArgumentException("Arrays must have the same length")
For Each combo() As Integer In GetPermutations(lStr1.Length, 2)
Dim elem As New List(Of String)
For i As Integer = 0 To combo.Length - 1
elem.Add(If(combo(i) = 0, lStr1(i), lStr2(i)))
Next
combos.Add(String.Join(" ", elem))
Next
Return combos.ToArray
End Function
Public Iterator Function GetPermutations(choose As Integer, total As Integer) As IEnumerable(Of Integer())
Dim totals() As Integer = Enumerable.Repeat(Of Integer)(total, choose).ToArray
Dim value(choose - 1) As Integer
Do
Yield value
For index As Integer = choose - 1 To 0 Step -1
value(index) += 1
If value(index) < totals(index) Then Continue Do
value(index) = 0
Next
Exit Do
Loop
End Function
I am writing a vb.net program to generate a three digit serial number I will use in printing a barcode.
The requirements are the counter must count:
001 - 999, A00 - A99, B00 - B99, ..., Z00 - Z99
I cannot use the letters O and I
This code simply increments the value I pass to it by 1. I first check if the value is <=998 and if so return the value in 3 digits. I had to put this in a Try statement because passing the value 'A00' caused an error.
The code is still breaking once I hit Z99.
Problem: If the next serial number = Z90 and the user wants to print 35 barcodes I need to stop the operation before it begins and warn the user there are only 10 avail serial numbers remaining
Also, I am also hoping for advice on how I could have accomplished this in a better manner, any advice would be greatly appreciated
Public Shared Function NextSerial(ByVal value As String) As String
Try
If value <= 998 Then
value += 1
Return ZeroPad(value, 3)
End If
Catch ex As Exception
End Try
Const chars As String = "ABCDEFGHJKLMNPQRSTUVWXYZ"
Dim threenumber As String = ZeroPad(value, 3) 'ensure value is 3 digits.
Dim alpha As String = threenumber.Substring(0, 1).ToUpper() ' 1st digit
Dim beta As String = threenumber.Substring(1, 2) 'remaining two digits
Dim newNumber As String
Dim nextletter As String
If beta = "99" Then
beta = "00"
nextletter = chars.Substring((chars.IndexOf(alpha, System.StringComparison.Ordinal) + 1), 1)
newNumber = nextletter + beta
Return newNumber
Else
beta += 1
newNumber = alpha + ZeroPad(beta, 2)
Return newNumber
End If
End Function
Private Shared Function ZeroPad(ByVal number As String, ByVal toLength As Integer) As String
ZeroPad = number
'add the necessary leading zeroes to build it up to the desired length.
Do Until Len(ZeroPad) >= toLength
ZeroPad = "0" & ZeroPad
Loop
End Function
I think you can do this by assuming your first character is the 'hundreds' and converting to a number and incrementing:
Private Function NextSerial(value As String) As String
Const chars As String = "0123456789ABCDEFGHJKLMNPQRSTUVWXYZ"
Dim numericValue As Integer = 100 * (chars.IndexOf(value.Substring(0, 1))) + Integer.Parse(value.Substring(1, 2))
numericValue += 1
Return chars.Substring(numericValue \ 100, 1) + (numericValue Mod 100).ToString.PadLeft(2, "0")
End Function
You should of course perform some error checking at the start of the function to make sure a valid serial number has been handed into the function. I would also put this function into a class and add functions such as isValid, SerialsRemaining and perhaps a function to retrieve a list of multiple serials.
I created constant strings that represent every available character in each digit position. I then used indexing to lookup the positions of the current serial number & moved one number forward to get the next serial. This will always provide the next serial until you run out of numbers.
Note: this code can easily be made more compact, but I left it as-is thinking it might be clearer.
Const charString1 As String = "0123456789ABCDEFGHJKLMNPQRSTUVWXYZ"
Const charString2 As String = "0123456789"
Const charString3 As String = "0123456789"
Public Function NextSerial(ByVal value As String) As String
' ensures the input is three chars long
Dim threenumber As String = Right("000" & value, 3)
Dim char1 As String = threenumber.Substring(0, 1)
Dim char2 As String = threenumber.Substring(1, 1)
Dim char3 As String = threenumber.Substring(2, 1)
Dim char1Pos As Integer = charString1.IndexOf(char1)
Dim char2Pos As Integer = charString2.IndexOf(char2)
Dim char3Pos As Integer = charString3.IndexOf(char3)
If char1Pos = -1 Or char2Pos = -1 Or char3Pos = -1 Then Throw New Exception("Invalid serial number format")
' move to next serial number
char3Pos += 1
If char3Pos > charString3.Length() - 1 Then
char3Pos = 0
char2Pos += 1
End If
If char2Pos > charString2.Length() - 1 Then
char2Pos = 0
char1Pos += 1
End If
If char1Pos > charString1.Length() - 1 Then Throw New Exception("Out of serial numbers!")
Return charString1.Substring(char1Pos, 1) & charString2.Substring(char2Pos, 1) & charString3.Substring(char3Pos, 1)
End Function
I suggest you use integer for all your check and calculation and only convert to serial number for display. It'll be a lot easier to know how many serial number are remaining.
Your serial number is similar to integer except everything over 100 is a letter instead of a number.
Note: It's very important to add error checking, this assumes that all input are valid.
Module Module1
Sub Main()
Console.WriteLine(SerialNumber.ConvertSerialNumberToInteger("D22"))
Console.WriteLine(SerialNumber.ConvertIntegerToSerialNumber(322))
Console.WriteLine(SerialNumber.GetAvailableSerialNumber("Z90"))
For Each sn As String In SerialNumber.GetNextSerialNumber("X97", 5)
Console.WriteLine(sn)
Next
Console.ReadLine()
End Sub
End Module
Class SerialNumber
Private Const _firstPart As String = "ABCDEFGHJKLMNPQRSTUVWXYZ"
Public Shared Function ConvertSerialNumberToInteger(ByVal serialNumber As String) As Integer
Return (_firstPart.IndexOf(serialNumber(0)) * 100) + Integer.Parse(serialNumber.Substring(1, 2))
End Function
Public Shared Function ConvertIntegerToSerialNumber(ByVal value As Integer) As String
Return _firstPart(value \ 100) & (value Mod 100).ToString("00")
End Function
Public Shared Function GetAvailableSerialNumber(ByVal serialNumber As String)
Dim currentPosition As Integer
Dim lastPosition As Integer
currentPosition = ConvertSerialNumberToInteger(serialNumber)
lastPosition = ConvertSerialNumberToInteger("Z99")
Return lastPosition - currentPosition
End Function
Public Shared Function GetNextSerialNumber(ByVal serialNumber As String, ByVal amount As Integer) As List(Of String)
Dim newSerialNumbers As New List(Of String)
Dim currentPosition As Integer
currentPosition = ConvertSerialNumberToInteger(serialNumber)
For i As Integer = 1 To amount
newSerialNumbers.Add(ConvertIntegerToSerialNumber(currentPosition + i))
Next
Return newSerialNumbers
End Function
End Class
I created the following function, but have not been able to finish. I want to return the first 2 characters of each word in the string. Here is what I have so far:
Function SelectWords(ByVal text As String, ByVal maxWords As Integer) As String
If String.IsNullOrEmpty(text) Then Return String.Empty
If maxWords <= 0 Then Return String.Empty
Dim words As String() = text.Split(" "c)
Return String ''I am stuck here
End Function
You did not describe the purpose of maxwords, nor what to do with a. The loop part:
Dim words = str.Split(" "c)
Dim ret As New StringBuilder ' in case it is a long string
For Each w As String In words
If w.Length > 1 Then
ret.Append(w.Substring(0, 2))
Else
' decide if you want 1
End If
Next
return ret.toString
The code you have doesn't do anything that you describing .. Try this function instead.
Function SelectWords(ByVal text As String, ByVal maxWords As Integer) As String
Dim collection As MatchCollection = Regex.Matches(text, "(\w{2})\w*\b")
Dim output As New System.Text.StringBuilder
Dim counter As Integer = 0
For Each M As Match In collection
output.Append(M.Groups(1).Value)
counter += 1
If counter = maxWords Then
Exit For
End If
Next
Return output.ToString
End Function
Okay, so I am trying to make my program take whatever your key is, and loop through each character of the key, then find the ascii code for each character code, and then loop through each character of the message, finding the ascii code of each of them, and adding the key code to the message code, doing this for each character in the key, to each character in the message. I ran into a little problem, it changes the message right after the first letter is added, and I can't figure out how to fix it, any help would be great!
Basically, all I want is to that the ascii code for the key characters and add them to the ascii code for the message characters, then convert that final code back to the new characters in the message text. Using this:
tbxMessage.Text = (AscW(Mid(tbxMessage.Text, xForMess, 1)) + AscW(vTemp))
Here is everything I've got so far:
Public Class Form1
Function fctEncryptDecrypt(pMess As String, pKey As String) As String
If Len(tbxMessage.Text) > 0 Then
Dim xForKey As Integer
Dim xForMess As Integer
Dim intKey As Integer
Dim intMessage As Integer
Dim strAsciiKeyChar As String
Dim intAsciiKeyChar As Integer
Dim strAsciiMesChar As String
Dim intAsciiMesChar As Integer
Dim vTemp As String
Dim vTempMess As String
intKey = Len(tbxKey.Text)
intMessage = Len(tbxMessage.Text)
For xForKey = 1 To intKey
strAsciiKeyChar = Mid(tbxKey.Text, xForKey, 1)
intAsciiKeyChar = AscW(strAsciiKeyChar)
vTemp = intAsciiKeyChar
For xForMess = 1 To intMessage
strAsciiMesChar = Mid(tbxMessage.Text, xForMess, 1)
intAsciiMesChar = AscW(strAsciiMesChar)
vTempMess = vTemp + intAsciiMesChar
tbxMessage.Text = (AscW(Mid(tbxMessage.Text, xForMess, 1)) + AscW(vTemp))
Next xForMess
Next xForKey
Label1.Text = vTemp
Else
MessageBox.Show("No Message Found")
End If
End Function
Private Sub btnEncrypt_Click(sender As System.Object, e As System.EventArgs) Handles btnEncrypt.Click
fctEncryptDecrypt(tbxMessage.Text, tbxKey.Text)
End Sub
End Class
tbxMessage.Text = (AscW(Mid(tbxMessage.Text, xForMess, 1)) + AscW(vTemp))
in the inner For loop is setting the value of the text box to a number.
I'd expect the use of a temporary string variable that collects
Chr((intAsciiKeyChar + intAsciiMesChar) mod 256)
I'd also expect the key to be applied one letter at a time over the message. Something like:
Dim i as Integer
Dim s as String
Dim sKey as String
Dim sMesg as String
Dim intCharacter as Integer
s = ""
For i = 1 to len(tbxMessage.Text)
sKey = Mid(tbxKey.Text, (i mod Len(tbxKey)) + 1, 1)
sMesg = Mid(tbxMessage.Text, i, 1)
intCharacter = (WAsc(sKey) + WAsc(sMesg)) mod 256
s = s & Chr(intCharacter)
Next
tbxMessage.Text = s
Beginner here, bear with me, I apologize in advance for any mistakes.
It's some homework i'm having a bit of trouble going about.
Overall goal: outputting the specific amount of characters in a string using a loop statement. Example being, user wants to find how many "I" is in "Why did the chicken cross the road?", the answer should be 2.
1) The form/gui has 1 MultiLine textbox and 1 button titled "Search"
2) User enters/copys/pastes text into the Textbox clicks "Search" button
3) Search button opens an InputBox where the user will type in what character(s) they want to search for in the Textbox then presses "Ok"
4) (where I really need help) Using a Loop Statement, The program searches and counts the amount of times the text entered into the Inputbox, appears in the text inside the MultiLine Textbox, then, displays the amount of times the character showed up in a "messagebox.show"
All I have so far
Private Sub Search_btn_Click(sender As System.Object, e As System.EventArgs) Handles Search_btn.Click
Dim counterInt As Integer = 0
Dim charInputStr As String
charInputStr = CStr(InputBox("Enter Search Characters", "Search"))
I would use String.IndexOf(string, int) method to get that. Simple example of concept:
Dim input As String = "Test input string for Test and Testing the Test"
Dim search As String = "Test"
Dim count As Integer = -1
Dim index As Integer = 0
Do
index = input.IndexOf(search, index) + 1
count += 1
Loop While index > 0
count is initialized with -1 because of do-while loop usage - it will be set to 0 even if there is no pattern occurrence in input string.
Try this Code
Dim input As String = "Test input string for Test and Testing the Test"
Dim search() As String = {"Te"}
MsgBox(input.Split(input.Split(search, StringSplitOptions.None), StringSplitOptions.RemoveEmptyEntries).Count)
Concept: Increment the count until the input containing the particular search string. If it contains the search string then replace the first occurance with string.empty (In String.contains() , the search starts from its first index, that is 0)
Dim input As String = "Test input string for Test and Testing the Test"
Dim search As String = "T"
Dim count As Integer = 0
While input.Contains(search) : input = New Regex(search).Replace(input, String.Empty, 1) : count += 1 : End While
MsgBox(count)
Edit:
Another solution:
Dim Input As String = "Test input string for Test and Testing the Test"
Dim Search As String = "Test"
MsgBox((Input.Length - Input.Replace(Search, String.Empty).Length) / Search.Length)
try this code.... untested but i know my vb :)
Function lol(ByVal YourLine As String, ByVal YourSearch As String)
Dim num As Integer = 0
Dim y = YourLine.ToCharArray
Dim z = y.Count
Dim x = 0
Do
Dim l = y(x)
If l = YourSearch Then
num = num + 1
End If
x = x + 1
Loop While x < z
Return num
End Function
Its a function that uses its own counter... for every character in the string it will check if that character is one that you have set (YourSearch) and then it will return the number of items that it found. so in your case it would return 2 because there are two i's in your line.
Hope this helps!
EDIT:
This only works if you are searching for individual Characters not words
You can try with something like this:
Dim sText As String = TextBox1.Text
Dim searchChars() As Char = New Char() {"i"c, "a"c, "x"c}
Dim index, iCont As Integer
index = sText.IndexOfAny(searchChars)
While index >= 0 Then
iCont += 1
index = sText.IndexOfAny(searchChars, index + 1)
End While
Messagebox.Show("Characters found " & iCont & " times in text")
If you want to search for words and the times each one is appearing try this:
Dim text As String = TextBox1.Text
Dim wordsToSearch() As String = New String() {"Hello", "World", "foo"}
Dim words As New List(Of String)()
Dim findings As Dictionary(Of String, List(Of Integer))
'Dividing into words
words.AddRange(text.Split(New String() {" ", Environment.NewLine()}, StringSplitOptions.RemoveEmptyEntries))
findings = SearchWords(words, wordsToSearch)
Console.WriteLine("Number of 'foo': " & findings("foo").Count)
With this function used:
Private Function SearchWords(ByVal allWords As List(Of String), ByVal wordsToSearch() As String) As Dictionary(Of String, List(Of Integer))
Dim dResult As New Dictionary(Of String, List(Of Integer))()
Dim i As Integer = 0
For Each s As String In wordsToSearch
dResult.Add(s, New List(Of Integer))
While i >= 0 AndAlso i < allWords.Count
i = allWords.IndexOf(s, i)
If i >= 0 Then dResult(s).Add(i)
i += 1
End While
Next
Return dResult
End Function
You will have not only the number of occurances, but the index positions in the file, grouped easily in a Dictionary.