Testing a trace table in VB.Net - vb.net

Working through trace tables and wanted to check to see if my results where correct, I have designed the following code to check each stage of the loop, but the code keeps throwing up an error about casting when i try to run it. I can see when the error comes back that the writeline is holding info but what have i done wrong.
Module Module1
Sub Main()
Dim aWord As String
Dim bWord As String
Dim result As Boolean
Dim temp As Char
Dim pos As Integer
Dim index As Integer
index = 0
aWord = "Simple"
bWord = "abcdef"
result = True
If Not (aWord.Length = bWord.Length) Then
result = False
Else
While index < bWord.Length And result
temp = bWord.Chars(index)
pos = aWord.IndexOf(temp)
If pos >= 0 Then
aWord = aWord.Remove(pos, 1)
Else
result = False
End If
WriteLine(bWord, aWord, temp, pos.ToString, index.ToString)
End While
End If
End Sub
End Module

You are calling WriteLine() incorrectly. It should be:
WriteLine("{0}, {1}, {2}, {3}, {4}", bWord, aWord, temp, pos.ToString, index.ToString)

Related

getting System.InvalidOperationException: Listbox DataSource VB.net

This is the error I am getting
System.InvalidOperationException: 'List that this enumerator is bound to has been modified. An enumerator can only be used if the list does not change.'
I have a Listbox that is databound The list of items are stored days table the saved value is stored in a record table. The List is a Comma Separated List E.G: 1,2,3,4,5
Would equate to Items with values of 1 -5 being selected on load.
This is the save Routine which Works perfectly
Private Sub ListBox1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ListBox1.Leave
Dim listboxItems As New List(Of String)
For Each row As DataRowView In ListBox1.SelectedItems
listboxItems.Add(row("IDNum"))
Next row
selectLoad = True
lblDays.Text = String.Join(",", listboxItems.ToArray())
End Sub
This is Routine Which is Throwing the error.
Private Sub BGWLoadData_RunWorkerCompleted(sender As Object, e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles BGWLoadData.RunWorkerCompleted
Dim TextBoxStrings() As String = {""}
Try
Dim TempStr() As String = lblDays.Text.Split(",")
ReDim TextBoxStrings(TempStr.Count - 1)
TextBoxStrings = TempStr
Catch ex As Exception
End Try
Dim TextBoxDoubles(TextBoxStrings.Count - 1) As Double
For a As Integer = 0 To TextBoxStrings.Count - 1
Try
TextBoxDoubles(a) = TextBoxStrings(a)
Catch ex As Exception
TextBoxDoubles(a) = 0
End Try
Next
Do While DaysBound = False
Application.DoEvents()
Loop
ListBox1.SelectedItems.Clear()
Dim TempIndex As Integer = 0
For Each row As DataRowView In ListBox1.Items
For a As Integer = 0 To TextBoxDoubles.Count - 1
If row("IDNum") = TextBoxDoubles(a) Then
ListBox1.SetSelected(TempIndex, True)
End If
Next
TempIndex = TempIndex + 1
Next row
End Sub
What am I doing wrong or what can be done to make the code more efficient.
Edit:
Error Occurs at Next Row.
Also telling me I have done something wrong isn't helpful I know something is Wrong because I am getting errors. I am asking for is how to fix this with a code snippet or something.
This Has been Solved by Adding a second arrary
If selectLoad = False Then
' convert CSV of IDNums of selected items in listbox into string array
Dim TextBoxStrings() As String = {""}
Try
Dim TempStr() As String = lblDays.Text.Split(",")
ReDim TextBoxStrings(TempStr.Count - 1)
TextBoxStrings = TempStr
Catch ex As Exception
End Try
' convert string array to double array
Dim TextBoxDoubles(TextBoxStrings.Count - 1) As Double
For a As Integer = 0 To TextBoxStrings.Count - 1
Try
TextBoxDoubles(a) = TextBoxStrings(a)
Catch ex As Exception
TextBoxDoubles(a) = -1
End Try
Next
' load underlying IDNums into temporary array
Dim TempIndex As Integer = 0
Dim TempIDNums(ListBox1.Items.Count - 1) As Integer
For Each row As DataRowView In ListBox1.Items
TempIDNums(TempIndex) = row("IDNum")
TempIndex = TempIndex + 1
Next row
' if any of the underlying IDNums are found in the CSV, select that item in the listbox
ListBox1.SelectedItems.Clear()
For ListItemCounter As Integer = 0 To TempIDNums.Count - 1
For SelectedItemCounter As Integer = 0 To TextBoxDoubles.Count - 1
If TempIDNums(ListItemCounter) = TextBoxDoubles(SelectedItemCounter) Then
ListBox1.SetSelected(ListItemCounter, True)
End If
Next
Next
End If

What is causing 'Index was outside the bounds of the array' error?

What is causing 'Index was outside the bounds of the array' error? It can't be my file, defianetly not. Below is my code:
Sub pupiltest()
Dim exitt As String = Console.ReadLine
Do
If IsNumeric(exitt) Then
Exit Do
Else
'error message
End If
Loop
Select Case exitt
Case 1
Case 2
Case 3
End Select
Do
If exitt = 1 Then
pupilmenu()
ElseIf exitt = 3 Then
Exit Do
End If
Loop
Dim score As Integer
Dim word As String
Dim totalscore As Integer = 0
'If DatePart(DateInterval.Weekday, Today) = 5 Then
'Else
' Console.WriteLine("You are only allowed to take the test on Friday unless you missed it")
' pupiltest()
'End If
Dim founditem() As String = Nothing
For Each line As String In File.ReadAllLines("F:\Computing\Spelling Bee\stdnt&staffdtls.csv")
Dim item() As String = line.Split(","c)
founditem = item
Next
Dim stdntfname As String = founditem(3)
Dim stdntsname As String = founditem(4)
Dim stdntyear As String = founditem(5)
Console.Clear()
If founditem IsNot Nothing Then
Do
If stdntyear = founditem(5) And daytoday = founditem(6) Then
Exit Do
ElseIf daytoday <> founditem(6) Then
Console.WriteLine("Sorry you are not allowed to do this test today. Test available on " & item(6).Substring(0, 3) & "/" & item(6).Substring(3, 6) & "/" & item(6).Substring(6, 9))
Threading.Thread.Sleep(2500)
pupiltest()
ElseIf stdntyear <> founditem(5) Then
Console.WriteLine("Year not found, please contact the system analysts")
Threading.Thread.Sleep(2500)
pupiltest()
End If
Loop
End If
For Each line As String In File.ReadAllLines("F:\Computing\Spelling Bee\testtests.csv")
Dim item() As String = line.Split(","c)
Dim mine As String = String.Join(",", item(2), item(3), item(4), item(5), item(6))
For i As Integer = 1 To 10
Console.WriteLine(i.ToString & "." & item(1))
Console.Write("Please enter the word: ")
word = Console.ReadLine
If word = Nothing Or word <> item(0) Then
score += 0
ElseIf word = item(0) Then
score += 2
ElseIf word = mine Then
score += 1
End If
Next
If score > 15 Then
Console.WriteLine("Well done! Your score is" & score & "/20")
ElseIf score > 10 Then
Console.WriteLine("Your score is" & score & "/20")
ElseIf score Then
End If
Next
Using sw As New StreamWriter("F:\Computing\Spelling Bee\stdntscores", True)
sw.Write(stdntfname, stdntsname, stdntyear, score, daytoday, item(7))
Try
Catch ex As Exception
MsgBox("Error accessing designated file")
End Try
End Using
End
End Sub
All help is highly appreciated,
You are constantly replacing the foundItem array when you do founditem = item:
Dim founditem() As String = Nothing
For Each line As String In File.ReadAllLines("F:\Computing\Spelling Bee\stdnt&staffdtls.csv")
Dim item() As String = line.Split(","c)
founditem = item
Next
Also, you are using (=) the assignment operation instead of (==) relational operator, to compare. Refer to this article for help in understanding the difference between the two.
Instead of this: If stdntyear = founditem(5) And daytoday = founditem(6) Then
Use this: If (stdntyear == founditem(5)) And (daytoday == founditem(6)) Then
Now back to your main error. You continue to assign the itemarray to founditem every time you iterate (Which overwrites previous content). At the end of the Iteration you will be left with the last entry in your CSV only... So in other words, founditem will only have 1 element inside of it. If you try to pick out ANYTHING but index 0, it will throw the exception index was outside the bounds of the array
So when you try to do the following later, it throws the exception.
Dim stdntfname As String = founditem(3) 'index 3 does not exist!
To fix it do the following change:
Dim founditem() As String = Nothing
For Each line As String In File.ReadAllLines("F:\Computing\Spelling Bee\stdnt&staffdtls.csv")
'NOTE: Make sure you know exactly how many columns your csv has or whatever column
' you wish to access.
Dim item() As String = line.Split(","c)
founditem(0) = item(0) 'Assign item index 0 to index 0 of founditem...
founditem(1) = item(1)
founditem(2) = item(2)
founditem(3) = item(3)
founditem(4) = item(4)
founditem(5) = item(5)
founditem(6) = item(6)
Next
For more help on how to work with VB.NET Arrays visit this site: http://www.dotnetperls.com/array-vbnet
In your line Dim item() As String = line.Split(","c) there's no guarantee that the correct number of elements exist. It's possible that one of the lines is missing a comma or is a blank trailing line in the document. You might want to add a If item.Length >= 7 and skipping rows that don't have the right number of rows. Also, remember that unlike VB6, arrays in .Net are 0 based not 1 based so make sure that item(6) is the value that you think it is.

random number in multi threading not working

please examine my code below :
Public Class tier1
Dim rnd As New System.Random()
Function build1(ByVal dt As DataTable) As String
Try
For i = 0 To 4
For ix As Integer = 0 To till Step 4
lstrn.Add(rnd.Next(ix, ix + 4))
Next
Dim cntx As Integer = 0
For Each x As Integer In lstrn
If (i = 0) Then
If (article(x).Split(ChrW(10)).Length > 2) Then
If (article(x).Split(ChrW(10))(0).Length > 300) Then
first.Add(article(x).Split(ChrW(10))(0))
cntx = cntx + 1
If (cntx = 25) Then
Exit For
End If
End If
End If
End If
lstrn.Clear()
Next
Dim fi as String = "{"
For dx As Integer = 0 To first.Count - 2
fi = fi & w.spinl(first(dx), "light") & "|"
Next
fi = fi & "}"
Return fi
Catch ex As Exception
End Try
End Function
End Class
Now see my calling code :
Dim w As WaitCallback = New WaitCallback(AddressOf beginscn)
For var As Integer = 1 To NumericUpDown1.Value
Dim param(1) As Object
param(0) = lst
param(1) = var
ThreadPool.QueueUserWorkItem(w, param)
Next
sub
sub beginscn()
Dim scntxt As String = t1.buildtier1(dt)
end sub
Now understand what i give and what i want. Suppose i pass a datatable like this :
1,abcd,34,5
2,adfg,34,5
3,fhjrt,34,5
4,rtitk,34,5
What i want is {abcd|adfg|fhjrt|rtitk} and this sequence should be random everytime. Since i pass like 50-100 values and exit loop at 25 each output should have a different sequence of 25 strings in {|} format but it does not work like that. Everytime i get same sequence.
Can anyone explain why does it do like that and any possible solution for this problem?
Note : I have already tried shuffling datatable just before queuing it but still it does not work.
The random object is not thread safe. You could work around this by creating separate instances of the random object in each thread and use the thread ID to generate the
seed.
http://msdn.microsoft.com/en-us/library/ms683183%28VS.85%29.aspx

Vb.Net something that i want to fix in my function - Stopwatch

i make function that convert time string ("hh\:mm\:ss\,fff" - example:"00:00:00,100") to parts
strTime = "00:00:00,100" =
h int = 0
m int = 0
sec int = 0
millisec int = 100
The function:
Public Function ShowInLabel(ByVal TEXT As String, ByVal time As String, ByVal startTime As Boolean) As Boolean
On Error Resume Next
Dim sss As String
sss = time
Dim start As String = StrReverse(sss)
start = StrReverse(start.Substring(0, 3))
Dim s As Integer
s = Integer.Parse(start)
Dim secstart As String = StrReverse(sss).Substring(0, 6)
secstart = StrReverse(secstart)
Dim secs As Integer = Integer.Parse(secstart.Substring(0, 2))
Dim hurs As Integer = Integer.Parse(sss.Substring(0, 2))
Dim mins As Integer = Integer.Parse(StrReverse(StrReverse(sss.Substring(0, 5)).Substring(0, 2)))
Dim stopWatch As New Stopwatch()
stopWatch.Start()
noh:
If stopWatch.Elapsed.Hours = hurs Then
GoTo yesh
Else
GoTo noh
End If
yesh:
If stopWatch.Elapsed.Minutes = mins Then
GoTo yesm
Else
GoTo yesh
End If
yesm:
If stopWatch.Elapsed.Seconds = secs Then
GoTo yess
Else
GoTo yesm
End If
yess:
If stopWatch.Elapsed.Milliseconds > s Or stopWatch.Elapsed.Milliseconds = s Then
GoTo done
Else
GoTo yess
End If
done:
If startTime = False Then
Label1.Text = ""
Else
Label1.Text = TEXT
End If
Return True
End Function
example:
ShowInLabel("SubTitle", "00:00:00,100", True)
The Function Works ,
but when the function runing the application is Stucked Till the function return true
Why it happening?
All you need to do is something like this:
Dim time As Date = DateTime.ParseExact("00:01:02,123", "hh:mm:ss,fff", CultureInfo.InvariantCulture)
Dim h As Integer = time.Hour
Dim m As Integer = time.Minute
Dim sec As Integer = time.Second
Dim millisec As Integer = time.Millisecond
However, being all to familiar with what you're trying to accomplish :), I suspect what you really need is this:
Dim time As Date = DateTime.ParseExact("00:01:02,123", "hh:mm:ss,fff", CultureInfo.InvariantCulture)
Dim startTime As Date = DateTime.ParseExact("00:00:00,000", "hh:mm:ss,fff", CultureInfo.InvariantCulture)
Dim elapsed As TimeSpan = time - startTime
Dim totalMilliseconds As Integer = CType(elapsed.TotalMilliseconds, Integer)
You could, in the same way, convert the start and end times for each subtitle to total milliseconds and then compare them that way.
As others have pointed out, On Error Resume Next is only really available in VB.NET for backwards compatibility with VB6 code. You should use a Try/Catch block, instead. However, just putting a resume next above your entire method was never considered good practice, even in VB6, just as putting a try/catch block around the entire method would also be considered a bad idea.
Similarly, GoTo is just about the most terrible thing you could ever do by just about any programmer's sensibilities. You should consider other options such as loops, if/else blocks, breaking the code up into separate methods, etc., and avoid GoTo's at all costs.

VBA. How to find position of first digit in string

I have string "ololo123".
I need get position of first digit - 1.
How to set mask of search ?
Here is a lightweight and fast method that avoids regex/reference additions, thus helping with overhead and transportability should that be an advantage.
Public Function GetNumLoc(xValue As String) As Integer
For GetNumLoc = 1 To Len(xValue)
If Mid(xValue, GetNumLoc, 1) Like "#" Then Exit Function
Next
GetNumLoc = 0
End Function
Something like this should do the trick for you:
Public Function GetPositionOfFirstNumericCharacter(ByVal s As String) As Integer
For i = 1 To Len(s)
Dim currentCharacter As String
currentCharacter = Mid(s, i, 1)
If IsNumeric(currentCharacter) = True Then
GetPositionOfFirstNumericCharacter = i
Exit Function
End If
Next i
End Function
You can then call it like this:
Dim iPosition as Integer
iPosition = GetPositionOfFirstNumericCharacter("ololo123")
Not sure on your environment, but this worked in Excel 2010
'Added reference for Microsoft VBScript Regular Expressions 5.5
Const myString As String = "ololo123"
Dim regex As New RegExp
Dim regmatch As MatchCollection
regex.Pattern = "\d"
Set regmatch = regex.Execute(myString)
MsgBox (regmatch.Item(0).FirstIndex) ' Outputs 5
I actually have that function:
Public Function GetNumericPosition(ByVal s As String) As Integer
Dim result As Integer
Dim i As Integer
Dim ii As Integer
result = -1
ii = Len(s)
For i = 1 To ii
If IsNumeric(Mid$(s, i, 1)) Then
result = i
Exit For
End If
Next
GetNumericPosition = result
End Function
You could try regex, and then you'd have two problems. My VBAfu is not up to snuff, but I'll give it a go:
Function FirstDigit(strData As String) As Integer
Dim RE As Object REMatches As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.Pattern = "[0-9]"
End With
Set REMatches = RE.Execute(strData)
FirstDigit = REMatches(0).FirstIndex
End Function
Then you just call it with FirstDigit("ololo123").
If speed is an issue, this will run a bit faster than Robs (noi Rob):
Public Sub Example()
Const myString As String = "ololo123"
Dim position As Long
position = GetFirstNumeric(myString)
If position > 0 Then
MsgBox "Found numeric at postion " & position & "."
Else
MsgBox "Numeric not found."
End If
End Sub
Public Function GetFirstNumeric(ByVal value As String) As Long
Dim i As Long
Dim bytValue() As Byte
Dim lngRtnVal As Long
bytValue = value
For i = 0 To UBound(bytValue) Step 2
Select Case bytValue(i)
Case vbKey0 To vbKey9
If bytValue(i + 1) = 0 Then
lngRtnVal = (i \ 2) + 1
Exit For
End If
End Select
Next
GetFirstNumeric = lngRtnVal
End Function
An improved version of spere's answer (can't edit his answer), which works for any pattern
Private Function GetNumLoc(textValue As String, pattern As String) As Integer
For GetNumLoc = 1 To (Len(textValue) - Len(pattern) + 1)
If Mid(textValue, GetNumLoc, Len(pattern)) Like pattern Then Exit Function
Next
GetNumLoc = 0
End Function
To get the pattern value you can use this:
Private Function GetTextByPattern(textValue As String, pattern As String) As String
Dim NumLoc As Integer
For NumLoc = 1 To (Len(textValue) - Len(pattern) + 1)
If Mid(textValue, NumLoc, Len(pattern)) Like pattern Then
GetTextByPattern = Mid(textValue, NumLoc, Len(pattern))
Exit Function
End If
Next
GetTextByPattern = ""
End Function
Example use:
dim bill as String
bill = "BILLNUMBER 2202/1132/1 PT2200136"
Debug.Print GetNumLoc(bill , "PT#######")
'Printed result:
'24
Debug.Print GetTextByPattern(bill , "PT#######")
'Printed result:
'PT2200136