Variable not setting or for loop not working correctly - vb.net

i'm having an issue with setting a variable to the return value of a function i made i can't seem to be able to get it to work and i get no errors or feedback from visual studios even in strict mode
Imports System.Net
Imports System.IO
Imports System.ComponentModel
Public Class Form2
Dim i As Integer
Public CleanSearchTexts As String()
Dim count As Integer = 0
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
If BackgroundWorker1.IsBusy = False Then
i = RichTextBox1.Lines.Count
i = i - 1
BackgroundWorker1.RunWorkerAsync()
Else
MsgBox("Threads are busy")
End If
End Sub
Private Sub StartThreads()
Dim SearchText As String
For count = count To i
SearchText = LineFunc(count)
count += 1
SearchText = CType(Ask_Query(SearchText), String)
SearchText = CType(Bing_Query(SearchText), String)
SearchText = CType(Yahoo_Query(SearchText), String)
Dim thread_count As String = CType(Process.GetCurrentProcess().Threads.Count - 20, String)
Label_T(thread_count)
Threading.Thread.Sleep(500)
If SearchText.Contains("All_Query:Yes") Then
SearchText = SearchText.Replace("All_Query:Yes", "")
RTB(SearchText)
End If
Next
End Sub
Private Delegate Sub UpdateStatus(ByVal s As String)
Private Delegate Sub UpdateLabel(ByVal thread_count As String)
Public Delegate Function GetTextBox(ByVal index As Integer) As String
Public Function LineFunc(ByVal index As Integer) As String
If InvokeRequired Then
Invoke(New GetTextBox(AddressOf LineFunc), index)
Else
Dim indexSearchText As String
indexSearchText = RichTextBox1.Lines(index)
Return indexSearchText
End If
End Function
Public Sub RTB(ByVal s As String)
If Me.InvokeRequired Then
Me.Invoke(New UpdateStatus(AddressOf RTB), New Object() {s})
Else
RichTextBox2.AppendText(Environment.NewLine & s)
End If
End Sub
Public Sub Label_T(ByVal thread_count As String)
If Me.InvokeRequired Then
Me.Invoke(New UpdateLabel(AddressOf Label_T), New Object() {thread_count})
Else
Label3.Text = "Threads Running: " + thread_count
End If
End Sub
Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
BackgroundWorker1.WorkerSupportsCancellation = True
BackgroundWorker1.WorkerReportsProgress = True
Dim count As Integer
Dim num As Integer = CInt(TextBox1.Text) - 1
For count = 0 To num
Dim thread = New Threading.Thread(AddressOf StartThreads)
thread.IsBackground = True
thread.Name = "Web Thread #" + CType(count, String)
thread.Start()
Threading.Thread.Sleep(500)
Next
End Sub
Private Sub BackgroundWorker1_RunWorkerCompleted(sender As Object, e As RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted
MsgBox("Work is done")
End Sub
End Class
the issue is clearly with either the line getting function or the for count
i have tested the function by adding a button and doing the process of setting a variable to the return and msgboxing it and it works perfectly not only that when i breakpoint it it shows it's returning the right output but its just not setting it for whatever reason in this sub
Public Sub StartThreads(ByVal List As Object)
Dim List2 As String() = CType(List, String())
For Each dork As String In List2
dork = CType(Ask_Query(dork), String)
dork = CType(Bing_Query(dork), String)
dork = CType(Yahoo_Query(dork), String)
Dim thread_count As String = CType(Process.GetCurrentProcess().Threads.Count - 20, String)
Label_T(thread_count)
Threading.Thread.Sleep(500)
If dork.Contains("All_Query:Yes") Then
dork = dork.Replace("All_Query:Yes", "")
RTB(dork)
End If
Next
End Sub
and here is the function
Public Delegate Function GetTextBox(ByVal index As Integer) As String
Public Function LineFunc(ByVal index As Integer) As String
If InvokeRequired Then
Invoke(New GetTextBox(AddressOf LineFunc), index)
Else
Dim indexSearchText As String
indexSearchText = RichTextBox1.Lines(index)
Return indexSearchText
End If
End Function
Update: List Split Func
Public Function splitData(ByVal width As Integer, ByVal dd As List(Of String)) As List(Of List(Of String))
Dim dds As New List(Of List(Of String))
Dim numberOfLists As Integer = (dd.Count \ width)
For i As Integer = 0 To numberOfLists
Dim newdd As List(Of String)
newdd = dd.Skip(i * width).Take(width).ToList()
dds.Add(newdd)
Next i
Return dds
End Function
Updated Background Worker
Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
BackgroundWorker1.WorkerSupportsCancellation = True
BackgroundWorker1.WorkerReportsProgress = True
Dim dds As New List(Of String)
GetList(dds)
Dim num As Integer = CInt(TextBox1.Text)
Dim ThreadCount As Integer = CInt(TextBox1.Text)
If ThreadCount > 1 Then
ThreadCount -= 1
End If
Dim RTBLines As Integer = RTB_Lines()
num = CInt(RTBLines / num)
num = CInt(Math.Ceiling(num))
Dim splitdd As List(Of List(Of String)) = CType(splitData(num, dds), List(Of List(Of String)))
For count = 0 To ThreadCount
Dim ListArray As String() = splitdd(count).ToArray
Dim newthread As New Thread(AddressOf StartThreads)
newthread.Name = "Web Thread #" + CType(count, String)
newthread.Start(ListArray)
Threading.Thread.Sleep(500)
Next
End Sub

Related

VB.NET TCP Server/Client - Get IP of connected client

I'm trying to get the IP address of the connected client but I don't know what I doing wrong. Where I can find it? I think near Sub AcceptClient. I was trying to convert cClient to string, but it always results to True or False. I'm trying to get the argument ar from cClient, which gives me an empty result.
Client.Client.RemoteEndPoint doesn't work or I can't use it correctly.
Form1.vb from Server project
Imports System.IO, System.Net, System.Net.Sockets
Public Class Form1
Dim Listener As TcpListener
Dim Client As TcpClient
Dim ClientList As New List(Of ChatClient)
Dim sReader As StreamReader
Dim cClient As ChatClient
Sub xLoad() Handles Me.Load
Listener = New TcpListener(IPAddress.Any, 3818)
Timer1.Start()
Listener.Start()
xUpdate("Server Started", False)
Listener.BeginAcceptTcpClient(New AsyncCallback(AddressOf AcceptClient), Listener)
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
''Set view property
ListView1.View = View.Details
ListView1.GridLines = True
ListView1.FullRowSelect = True
'Add column header
ListView1.Columns.Add("Adres IP", 120)
ListView1.Columns.Add("Nazwa użytkownika", 120)
End Sub
Sub AcceptClient(ByVal ar As IAsyncResult)
cClient = New ChatClient(Listener.EndAcceptTcpClient(ar))
AddHandler(cClient.MessageRecieved), AddressOf MessageRecieved
AddHandler(cClient.ClientExited), AddressOf ClientExited
ClientList.Add(cClient)
xUpdate("New Client Joined", True)
Listener.BeginAcceptTcpClient(New AsyncCallback(AddressOf AcceptClient), Listener)
End Sub
Sub MessageRecieved(ByVal Str As String)
xUpdate(Str, True)
End Sub
Sub ClientExited(ByVal Client As ChatClient)
ClientList.Remove(Client)
xUpdate("Client Exited", True)
End Sub
Delegate Sub _xUpdate(ByVal Str As String, ByVal Relay As Boolean)
Sub xUpdate(ByVal Str As String, ByVal Relay As Boolean)
On Error Resume Next
If InvokeRequired Then
Invoke(New _xUpdate(AddressOf xUpdate), Str, Relay)
Else
Dim nStart As Integer
Dim nLast As Integer
If Str.Contains("</>") Then
nStart = InStr(Str, "</></>") + 7
nLast = InStr(Str, "<\><\>")
Str = Mid(Str, nStart, nLast - nStart)
'dzielenie strina po odpowiednim syymbolu na przed i po symbolu :D
Dim mystr As String = Str
Dim cut_at As String = ","
Dim x As Integer = InStr(mystr, cut_at)
Dim string_before As String = mystr.Substring(0, x - 1)
Dim string_after As String = mystr.Substring(x + cut_at.Length - 1)
Dim otherItems As String() = {string_after}
ListView1.Items.Add(string_before).SubItems.AddRange(otherItems) 'use SubItems
ElseIf Str.Contains("<A>") Then
nStart = InStr(Str, "<A>") + 4
nLast = InStr(Str, "<B>")
Str = Mid(Str, nStart, nLast - nStart)
ListBox2.Items.Add(Str & vbNewLine)
Else
TextBox1.AppendText(Str & vbNewLine)
If Relay Then Send(Str & vbNewLine)
End If
End If
End Sub
Private Sub TextBox2_KeyDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles TextBox2.KeyDown
If e.KeyCode = Keys.Enter Then
e.SuppressKeyPress = True
xUpdate("Server Says: " & TextBox2.Text, True)
TextBox2.Clear()
End If
End Sub
Sub Send(ByVal Str As String)
For i As Integer = 0 To ClientList.Count - 1
Try
ClientList(i).Send(Str)
Catch
ClientList.RemoveAt(i)
End Try
Next
End Sub
End Class
ChatClient.vb from Server project
Imports System.Net.Sockets, System.IO
Public Class ChatClient
Public Event MessageRecieved(ByVal Str As String)
Public Event ClientExited(ByVal Client As ChatClient)
Private sWriter As StreamWriter
Public Client As TcpClient
Sub New(ByVal xclient As TcpClient)
Client = xclient
client.GetStream.BeginRead(New Byte() {0}, 0, 0, AddressOf Read, Nothing)
End Sub
Private Sub Read()
Try
Dim sr As New StreamReader(Client.GetStream)
Dim msg As String = sr.ReadLine()
RaiseEvent MessageRecieved(msg)
Client.GetStream.BeginRead(New Byte() {0}, 0, 0, New AsyncCallback(AddressOf Read), Nothing)
Catch
RaiseEvent ClientExited(Me)
End Try
End Sub
Public Sub Send(ByVal Message As String)
sWriter = New StreamWriter(Client.GetStream)
sWriter.WriteLine(Message)
sWriter.Flush()
End Sub
End Class
You can get the IP address from the underlying socket by converting the Socket.RemoteEndPoint property into an IPEndPoint:
Dim Address As IPAddress = CType(cClient.Client.Client.RemoteEndPoint, IPEndPoint).Address
MessageBox.Show(Address.ToString()) 'Example.

Multithreading duplicate error after background worker added

I wrote a program that does queries on some search engines that I wanted to be multithreaded so it could do the searches faster. I made a question about this which was answered indirectly, but I have yet another problem even after I set up delegates and such.
I was running the queries on the main thread, so I had to set up a BackgroundWorker. I did that but even though everything seems to run without an issue, I get duplicates of my results even though the program is suppose to do the opposite. Sometimes it doesn't even read or output a result that I know would be good.
Imports System.Net
Imports System.IO
Imports System.ComponentModel
Public Class Form2
Dim i As Integer
Dim SearchString As String
Public CleanSearchStrings As String()
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
i = RichTextBox1.Lines.Count
BackgroundWorker1.RunWorkerAsync()
End Sub
Private Sub StartThreads()
While i > 0
i = i - 1
Dim thread_count As String = Process.GetCurrentProcess().Threads.Count - 20
Label_T(thread_count)
SearchString = LineFunc(i)
Threading.Thread.Sleep(500)
SearchString = Ask_Query(SearchString) #This was commented out
SearchString = Bing_Query(SearchString) #just simple webscraping
SearchString = Yahoo_Query(SearchString)
If SearchString.Contains("All_Query:Yes") Then
SearchString = SearchString.Replace("All_Query:Yes", "")
RTB(SearchString)
End If
End While
End Sub
Private Delegate Sub UpdateStatus(ByVal s As String)
Private Delegate Sub UpdateLabel(ByVal thread_count As String)
Private Delegate Function Line(ByVal i As Integer)
Function LineFunc(ByVal i As Integer)
If Me.InvokeRequired Then
Me.Invoke(New Line(AddressOf LineFunc), New Object() {i})
Else
SearchString = RichTextBox1.Lines(i).ToString
Return SearchString
End If
End Function
Sub RTB(ByVal s As String)
If Me.InvokeRequired Then
Me.Invoke(New UpdateStatus(AddressOf RTB), New Object() {s})
Else
RichTextBox2.AppendText(Environment.NewLine & s)
End If
End Sub
Sub Label_T(ByVal thread_count As String)
If Me.InvokeRequired Then
Me.Invoke(New UpdateLabel(AddressOf Label_T), New Object() {thread_count})
Else
Label3.Text = "Threads Running: " + thread_count
End If
End Sub
Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
BackgroundWorker1.WorkerSupportsCancellation = True
BackgroundWorker1.WorkerReportsProgress = True
Dim count As Integer
Dim num As Integer = TextBox1.Text - 1
For count = 0 To num
Dim thread = New Threading.Thread(AddressOf StartThreads)
thread.IsBackground = True
thread.Start()
Threading.Thread.Sleep(500)
Next
End Sub
End Class
I know it has something to do with the LineFunc that I wrote but I can't seem to figure it out.
This was working flawlessly on multithreading, but the UI would be frozen and after I added the BackgroundWorker it seems to be giving me these duplicate results error and not reading the TextBox fully.
Update:
Private Sub StartThreads()
For count = count To i
Dim SearchString As String = LineFunc(count)
count += 1
Dim thread_count As String = CType(Process.GetCurrentProcess().Threads.Count - 20, String)
Label_T(thread_count)
Threading.Thread.Sleep(500)
SearchString = CType(Ask_Query(SearchString), String)
SearchString = CType(Bing_Query(SearchString), String)
SearchString = CType(Yahoo_Query(SearchString), String)
If SearchString.Contains("All_Query:Yes") Then
SearchString = SearchString.Replace("All_Query:Yes", "")
RTB(SearchString)
End If
Next
End Sub
Heres my Revised Get Line Func
Private Delegate Function GetTextBox(ByVal index As Integer) As String
Public Function LineFunc(ByVal index As Integer) As String
If Me.InvokeRequired Then
Me.Invoke(New GetTextBox(AddressOf LineFunc), New Object() {index})
Else
Dim indexSearchString As String
indexSearchString = CType(RichTextBox1.Lines(index), String)
Return indexSearchString
End If
End Function
If i use the a msgbox it gives me the right values i don't understand how come it does not give me the right values when i do the func Dim SearchString As String = LineFunc(count) it returns a null string in the end i don't understand why
this seemed to work for the duplicate issue but now i seem to be having issues with my output to richtextbox2 only outputing blanks and the line func is only giving out blanks i don't understand why either but atleast there is progress
I can't verify if this will work as you haven't posted the search functions, but here goes.
Public Class Form2
Dim i As Integer
Dim SearchString As String
Dim ResultString As String
Public CleanSearchStrings As String()
Private threadCount As Integer
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
SearchUsingRTB1Items()
End Sub
Private Sub SearchUsingRTB1Items()
threadCount = 0
Dim rtb1Lines() As String = RichTextBox1.Lines
Parallel.ForEach(rtb1Lines, Sub(line As String)
dim ResultString As String =""
threadCount += 1
Label_T(i.ToString)
ResultString =Ask_Query(line) 'This was commented out
ResultString = ResultString & Bing_Query(line) 'just simple webscraping
ResultString = ResultString & Yahoo_Query(line)
If ResultString.Contains("All_Query:Yes") Then
ResultString = ResultString.Replace("All_Query:Yes", "")
RTB(ResultString)
End If
threadCount -= 1
Label_T(i.ToString)
End Sub)
End Sub
Private Delegate Sub UpdateStatus(ByVal s As String)
Private Delegate Sub UpdateLabel(ByVal thread_count As String)
Sub RTB(ByVal s As String)
If Me.InvokeRequired Then
Me.Invoke(New UpdateStatus(AddressOf RTB), New Object() {s})
Else
RichTextBox2.AppendText(Environment.NewLine & s)
End If
End Sub
Sub Label_T(ByVal thread_count As String)
If Me.InvokeRequired Then
Me.Invoke(New UpdateLabel(AddressOf Label_T), New Object() {thread_count})
Else
Label3.Text = "Threads Running: " & thread_count
End If
End Sub
End Class

How to display random ques from text file in vb?

I have created a Quiz application in Visual Basic.I have stored the questions in a text file and I'm using streamreader to read the lines.The text file looks like this
If x is the first of five consecutive odd numbers then what is their average ?
x
x+1
x+4
x+3
3
Which of the following number is divisible by 24 ?
76300
78132
80424
81234
3
The first line is the question,the lines 2 to 5 is the options and the 6th line is the answer key and there are more than 100 questions and I should print random questions and its corresponding choices each time I open the application and it should not repeat the same question.Can any one give me a code snippet for this?
Imports System.IO
Imports System.Runtime.InteropServices
Public Class Quiz
Public ques As Integer = 1
Dim Shuffle As Integer = 0
Dim SCORE As Integer = 0
Dim val As Integer = 30
Public anskey As String
Private currentQuestion As Integer
Private listOfQuestions As List(Of Question) = New List(Of Question)
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As Integer, ByVal lParam As Integer) As IntPtr
End Function
Public Sub Reset_all()
val = 30
SCORE = 0
ProgressBar1.Value = 0
Button3.Hide()
ProgressBar1.Minimum = 0
ProgressBar1.Maximum = 30
Timer1.Enabled = True
Using reader = New System.IO.StreamReader("Quiz.txt")
Dim line = reader.ReadLine()
While (Not String.IsNullOrWhiteSpace(line))
Dim question = New Question
question.Question = line
question.Choice1 = reader.ReadLine()
question.Choice2 = reader.ReadLine()
question.Choice3 = reader.ReadLine()
question.Choice4 = reader.ReadLine()
question.Answer = reader.ReadLine()
listOfQuestions.Add(question)
line = reader.ReadLine()
End While
End Using
If listOfQuestions.Count > 0 Then
LoadQuestion(0)
End If
End Sub
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Reset_all()
End Sub
Sub LoadQuestion(questionIndex As Integer)
Dim question = listOfQuestions(questionIndex)
currentQuestion = questionIndex
If listOfQuestions.Count - 1 = currentQuestion Then
End If
With question
Label3.Text = ques
Label1.Text = .Question
RadioButton1.Text = .Choice1
RadioButton2.Text = .Choice2
RadioButton3.Text = .Choice3
RadioButton4.Text = .Choice4
anskey = .Answer
End With
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
If (SCORE > 0) Then
SCORE -= 1
End If
If (currentQuestion > 0) Then
If (ques > 0) Then
ques -= 1
LoadQuestion(currentQuestion - 1)
End If
End If
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
If (anskey = "a" And RadioButton1.Checked = True Or anskey = "b" And RadioButton2.Checked = True Or anskey = "c" And RadioButton3.Checked = True Or anskey = "d" And RadioButton4.Checked = True) Then
SCORE += 1
End If
If (currentQuestion < listOfQuestions.Count - 1) Then
If (ques <= 99) Then
ques += 1
LoadQuestion(currentQuestion + 1)
End If
End If
End Sub
Private Sub Quiz_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing
Dashboard.Show()
Me.Hide()
End Sub
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
ProgressBar1.Value += 1
val -= 1
Label2.Text = val & " Sec"
If ProgressBar1.Value = ProgressBar1.Maximum Then
Timer1.Enabled = False
End If
If ProgressBar1.Value > 23 Then
SendMessage(ProgressBar1.Handle, 1040, 2, 0)
Button3.Show()
End If
If ProgressBar1.Value = 30 Then
End If
End Sub
Private Sub SubmitResult()
MsgBox("You have Scored " + SCORE.ToString + " Out of 100")
End Sub
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
Dim Re As Integer = MsgBox("Are you sure you want to submit?",
vbYesNo, "Submit")
If (Re = 6) Then
SubmitResult()
Try
Me.Close()
Dashboard.Show()
Catch ex As Exception
End Try
End If
End Sub
Private Sub Label1_Click(sender As Object, e As EventArgs) Handles Label1.Click
End Sub
End Class
Public Class Question
Public Property Question As String
Public Property Choice1 As String
Public Property Choice2 As String
Public Property Choice3 As String
Public Property Choice4 As String
Public Property Answer As String
End Class
I would make a class "question" like this:
public Class Question
public questionas String
public answer1 as String
public answer2 as String
public answer3 as String
public answer4 as String
public correctAnswer as integer
public sub new(que as string, a1 as string, a2 as string, a3 as string, a4 as string, answer as integer)
question= que
answer1=a1
answer2=a2
answer3=a3
answer4=a4
correctAnswer=answer
end sub
end Class
Now load all your questions in the programm like this:
Imports System
Imports System.IO
Class MainWindow
private listQuestions as List(Of Question)
Public Sub window_loaded() handles MainWindow.loaded
listQuestions = loadAllQuestions()
End Sub
private function loadAllQuestions() as List(Of Question)
Dim str() As String
Try
' Open the file using a stream reader.
Using sr As New StreamReader("example.txt")
Dim line As String
' Read the stream to a string and write the string to the console.
line = sr.ReadToEnd()
Str = line.Split(vbNewLine)
End Using
Catch e As Exception
Console.WriteLine("The file could not be read:")
Console.WriteLine(e.Message)
End Try
'So now put the questions in your list:
dim list as new List(Of Question)
For i = 0 to str.count - 1
if (i+1) mod 5 = 0 then 'is divible without rest by 6
list.add(new Question(str(i-5), str(i-4), str(i-3), str(i-2), str(i-1), str(i))
end if
next
return list
end sub
'Load a random question:
private sub btNext_click() handles btNext.click()
dim ranQuestion as Question
dim r as new random
ranQuestion = listFragen.item(r.next(0,listQuestions.count))
End Class
Hope i could help you. To prevent that the programm can show the same question again its your job :)
First, I would recommend using the File.ReadAllLines() function to get an array of lines in the text file with questions. Then you can access them easily.
If you observe, the index of the line of the question will be (n - 1) * 6, where n is the question number. Once you get that, the indices of the options are given by:
i + 1
i + 2
i + 3
i + 4
where i = (n - 1) * 6. The answer key is given by:
i + 5
That should get you started. If you get stuck, leave a comment :)
So you would do the first part by:
Dim lines() As String = File.ReadAllLines("<yourQuestions.txt")
Then, you can generate a random number within the required range using:
Dim questionNumber As Integer = Random.Next(1, (lines.Length / 6) + 1)
After that, you can retrieve the question, options and answer key by:
Dim i As Integer = (questionNumber - 1) * 6
Dim question As String = lines(i)
Dim options() As String = {lines(i + 1), lines(i + 2), lines(i + 3), lines(i + 4)}
Dim answerKey As String = lines(Integer.Parse(lines(i + 5)))
You can also consider creating a class Question:
Public Class Question
Public Property Question As String
Public Property Choice1 As String
Public Property Choice2 As String
Public Property Choice3 As String
Public Property Choice4 As String
Public Property Answer As String
Public Sub New(q As String, c1 As String, c2 As String, c3 As String, c4 As String, ans As String)
Question = q
Choice1 = c1
Choice2 = c2
Choice3 = c3
Choice4 = c4
Answer = ans
End Sub
End Class
Then you can assign the properties.
Another alternative (might be better in performance, in fact, I think it should be) would be to use the File.ReadLines() function and use the Take() and Skip() extension methods of IEnumerable<T> (LINQ):
Dim questionNumber As Integer = Random.Next(1, (File.ReadLines("<yourQuestions.txt").Count() / 6) + 1)
Dim blockLines = File.ReadLines("<yourQuestions.txt").Skip((questionNumber - 1) * 6).Take(6)
Dim currentQuestion As New Question(blockLines(0), blockLines(1), blockLines(2), blockLines(3), blockLines(4), blockLines(blockLines(5)))
To start with, load your questions this way:
Dim questions = _
File _
.ReadLines("questions.txt") _
.Select(Function (x, n) New With { .Line = X, .Index = n }) _
.GroupBy(Function (xn) xn.Index \ 6, Function (xn) xn.Line) _
.Select(Function (xs) New Question() With _
{ _
.Question = xs(0), _
.Choice1 = xs(1), _
.Choice2 = xs(2), _
.Choice3 = xs(3), _
.Choice4 = xs(4), _
.Answer = xs(5) _
}) _
.ToArray()
That'll give you an array for your questions:
Next, you need to create a "queue.txt" file that contains the indices of your questions in a random order that you wish to display them in. Here's how to create your queue:
Dim rnd = New Random()
Dim queue = _
Enumerable _
.Range(0, questions.Length) _
.OrderBy(Function (n) rnd.Next()) _
.Select(Function (n) n.ToString()) _
.ToArray()
File.WriteAllLines("queue.txt", queue)
Then when you load your program, you can read this file and choose the next question to ask, and save the file, skipping the first question for next time, like this:
Dim queue = File.ReadAllLines("queue.txt")
Dim questionToAsk As Question = questions(Integer.Parse(queue.First()))
File.WriteAllLines("queue.txt", queue.Skip(1))
It would be up to you to make sure that the file is created when it doesn't exist and to write the code that checks if you've asked all the questions and need to re-create the queue.
Here are the basics of a class that uses XML.
Public Class QuestionAndAnswer
'the container for all questions/answers
Private ReadOnly qa As XElement = <QandA></QandA>
'the container for a question and some number of possible answers
Private ReadOnly ent As XElement = <entry></entry>
'the question
Private ReadOnly aquestion As XElement = <question></question>
'an answer - the c attribute will be "y" for the correct answer
Private ReadOnly ananswer As XElement = <answer c=""></answer>
Private theQA As XElement
Public Sub New()
Me.theQA = New XElement(qa) 'set up
End Sub
Public Sub New(path As String)
Me.theQA = XElement.Load(path)
End Sub
Public Sub Save(path As String)
Me.theQA.Save(path)
End Sub
Private Function AddQuestion(theQuestion As String, correctAnsw As String) As XElement
Dim e As New XElement(ent)
Dim q As New XElement(aquestion)
Dim a As New XElement(ananswer)
q.Value = theQuestion
a.Value = correctAnsw
a.#c = "y"
e.Add(q)
e.Add(a)
Me.theQA.Add(e)
Return e
End Function
Public Function AddQuestion(theQuestion As String, correctAnsw As String,
ans1 As String) As XElement
Dim e As XElement = Me.AddQuestion(theQuestion, correctAnsw)
Dim a As New XElement(ananswer)
a.Value = ans1
e.Add(a)
Return e
End Function
Public Function AddQuestion(theQuestion As String, correctAnsw As String,
ans1 As String, ans2 As String) As XElement
Dim e As XElement = Me.AddQuestion(theQuestion, correctAnsw, ans1)
Dim a As New XElement(ananswer)
a.Value = ans2
e.Add(a)
Return e
End Function
Public Function AddQuestion(theQuestion As String, correctAnsw As String,
ans1 As String, ans2 As String, ans3 As String) As XElement
Dim e As XElement = Me.AddQuestion(theQuestion, correctAnsw, ans1, ans2)
Dim a As New XElement(ananswer)
a.Value = ans3
e.Add(a)
Return e
End Function
Public Function AddQuestion(theQuestion As String, correctAnsw As String,
ans1 As String, ans2 As String, ans3 As String, ans4 As String) As XElement
Dim e As XElement = Me.AddQuestion(theQuestion, correctAnsw, ans1, ans2, ans3)
Dim a As New XElement(ananswer)
a.Value = ans4
e.Add(a)
Return e
End Function
Private Shared prng As New Random
Public LastQuestionAnswer As String
Public Function RandomQuestion() As String
Dim q As XElement = Me.SelectRandomQ
If q IsNot Nothing Then
Dim rv As New System.Text.StringBuilder
rv.AppendLine(q.<question>.Value)
rv.AppendLine()
Dim ie As IEnumerable(Of XElement)
ie = From qa In q.<answer>
Select qa
ie = ie.OrderBy(Function() prng.Next(q.<answer>.Count))
Dim x As Integer = 1
For Each a As XElement In ie
If a.#c = "y" Then
Me.LastQuestionAnswer = x.ToString
End If
rv.AppendFormat("{0}. {1}", x, a.Value)
rv.AppendLine()
x += 1
Next
rv.AppendLine()
Me.LastQuestionAnswer = Me.LastQuestionAnswer.Insert(0, rv.ToString)
Debug.WriteLine(Me.LastQuestionAnswer)
Return rv.ToString
End If
Return ""
End Function
Private Function SelectRandomQ() As XElement
If Me.theQA IsNot Nothing AndAlso Me.theQA.<entry>.Count > 0 Then
Dim ie As IEnumerable(Of XElement)
ie = From ent In Me.theQA.Elements
Where ent.#used <> "y"
Select ent
Dim rv As XElement = ie(prng.Next(ie.Count))
rv.#used = "y"
Return rv
End If
Return Nothing
End Function
End Class
A form with a richtextbox and a button shows it
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim foo As New QuestionAndAnswer
foo.RandomQuestion()
foo.AddQuestion("Which Vietnam War film directed by Francis Ford Coppola followed a screenplay based on famous adventure story Heart of Darkness?",
"Apocalypse Now",
"Good Morning Vietnam",
"Born on the Fourth of July",
"Band of Brothers")
foo.AddQuestion("What was the name of the baseball pitcher that hit a bird with a pitch during a 2001 Spring Training game?",
"Randy Johnson",
"Mike Mussina",
"Roger Clemens",
"Greg Maddux",
"Johan Santana")
foo.AddQuestion("The third largest desert in the world is the Sahara, what is the first?",
"Antarctic",
"Gobi",
"Sonoran")
foo.AddQuestion("How many US presidents have died while in office?",
"8",
"6",
"7")
foo.AddQuestion("If x is the first of five consecutive odd numbers > 0, then what is their average?",
"x + 4",
"x",
"x + 1",
"x + 3")
Dim qa As New System.Text.StringBuilder
foo.RandomQuestion()
qa.AppendLine(foo.LastQuestionAnswer)
qa.AppendLine()
foo.RandomQuestion()
qa.AppendLine(foo.LastQuestionAnswer)
qa.AppendLine()
foo.RandomQuestion()
qa.AppendLine(foo.LastQuestionAnswer)
RichTextBox1.Text = qa.ToString
End Sub

Path from URL not from C:/ Drive

I found one code which auto-change proxies from own text file located in computer.
Now I would like to rather this get path from my own URL where I store my private list of proxies, so what I have to change in the code please? and could also someone explain why? thank you.
Imports System
Imports System.Runtime.InteropServices
Imports System.IO
Imports Microsoft.VisualBasic
Imports System.Timers
Public Class Form1
Dim FILE_NAME As String = "C:\Users\name\Documents\proxylist.txt"
Dim label As String
Public proxy(2000) As String
Public index As Integer = 0
Public max_proxys As Integer = 0
Dim a As String
Dim start_check As Integer = 0
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
If (start_check > 0) Then
index = 0
Do While index <> max_proxys
proxy(index) = ""
index = index + 1
Loop
If TextBox3.Text = "" Then
FILE_NAME = "C:\Users\name\Documents\proxylist.txt"
End If
End If
If TextBox3.Text <> "" Then
FILE_NAME = TextBox3.Text
End If
Try
Dim reader As StreamReader = My.Computer.FileSystem.OpenTextFileReader(FILE_NAME)
index = 0
Do While reader.Peek <> -1
a = reader.ReadLine
proxy(index) = a.ToString
index = index + 1
Loop
max_proxys = index
reader.Close()
Catch ex As Exception
MessageBox.Show("File Not Found")
Timer1.Stop()
End Try
label = "true"
index = 0
TextBox1.Text = proxy(0)
If TextBox2.Text = "" Then
Timer1.Interval = 1000 'ms
Else
Try
Dim a As Integer = Convert.ToDecimal(TextBox2.Text)
Timer1.Interval = a * 1000 'ms
Catch ex As Exception
MessageBox.Show(ex.Message & "Please Enter Valid Time in Seconds ")
If Timer1.Enabled Then
Timer1.Stop()
End If
End Try
End If
start_check = 1
Timer1.Start()
End Sub
Private Sub TextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox1.TextChanged
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
label = "false"
End Sub
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
Dim clsProxy As New IEProxy
clsProxy.DisableProxy()
End Sub
Private Sub Timer1_Tick_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
Timer1.Stop()
TextBox1.Text = proxy(index)
index = index + 1
Dim clsProxy As New IEProxy
If clsProxy.SetProxy(TextBox1.Text) Then
MessageBox.Show("Proxy successfully enabled.", "Success", MessageBoxButtons.OK, MessageBoxIcon.Information)
Else
MessageBox.Show("Error enabling proxy.", "Failed", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
End If
If index >= max_proxys Then
index = 0
End If
If label.Equals("false") Then
Timer1.Stop()
End If
End Sub
End Class
Public Class IEProxy
Public Enum Options
INTERNET_PER_CONN_FLAGS = 1
INTERNET_PER_CONN_PROXY_SERVER = 2
INTERNET_PER_CONN_PROXY_BYPASS = 3
INTERNET_PER_CONN_AUTOCONFIG_URL = 4
INTERNET_PER_CONN_AUTODISCOVERY_FLAGS = 5
INTERNET_OPTION_REFRESH = 37
INTERNET_OPTION_PER_CONNECTION_OPTION = 75
INTERNET_OPTION_SETTINGS_CHANGED = 39
PROXY_TYPE_PROXY = &H2
PROXY_TYPE_DIRECT = &H1
End Enum
<StructLayout(LayoutKind.Sequential)> _
Private Class FILETIME
Public dwLowDateTime As Integer
Public dwHighDateTime As Integer
End Class
<StructLayout(LayoutKind.Explicit, Size:=12)> _
Private Structure INTERNET_PER_CONN_OPTION
<FieldOffset(0)> Dim dwOption As Integer
<FieldOffset(4)> Dim dwValue As Integer
<FieldOffset(4)> Dim pszValue As IntPtr
<FieldOffset(4)> Dim ftValue As IntPtr
Public Function GetBytes() As Byte()
Dim b(12) As Byte
BitConverter.GetBytes(dwOption).CopyTo(b, 0)
Select Case dwOption
Case Options.INTERNET_PER_CONN_FLAGS
BitConverter.GetBytes(dwValue).CopyTo(b, 4)
Case Options.INTERNET_PER_CONN_PROXY_BYPASS
BitConverter.GetBytes(pszValue.ToInt32()).CopyTo(b, 4)
Case Options.INTERNET_PER_CONN_PROXY_SERVER
BitConverter.GetBytes(pszValue.ToInt32()).CopyTo(b, 4)
End Select
Return b
End Function
End Structure
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> _
Private Class INTERNET_PER_CONN_OPTION_LIST
Public dwSize As Integer
Public pszConnection As String
Public dwOptionCount As Integer
Public dwOptionError As Integer
Public pOptions As IntPtr
End Class
<StructLayout(LayoutKind.Sequential)> _
Private Class INTERNET_PROXY_INFO
Public dwAccessType As Integer
Public lpszProxy As IntPtr
Public lpszProxyBypass As IntPtr
End Class
Private Const ERROR_INSUFFICIENT_BUFFER = 122
Private Const INTERNET_OPTION_PROXY = 38
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
<DllImport("wininet.dll")> _
Private Shared Function InternetSetOption(ByVal hInternet As IntPtr, _
ByVal dwOption As Integer, _
ByVal lpBuffer As INTERNET_PER_CONN_OPTION_LIST, _
ByVal dwBufferLength As Integer) As Boolean
End Function
<DllImport("kernel32.dll")> _
Private Shared Function GetLastError() As Integer
End Function
Public Function SetProxy(ByVal proxy_full_addr As String) As Boolean
Dim bReturn As Boolean
Dim list As New INTERNET_PER_CONN_OPTION_LIST
Dim dwBufSize As Integer = Marshal.SizeOf(list)
Dim opts(3) As INTERNET_PER_CONN_OPTION
Dim opt_size As Integer = Marshal.SizeOf(opts(0))
list.dwSize = dwBufSize
list.pszConnection = ControlChars.NullChar
list.dwOptionCount = 3
'set flags
opts(0).dwOption = Options.INTERNET_PER_CONN_FLAGS
opts(0).dwValue = Options.PROXY_TYPE_DIRECT Or Options.PROXY_TYPE_PROXY
'set proxyname
opts(1).dwOption = Options.INTERNET_PER_CONN_PROXY_SERVER
opts(1).pszValue = Marshal.StringToHGlobalAnsi(proxy_full_addr)
'set override
opts(2).dwOption = Options.INTERNET_PER_CONN_PROXY_BYPASS
opts(2).pszValue = Marshal.StringToHGlobalAnsi("local")
Dim b(3 * opt_size) As Byte
opts(0).GetBytes().CopyTo(b, 0)
opts(1).GetBytes().CopyTo(b, opt_size)
opts(2).GetBytes().CopyTo(b, 2 * opt_size)
Dim ptr As IntPtr = Marshal.AllocCoTaskMem(3 * opt_size)
Marshal.Copy(b, 0, ptr, 3 * opt_size)
list.pOptions = ptr
'Set the options on the connection
bReturn = InternetSetOption(IntPtr.Zero, Options.INTERNET_OPTION_PER_CONNECTION_OPTION, list, dwBufSize)
If Not bReturn Then
Debug.WriteLine(GetLastError)
End If
'Notify existing Internet Explorer instances that the settings have changed
bReturn = InternetSetOption(IntPtr.Zero, Options.INTERNET_OPTION_SETTINGS_CHANGED, Nothing, 0)
If Not bReturn Then
Debug.WriteLine(GetLastError)
End If
'Flush the current IE proxy setting
bReturn = InternetSetOption(IntPtr.Zero, Options.INTERNET_OPTION_REFRESH, Nothing, 0)
If Not bReturn Then
Debug.WriteLine(GetLastError)
End If
Marshal.FreeHGlobal(opts(1).pszValue)
Marshal.FreeHGlobal(opts(2).pszValue)
Marshal.FreeCoTaskMem(ptr)
Return bReturn
End Function
Public Function DisableProxy() As Boolean
Dim bReturn As Boolean
Dim list As New INTERNET_PER_CONN_OPTION_LIST
Dim dwBufSize As Integer = Marshal.SizeOf(list)
Dim opts(0) As INTERNET_PER_CONN_OPTION
Dim opt_size As Integer = Marshal.SizeOf(opts(0))
list.dwSize = dwBufSize
list.pszConnection = ControlChars.NullChar
list.dwOptionCount = 1
opts(0).dwOption = Options.INTERNET_PER_CONN_FLAGS
opts(0).dwValue = Options.PROXY_TYPE_DIRECT
Dim b(opt_size) As Byte
opts(0).GetBytes().CopyTo(b, 0)
Dim ptr As IntPtr = Marshal.AllocCoTaskMem(opt_size)
Marshal.Copy(b, 0, ptr, opt_size)
list.pOptions = ptr
'Set the options on the connection
bReturn = InternetSetOption(IntPtr.Zero, Options.INTERNET_OPTION_PER_CONNECTION_OPTION, list, dwBufSize)
If Not bReturn Then
Debug.WriteLine(GetLastError)
End If
'Notify existing Internet Explorer instances that the settings have changed
bReturn = InternetSetOption(IntPtr.Zero, Options.INTERNET_OPTION_SETTINGS_CHANGED, Nothing, 0)
If Not bReturn Then
Debug.WriteLine(GetLastError)
End If
'Flush the current IE proxy setting
bReturn = InternetSetOption(IntPtr.Zero, Options.INTERNET_OPTION_REFRESH, Nothing, 0)
If Not bReturn Then
Debug.WriteLine(GetLastError)
End If
Marshal.FreeCoTaskMem(ptr)
Return bReturn
End Function
End Class
Maybe just download your url to the FILE_NAME location in your form's load event. Be warned that if there is a file at FILE_NAME, this sub I provide you will overwrite it.
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim YourURL As String = "http://www.yoururl.com/filename.ext"
Using w As New System.Net.WebClient
w.DownloadFile(YourURL, FILE_NAME)
End Using
End Sub

Backgroundworker is very slow, how to optimize?

I have the following structure:
OLD:
frmMain (WinForm)
uscStat (UserControl with Grid)
In frmMain I'm able to make some settings and load the result of the settings via LinQ into the Grid of the uscStat.
f.e.:
frmMain
Private Sub rdbValue2_ValueChanged(sender As System.Object, e As System.EventArgs) Handles rdbValue2.ValueChanged
uscStat.Load(Value1,Value2,Value3,Value4, ...)
End Sub
uscStat
Public Sub Load(ByVal Value1, ByVal Value2, ByVal Value3, ...)
...
Dim dt As New Datatable
dt.Columns.Add(New DataColumn("Value1", GetType(Double)
...
Dim res As IEnumerable = ReturnDatable(Value2, Value3, ...)
Dim rowObj(6) As Object
...
For each item in res
rowObj(1) = FuncXY(item.Value1)
rowObj(2) = item.Value2
...
dt.Rows.Add(rowObj)
Next
dg.Datasource = dt
End Sub
Takes round about 30 sec, depending on the User-Settings.
NEW
Added: modCommon (Module)
To pass all the variables I added the following Class in the module:
Public Class clsStatValues
Public Property Value1() As Boolean
Get
Return m_Value1
End Get
Set(value As Boolean)
m_Value1 = value
End Set
End Property
Private m_Value1 As Boolean
Public Property Value2() As Integer
Get
Return m_Value2
End Get
Set(value As Integer)
m_Value2 = value
End Set
End Property
Private m_Value2 As Integer
...
End Class
And I add the following BackgroundWorker in modCommon:
Public thStat As Backgroundworker
I initialize in frmMain thStat:
thStat = New BackgroundWorker
AddHandler thStat.DoWork, AddressOf thStat_DoWork
AddHandler thStat.RunWorkerCompleted, AddressOf thStat_Completed
AddHandler thStat.ProgressChanged, AddressOf thStat_ProgressChanged
thStat.WorkerReportsProgress = True
thStat.WorkerSupportsCancellation = True
And created the following subs:
Private Sub thStat_DoWork(ByVal sender As Object, ByVal e As DoWorkEventArgs)
Dim varStat As clsStatValues = e.Argument
uscStat.Load(varStat.Value1, varStat.Value2, ...)
End Sub
And changed the settings-subs like:
Private Sub rdbValue2_ValueChanged(sender As System.Object, e As System.EventArgs) Handles rdbValue2.ValueChanged
Dim varStat As New clsStatValues
varStat.Value1 = True
varStat.Value2 ...
...
thStat.RunWorkerAsync(varStat)
End Sub
In uscStat I changed/added the following:
Public Sub Load(ByVal Value1, ...)
...
Me.Invoke(New AddDataSourceToGrid(AddressOf AddDataSourceToGridFunction), GetDatatable(Value1, Value2, ...))
...
End Sub
Delegate Sub AddDataSourceToGrid(ByRef tmpDt As DataTable)
Private Sub AddDataSourceToGridFunction(ByRef tmpDt As DataTable)
dg.DataSource = tmpDt
End Sub
Public Function GetDatatable(ByVal Value1, ByVal Value2, ByVal Value3, ...) As Datatable
...
Dim dt As New Datatable
dt.Columns.Add(New DataColumn("Value1", GetType(Double)
...
Dim res As IEnumerable = ReturnDatable(Value2, Value3, ...)
Dim resultCount = res.AsQueryable.Count
Dim ReportEvery As Double = resultCount/100
Dim staticReportEvery As Double = ReportEvery
Dim count As Integer = 0
Dim Percent As Integer = 0
Dim rowObj(6) As Object
...
For each item in res
count += 1
If count > ReportEvery then
Percent += 1
thStat.ReportProgress(Percent, count & " of " & resultCount)
ReportEvery += staticReportEvery
End If
rowObj(1) = FuncXY(item.Value1)
rowObj(2) = item.Value2
...
dt.Rows.Add(rowObj)
Next
Return dt
End Sub
This takes round about 5 mins with the same user-settings, too slow.
How can I improve it?
If I understand right, you copy one DataTable into another DataTable and apply FuncXY to a column. I do not know what FuncXY does. Would it be possible to do that with an SQL query? It would be much faster than looping through individual records.