FOR statement conflicting with IF statement in VB - vb.net

I am creating a fairly simple ping tool which shows in milliseconds how long the server took to respond. If the server does not respond, it shows as it responded in 0ms. I wanted to implement an If statement to write Server failed to respond in the ListBox rather than it replied in 0ms. The only problem with this is I have a chunk of code which need to be run outside the If but continues inside the If and involves using the line of code Next... This seems to cause the If statement to not recognise the End If and the End If to not recognise the If...
Here is my code:
For i As Integer = 0 To numberOfPings - 1
Dim ping As New Ping
Dim pingRe As PingReply = ping.Send(pingTarget)
If pingRe.RoundtripTime = 0 Then
Me.listboxPing.Items.Add("Server failed to respond...")
Else
Me.listboxPing.Items.Add("Response from " & pingTarget & " in " & pingRe.RoundtripTime.ToString() & "ms")
listboxPing.SelectedIndex = listboxPing.Items.Count - 1
listboxPing.SelectedIndex = -1
Application.DoEvents()
Threading.Thread.Sleep(500)
Next
Me.listboxPing.Items.Add("")
End If
Does anyone know of a way I could fix this/get around this issue?
Thanks,

If I were going to write code to ping an address and show the results it would look something like this.
Dim pingThrd As Threading.Thread
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
If pingThrd Is Nothing OrElse pingThrd.ThreadState = Threading.ThreadState.Stopped Then
RichTextBox1.Clear()
pingThrd = New Threading.Thread(AddressOf PingIt)
pingThrd.IsBackground = True
pingThrd.Start("192.168.33.1")
End If
End Sub
Public Sub PingIt(pingTarget As Object)
Dim numberOfPings As Integer = 5
Dim pingT As String = DirectCast(pingTarget, String)
Dim pingTimeOut As Integer = 1000
Const dlyBetweenPing As Integer = 500
Dim dspStr As String
For i As Integer = 0 To numberOfPings - 1
Dim pingit As New Ping
Dim pingRe As PingReply = pingit.Send(pingT, pingTimeOut)
'check if success
If pingRe.Status = IPStatus.Success Then
dspStr = String.Format("Response from: {0} in {1}ms.", pingRe.Address, pingRe.RoundtripTime)
Else
dspStr = String.Format("{0} failed. Status: {1}", pingRe.Address, pingRe.Status)
End If
Me.BeginInvoke(Sub()
RichTextBox1.AppendText(dspStr)
RichTextBox1.AppendText(Environment.NewLine)
End Sub)
Threading.Thread.Sleep(dlyBetweenPing)
Next
End Sub
edit: Same basic code but allow thread to start with different address and count.
Structure PingWhat
Dim addr As String
Dim howmany As Integer
End Structure
Dim pingThrd As Threading.Thread
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
If pingThrd Is Nothing OrElse pingThrd.ThreadState = Threading.ThreadState.Stopped Then
RichTextBox1.Clear()
'setup a thread to do the actual ping'ing
'this allows the UI to function
pingThrd = New Threading.Thread(AddressOf PingIt)
pingThrd.IsBackground = True
'setup address to ping and howmany times to ping it
Dim somePing As New PingWhat With {.addr = "192.168.33.1", .howmany = 3}
'start the thread
pingThrd.Start(somePing)
End If
End Sub
Public Sub PingIt(pingTarget As Object)
Dim pingT As PingWhat = DirectCast(pingTarget, PingWhat)
Dim pingTimeOut As Integer = 1000
Const dlyBetweenPing As Integer = 500
Dim dspStr As String
For i As Integer = 1 To pingT.howmany
Dim pingit As New Ping
Dim pingRe As PingReply = pingit.Send(pingT.addr, pingTimeOut)
'check if success
If pingRe.Status = IPStatus.Success Then
dspStr = String.Format("Response from: {0} in {1} ms.", pingRe.Address, pingRe.RoundtripTime)
Else
dspStr = String.Format("Ping Failed {0}. Status: {1}", pingT.addr, pingRe.Status)
End If
'update the UI
Me.BeginInvoke(Sub()
RichTextBox1.AppendText(dspStr)
RichTextBox1.AppendText(Environment.NewLine)
RichTextBox1.ScrollToCaret()
End Sub)
Threading.Thread.Sleep(dlyBetweenPing)
Next
Me.BeginInvoke(Sub()
RichTextBox1.AppendText("Done")
RichTextBox1.AppendText(Environment.NewLine)
RichTextBox1.ScrollToCaret()
End Sub)
End Sub

Is this what you're after?
For i As Integer = 0 To numberOfPings - 1
Dim ping As New Ping
Dim pingRe As PingReply = ping.Send(pingTarget)
If pingRe.RoundtripTime = 0 Then
Me.listboxPing.Items.Add("Server failed to respond...")
Else
Me.listboxPing.Items.Add("Response from " & pingTarget & " in " & pingRe.RoundtripTime.ToString() & "ms")
listboxPing.SelectedIndex = listboxPing.Items.Count - 1
listboxPing.SelectedIndex = -1
Application.DoEvents()
Threading.Thread.Sleep(500)
add = True
Exit For
End If
Next
If add Then Me.listboxPing.Items.Add("")
The If will change the scope, therefore, you need to use a variable to check whether it went into the Else part.
Of course, you need to close the first If before the Next.

#dbasnett This was the code I using before and it was absolutely perfect for what i needed EXCEPT if a ping failed it would just say (PingTarget) responded in 0ms which is not ideal. Ideally i would like it to say Server failed to respond... . Do you know a way in which this can be achieved by modifying my original code?
Imports System.Net.NetworkInformation
Imports System.Runtime.InteropServices
Public Class PingClient
Private Const EM_SETCUEBANNER As Integer = &H1501
<DllImport("user32.dll", CharSet:=CharSet.Auto)>
Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As Integer, <MarshalAs(UnmanagedType.LPWStr)> ByVal lParam As String) As Int32
End Function
Private Sub SetCueText(ByVal control As Control, ByVal text As String)
SendMessage(control.Handle, EM_SETCUEBANNER, 0, text)
End Sub
Private Sub PingClient_Load(sender As Object, e As EventArgs) Handles MyBase.Load
SetCueText(textboxIP, "IP Address/Domain")
SetCueText(textboxPing, "No. Of Pings")
End Sub
Structure PingWhat
Dim addr As String
Dim howmany As Integer
End Structure
Dim pingThrd As Threading.Thread
Public Sub buttonPing_Click(sender As Object, e As EventArgs) Handles buttonPing.Click
If pingThrd Is Nothing OrElse pingThrd.ThreadState = Threading.ThreadState.Stopped Then
Dim pingTarget As String = ""
Dim numberOfPings As Integer = 0
Dim intTimeout As Integer = 2000
If String.IsNullOrEmpty(textboxIP.Text) Then
MsgBox("You must enter an IP Address or Domain.")
Exit Sub
End If
If Not Int32.TryParse(textboxPing.Text, numberOfPings) Then
MsgBox("You must enter a number of how many times the target address will be pinged.")
Exit Sub
End If
If numberOfPings = 0 Then
MsgBox("You must enter a value over 0.")
textboxPing.Clear()
Exit Sub
End If
'setup a thread to do the actual ping'ing
'this allows the UI to function
pingThrd = New Threading.Thread(AddressOf PingIt)
pingThrd.IsBackground = True
'setup address to ping and howmany times to ping it
Dim somePing As New PingWhat With {.addr = pingTarget, .howmany = numberOfPings}
'start the thread
pingThrd.Start(somePing)
End If
Me.listboxPing.Items.Add("")
End Sub
Public Sub PingIt(pingTarget As Object)
Dim pingT As PingWhat = DirectCast(pingTarget, PingWhat)
Dim pingTimeOut As Integer = 1000
Const dlyBetweenPing As Integer = 500
Dim dspStr As String
For i As Integer = 1 To pingT.howmany
Dim pingit As New Ping
Dim pingRe As PingReply = pingit.Send(pingT.addr, pingTimeOut)
'check if success
If pingRe.Status = IPStatus.Success Then
dspStr = String.Format("Response from: {0} in {1} ms.", pingRe.Address, pingRe.RoundtripTime)
Else
dspStr = String.Format("Ping Failed {0}. Status: {1}", pingT.addr, pingRe.Status)
End If
'update the UI
Me.BeginInvoke(Sub()
listboxPing.Items.Add(dspStr)
End Sub)
Threading.Thread.Sleep(dlyBetweenPing)
Next
Me.BeginInvoke(Sub()
listboxPing.Items.Add("Done")
End Sub)
End Sub
Private Sub PingClient_Closing(sender As Object, e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
Dim Response As Integer
Response = MsgBox("Are you sure you want to exit the Ping Tool?", 36)
If Response = MsgBoxResult.Yes Then
Else
e.Cancel = True
End If
End Sub
End Class

Related

How to get ipv4 addresses of all computers on a network in VB.NET

I have a Windows Forms app in Visual basic that is currently sending messages back and forth between two computers. Currently, the user has to manually enter the ipv4 address of the receiver of the message. what I would like to do is put the ipv4 addresses of all the computers on the network into a combo box so the user has a list to pick from.
I have searched a whole bunch of different forums and am unable to find a working solution.
Public Class Form1
Dim strHostName As String
Dim strIPAddress As String
Dim running As Boolean = False
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
strHostName = System.Net.Dns.GetHostName()
strIPAddress = System.Net.Dns.GetHostByName(strHostName).AddressList(0).ToString()
Me.Text = strIPAddress
txtIP.Text = strIPAddress
running = True
'run listener on separate thread
Dim listenTrd As Thread
listenTrd = New Thread(AddressOf StartServer)
listenTrd.IsBackground = True
listenTrd.Start()
End Sub
Private Sub Form1_FormClosing(sender As Object, e As EventArgs) Handles MyBase.FormClosing
running = False
End Sub
Sub StartServer()
Dim serverSocket As New TcpListener(CInt(txtPort.Text))
Dim requestCount As Integer
Dim clientSocket As TcpClient
Dim messageReceived As Boolean = False
While running
messageReceived = False
serverSocket.Start()
msg("Server Started")
clientSocket = serverSocket.AcceptTcpClient()
msg("Accept connection from client")
requestCount = 0
While (Not (messageReceived))
Try
requestCount = requestCount + 1
Dim networkStream As NetworkStream = clientSocket.GetStream()
Dim bytesFrom(10024) As Byte
networkStream.Read(bytesFrom, 0, bytesFrom.Length)
Dim dataFromClient As String = System.Text.Encoding.ASCII.GetString(bytesFrom)
dataFromClient = dataFromClient.Substring(0, dataFromClient.Length)
'invoke into other thread
txtOut.Invoke(Sub()
txtOut.Text += dataFromClient
txtOut.Text += vbNewLine
End Sub)
messageReceived = True
Dim serverResponse As String = "Server response " + Convert.ToString(requestCount)
Dim sendBytes As [Byte]() = Encoding.ASCII.GetBytes(serverResponse)
networkStream.Write(sendBytes, 0, sendBytes.Length)
networkStream.Flush()
Catch ex As Exception
End
End Try
End While
clientSocket.Close()
serverSocket.Stop()
msg("exit")
Console.ReadLine()
End While
End Sub
Sub msg(ByVal mesg As String)
mesg.Trim()
Console.WriteLine(" >> " + mesg)
End Sub
Public Sub WriteData(ByVal data As String, ByRef IP As String)
Try
txtOut.Text += data.PadRight(1)
txtOut.Text += vbNewLine
txtMsg.Clear()
Console.WriteLine("Sending message """ & data & """ to " & IP)
Dim client As TcpClient = New TcpClient()
client.Connect(New IPEndPoint(IPAddress.Parse(IP), CInt(txtPort.Text)))
Dim stream As NetworkStream = client.GetStream()
Dim sendBytes As Byte() = Encoding.ASCII.GetBytes(data)
stream.Write(sendBytes, 0, sendBytes.Length)
Catch ex As Exception
msg(ex.ToString)
End Try
End Sub
Private Sub btnSend_Click(sender As Object, e As EventArgs) Handles btnSend.Click
If Not (txtMsg.Text = vbNullString) AndAlso Not (txtIP.Text = vbNullString) Then
WriteData(txtMsg.Text, txtIP.Text)
End If
End Sub
Private Sub txtMsg_KeyDown(sender As Object, e As KeyEventArgs) Handles txtMsg.KeyDown
If e.KeyCode = Keys.Enter Then
If Not (txtMsg.Text = vbNullString) AndAlso Not (txtIP.Text = vbNullString) Then
WriteData(txtMsg.Text, txtIP.Text)
End If
End If
End Sub
Private Sub BtnFind_Click(sender As Object, e As EventArgs) Handles btnFind.Click
'find all local addresses and put in combobox (button will be removed later)
End Sub
End Class
For PC names "as you suggested in your comments", I used this at work to get pc names i was on domain, try it:
AFAIK it works on domains...
Make sure you have a listbox on your form, or change listbox and populate in your combobox directly, play with that as you like :)
Private Delegate Sub UpdateDelegate(ByVal s As String)
Dim t As New Threading.Thread(AddressOf GetNetworkComputers)
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
t.IsBackground = True
t.Start()
End Sub
Private Sub AddListBoxItem(ByVal s As String)
ListBox1.Items.Add(s)
End Sub
Private Sub GetNetworkComputers()
Try
Dim alWorkGroups As New ArrayList
Dim de As New DirectoryEntry
de.Path = "WinNT:"
For Each d As DirectoryEntry In de.Children
If d.SchemaClassName = "Domain" Then alWorkGroups.Add(d.Name)
d.Dispose()
Next
For Each workgroup As String In alWorkGroups
de.Path = "WinNT://" & workgroup
For Each d As DirectoryEntry In de.Children
If d.SchemaClassName = "Computer" Then
Dim del As UpdateDelegate = AddressOf AddListBoxItem
Me.Invoke(del, d.Name)
End If
d.Dispose()
Next
Next
Catch ex As Exception
'MsgBox(Ex.Message)
End Try
End Sub
POC:

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.

multi-threaded code to check proxies

I'm suffering with this VB.Net 2017 code which is supposed to check if Proxies working or not. Sometimes it reach to an end successfully, and sometimes the program never reach and end or take lots of time to do so, although I have specified the timeout for every webrequest to be 11000... Also, the list of working proxies always has duplicates! I don't know how that happens, althoug the original (raw) list is unique!
Could you please help? This is supposed to wait till the 99 threads finished then another 99 (or the remaining threads) kick-started.
P.S. MYWEBSITE.com works for me only and it displays the IP address of the visitor, i.e. to double check if the proxy has worked fine
Imports System.Net
Imports System.IO
Imports System
Imports System.Text.RegularExpressions
Imports System.Threading
Public Class frmMain
Dim FinalWorkingProxies As New List(Of String)()
Private Sub btnBrowse_Click(sender As Object, e As EventArgs) Handles btnBrowse.Click
Control.CheckForIllegalCrossThreadCalls = False
PB.Maximum = txtRawIP.Lines.Count
PB.Value = 0
StartCheckingIP(0)
End Sub
Function StartCheckingIP(ByVal num As Integer)
For I As Integer = num To txtRawIP.Lines.Count - 1
Dim StrIPOnly As String = txtRawIP.Lines(I)
StrIPOnly = Trim(StrIPOnly.TrimStart("0"c)) 'remove any leading zeros
Try
Dim clsThreads As New System.Threading.Thread(AddressOf CheckIP)
clsThreads.Start(StrIPOnly)
Catch ex As Exception
MsgBox(I)
End Try
If (I > 0 And (I Mod 99 = 0)) Then Exit For
Next
Return True
End Function
Private Function CheckIP(ByVal Prox As String) As Boolean
'txtHTML.Text += vbCrLf & Prox
'txtHTML.Refresh()
Dim txtWebResult As String = ""
Dim OriginalFullProx As String = Trim(Prox)
Dim proxyObject As WebProxy = New WebProxy("http://" & OriginalFullProx & "/")
proxyObject.BypassProxyOnLocal = True
Prox = Prox.Substring(0, Prox.IndexOf(":"))
Dim sURL As String
sURL = "http://MYWEBSITE.com/testip.php"
Dim wrGETURL As WebRequest
wrGETURL = WebRequest.Create(sURL)
wrGETURL.Proxy = proxyObject
wrGETURL.Timeout = 6000
txtWebResult = "Dosn't work"
Try
Dim objStream As Stream
objStream = wrGETURL.GetResponse.GetResponseStream
Dim objReader As New StreamReader(objStream)
Dim sLine As String = ""
sLine = objReader.ReadLine
If Not sLine Is Nothing Then
txtWebResult = sLine
End If
txtWebResult = Regex.Replace(txtWebResult, “^\s+$[\r\n]*”, “”, RegexOptions.Multiline)
If (Trim(Prox) = Trim(txtWebResult)) Then
FinalWorkingProxies.Add(OriginalFullProx)
End If
Catch ex As Exception
txtWebResult = "Dosn't work"
End Try
If (PB.Value < PB.Maximum) Then PB.Value += 1
PB.Refresh()
If (PB.Value = PB.Maximum) Then
txtFilteredIP.Clear()
Randomize()
Dim RRR As Integer = CInt(Math.Ceiling(Rnd() * 1000)) + 1
Thread.Sleep(RRR)
If (txtFilteredIP.Text <> "") Then Return False
Dim str As String
For Each str In FinalWorkingProxies
txtFilteredIP.Text += str & vbCrLf
Next
ElseIf ((PB.Value - 1) > 0 And ((PB.Value - 1) Mod 99 = 0)) Then
StartCheckingIP(PB.Value)
End If
Return True
End Function
Private Sub txtRawIP_TextChanged(sender As Object, e As EventArgs) Handles txtRawIP.TextChanged
lblRawIPTotal.Text = "Total: " & txtRawIP.Lines.Count
End Sub
Private Sub txtFilteredIP_TextChanged(sender As Object, e As EventArgs) Handles txtFilteredIP.TextChanged
lblFilteredIPTotal.Text = "Total: " & txtFilteredIP.Lines.Count
End Sub
End Class
Here is the modified code, but it stills takes long of time to finalize long list of proxies, although I sat max concurrent connection to 2000 and timeout to 8sec. Please help. Thanks.
Public Class frmMain
Dim FinalWorkingProxies As New List(Of String)()
Private Sub btnBrowse_Click(sender As Object, e As EventArgs) Handles btnBrowse.Click
'Control.CheckForIllegalCrossThreadCalls = False
ServicePointManager.Expect100Continue = False
ServicePointManager.DefaultConnectionLimit = 2000
'ServicePointManager.Expect100Continue = True
FinalWorkingProxies.Clear()
PB.Maximum = txtRawIP.Lines.Count
PB.Value = 0
StartCheckingIP(0)
End Sub
Function StartCheckingIP(ByVal num As Integer)
For I As Integer = num To txtRawIP.Lines.Count - 1
Dim StrIPOnly As String = txtRawIP.Lines(I)
StrIPOnly = Trim(StrIPOnly.TrimStart("0"c)) 'remove any leading zeros
Try
Dim clsThreads As New System.Threading.Thread(AddressOf CheckIP)
clsThreads.Start(StrIPOnly)
Catch ex As Exception
MsgBox(I)
End Try
If (I > 0 And (I Mod 333 = 0)) Then Exit For
Next
Return True
End Function
Private Function CheckIP(ByVal Prox As String) As Boolean
'txtHTML.Text += vbCrLf & Prox
'txtHTML.Refresh()
Dim txtWebResult As String = ""
Dim OriginalFullProx As String = Trim(Prox)
Dim proxyObject As WebProxy = New WebProxy("http://" & OriginalFullProx & "/")
proxyObject.BypassProxyOnLocal = True
Prox = Prox.Substring(0, Prox.IndexOf(":"))
Dim sURL As String
sURL = "http://MYWEBSITE.com/testip.php"
Dim wrGETURL As WebRequest
wrGETURL = WebRequest.Create(sURL)
wrGETURL.Proxy = proxyObject
wrGETURL.Timeout = 8000
txtWebResult = "Dosn't work"
Try
Dim objStream As Stream
objStream = wrGETURL.GetResponse.GetResponseStream
Dim objReader As New StreamReader(objStream)
Dim sLine As String = ""
sLine = objReader.ReadLine
If Not sLine Is Nothing Then
txtWebResult = sLine
End If
txtWebResult = Regex.Replace(txtWebResult, “^\s+$[\r\n]*”, “”, RegexOptions.Multiline)
If (Trim(Prox) = Trim(txtWebResult)) Then
'Now know exact country
sURL = "http://ip-api.com/xml/" & Prox
wrGETURL = WebRequest.Create(sURL)
wrGETURL.Proxy = proxyObject
wrGETURL.Timeout = 8000
objStream = wrGETURL.GetResponse.GetResponseStream
Dim objReader2 As New StreamReader(objStream)
Dim FullCODEOFAPI As String = objReader2.ReadToEnd()
Dim XMLR As XmlReader
XMLR = XmlReader.Create(New StringReader(FullCODEOFAPI))
XMLR.ReadToFollowing("country")
XMLR.Read()
OriginalFullProx += "-" + XMLR.Value
FinalWorkingProxies.Add(OriginalFullProx)
End If
Catch ex As Exception
txtWebResult = "Dosn't work"
End Try
If (PB.Value < PB.Maximum) Then UpdatePB(1)
If (PB.Value = PB.Maximum) Then
UpdateFilteredList(1)
ElseIf ((PB.Value - 1) > 0 And ((PB.Value - 1) Mod 333 = 0)) Then
StartCheckingIP(PB.Value)
End If
Return True
End Function
Private Delegate Sub UpdatePBDelegate(ByVal PBVal As Integer)
Private Sub UpdatePB(ByVal PBVal As Integer)
If PB.InvokeRequired Then
PB.Invoke(New UpdatePBDelegate(AddressOf UpdatePB), New Object() {PBVal})
Else
PB.Value += PBVal
PB.Refresh()
End If
End Sub
Private Delegate Sub UpdateFilteredListDelegate()
Private Sub UpdateFilteredList(ByVal TMP As Integer)
If txtFilteredIP.InvokeRequired Then
txtFilteredIP.Invoke(New UpdatePBDelegate(AddressOf UpdateFilteredList), New Object() {TMP})
Else
txtFilteredIP.Clear()
Dim str As String
For Each str In FinalWorkingProxies
txtFilteredIP.Text += str & vbCrLf
Next
End If
End Sub
Private Sub txtRawIP_TextChanged(sender As Object, e As EventArgs) Handles txtRawIP.TextChanged
lblRawIPTotal.Text = "Total: " & txtRawIP.Lines.Count
End Sub
Private Sub txtFilteredIP_TextChanged(sender As Object, e As EventArgs) Handles txtFilteredIP.TextChanged
lblFilteredIPTotal.Text = "Total: " & txtFilteredIP.Lines.Count
End Sub
Private Sub btnLoadList_Click(sender As Object, e As EventArgs) Handles btnLoadList.Click
OFD.ShowDialog()
If (OFD.FileName <> "") Then
txtRawIP.Text = File.ReadAllText(OFD.FileName)
End If
End Sub
End Class

Making a string from a listbox

I have 2 projects, one which has a highscorelist stored on it, and one which tries to add highscores to that list and retrieve all items on the list. Trying to put items on the list works good, but retrieving the list doesn't work well. Here's the code:
Option Strict On
Option Explicit On
Imports System.Net.Sockets
Imports System.Threading
Public Class Main
Dim server As New TcpListener(45888)
Dim client As New TcpClient
Dim stream As NetworkStream
Dim connected As Boolean
Private Sub cmd_start_Click(sender As Object, e As EventArgs) Handles cmd_start.Click
server.Start()
cmd_start.Enabled = False
cmd_stop.Enabled = True
lbl_status.Text = "Running"
lbl_status.ForeColor = Color.Green
tmr.Start()
End Sub
Private Sub cmd_stop_Click(sender As Object, e As EventArgs) Handles cmd_stop.Click
server.Stop()
cmd_start.Enabled = True
cmd_stop.Enabled = False
lbl_status.Text = "Not running"
lbl_status.ForeColor = Color.Red
tmr.Stop()
End Sub
Private Sub Main_Load(sender As Object, e As EventArgs) Handles MyBase.Load
connected = False
CheckForIllegalCrossThreadCalls = False
End Sub
Dim x As Integer = 0
Private Sub tmr_Tick(sender As Object, e As EventArgs) Handles tmr.Tick
If server.Pending Then
client = server.AcceptTcpClient()
stream = client.GetStream()
tmr.Stop()
read()
Else
tmr.Start()
End If
lbl_mseconds.Text = "Relative time: " & x
x += 1
End Sub
Private Sub SendMessage(message As String)
Dim sendtext() As Byte = System.Text.Encoding.ASCII.GetBytes(message)
stream.Write(sendtext, 0, sendtext.Length)
stream.Flush()
End Sub
Private Sub read()
Dim rec(client.ReceiveBufferSize) As Byte
stream.Read(rec, 0, client.ReceiveBufferSize)
Dim rectext As String = System.Text.Encoding.ASCII.GetString(rec)
If rectext.Contains("#1#") Then
rectext = rectext.Substring(3)
If rectext.Split(CChar("-"))(0).Length = 2 Then rectext = "0" & rectext
If rectext.Split(CChar("-"))(0).Length = 1 Then rectext = "00" & rectext
listbox_highscores.Items.Add(rectext)
ElseIf rectext.Contains("#2#") Then
Dim tosend As String = listbox_highscores.Items(0).ToString
For i = 1 To listbox_highscores.Items.Count - 1
tosend &= "," & listbox_highscores.Items(i).ToString
Next
MsgBox(tosend)
SendMessage(tosend)
End If
tmr.Start()
End Sub
End Class
On the other project I have this:
Dim server As New TcpListener(45888)
Dim client As New TcpClient
Dim stream As NetworkStream
Friend Sub sendHighscore(name As String, score As Integer)
Try
client.Connect("192.168.1.127", 45888)
Catch ex As Exception
Exit Sub
End Try
stream = client.GetStream()
Dim sendtext() As Byte = Encoding.ASCII.GetBytes("#1#" & score & "-" & name)
stream.Write(sendtext, 0, sendtext.Length)
client = New TcpClient
End Sub
Friend Sub getHighscoreList()
ListBox_highscores.Items.Clear()
Try
client.Connect("192.168.1.127", 45888)
Catch ex As Exception
ListBox_highscores.Items.Add("Couldn't connect")
Exit Sub
End Try
stream = client.GetStream()
Dim sendtext() As Byte = Encoding.ASCII.GetBytes("#2#")
stream.Write(sendtext, 0, sendtext.Length)
client = New TcpClient
read()
End Sub
Private Sub read()
Dim rec(client.ReceiveBufferSize) As Byte
stream.Read(rec, 0, client.ReceiveBufferSize)
Dim rectext As String = Encoding.ASCII.GetString(rec)
Label2.Text = rectext
For Each item In rectext.Split(",")
ListBox_highscores.Items.Add(item)
Next
End Sub
Then when I use the sub sendHighscore() with a name and score, everything perfectly works and it shows in the other project on the list, but when I use the sub getHighscoreList() the list on the second project only contains the first item from the first list. Does someone has ideas?
Edit: Original answer removed entirely because it wasn't actually the problem (although it did offer improvements). My answer was nearly identical to this one anyway.
After analyzing this project much more closely, the problem with the For..Next loop not returning the expected results is because the strings are being sent back and forth as byte arrays in buffers much larger than necessary (client.ReceiveBufferSize). The actual "strings" received contain large amounts of non-printable characters (garbage) added to the end to fill the buffer. The quick and dirty solution is to remove all non-printable characters:
rectext = System.Text.RegularExpressions.Regex.Replace(rectext, _
"[^\u0020-\u007F]", String.Empty)
The whole Sub would read like this:
Private Sub read()
Dim rec(client.ReceiveBufferSize) As Byte
stream.Read(rec, 0, client.ReceiveBufferSize)
Dim rectext As String = System.Text.Encoding.ASCII.GetString(rec)
If rectext.Contains("#1#") Then
rectext = rectext.Substring(3)
If rectext.Split(CChar("-"))(0).Length = 2 Then rectext = "0" & rectext
If rectext.Split(CChar("-"))(0).Length = 1 Then rectext = "00" & rectext
rectext = System.Text.RegularExpressions.Regex.Replace(rectext, "[^\u0020-\u007F]", String.Empty)
listbox_highscores.Items.Add(rectext)
ElseIf rectext.Contains("#2#") Then
Dim tosend As String = listbox_highscores.Items(0).ToString
For i As Integer = 1 To (listbox_highscores.Items.Count - 1)
tosend &= "," & listbox_highscores.Items(i).ToString
Next
SendMessage(tosend)
End If
tmr.Start()
End Sub
Try this, your comma's are off as well...
Dim tosend As String = String.Empty
Dim intCount As Integer = 0
For i As Integer = 0 To listbox.Items.Count - 1
If intCount >= 1 Then
tosend &= "," & listbox.Items(i).ToString
Else
tosend &= listbox.Items(i).ToString
intCount += 1
End If
Next
MessageBox.Show(tosend)
Screenshot THAT IT WORKS!

Running Different Processes In Multiple Threads Without Overlapping In VB.NET 2

I have a sub-procedure which I want to run a different process, depending on what is currently running. I thought the easiest way to do this was by using an ArrayList of each of the campaign details & adding an 'Inuse' field to check to see if the Inuse field is set to 0 or 1. The problem that I have is that when running the process it is all happening at once & the integer hasn't been changed before the next thread kicks in so my threads are running the same campaigns.
I tried to avoid the problem by adding a Thread.Sleep(100) delay inbetween starting threads but this led to exactly the same problem.
Here's an example of what I am trying to do:
Imports System.Threading
Public Class Form1
Private Campaigns As New ArrayList
Private ProcessRunning As Boolean = False
Friend StopProcess As Boolean = False
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
For i = 0 To Campaigns.Count - 1
Dim objNewThread As New Thread(AddressOf RunProcess)
objNewThread.IsBackground = True
objNewThread.Start()
Next
End Sub
Private Sub UpdateCells(ByVal CampID As Integer, ByVal Column As String, ByVal newText As String)
Dim CellItemNum As Integer
If Column = "Status" Then CellItemNum = 4
DataGridView2.Rows(CampID).Cells.Item(CellItemNum).Value = newText
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
For i As Integer = 0 To 10
Campaigns.Add({Campaigns.Count(), "Campaign " & i, "Keywords " & i, "Link " & i, 5, True, 0, 0})
Next
DataGridView2.Rows.Clear()
For Each Campaign In Campaigns
DataGridView2.Rows.Add(New String() {Campaign(1), Campaign(2), Campaign(3), Campaign(6), ""})
Next
End Sub
Private Sub RunProcess()
' Set Variables
Dim CampID As Integer
Dim CampName As String
Dim Keywords As String
Dim Link As String
Dim CheckEvery As Integer
Dim OkToUse As Boolean
Dim Sent As Integer
' Find A Free Campaign
For i As Integer = 0 To Campaigns.Count - 1
' Check If Inuse
If Campaigns(i)(7) = 1 Then Continue For Else Campaigns(i)(7) = 1 ' This Line Sets Campaign To Inuse
' Most of the time only campaign(0) and campaign(1) are selected & multiple threads are running them instead of choosing unique campaigns
' Set Campaign Details
CampID = Campaigns(i)(0)
CampName = Campaigns(i)(1)
Keywords = Campaigns(i)(2)
Link = Campaigns(i)(3)
CheckEvery = Campaigns(i)(4)
OkToUse = Campaigns(i)(5)
Sent = Campaigns(i)(6)
' Start Process
UpdateCells(CampID, "Status", "Looking Up New Links (" & CampID & ")")
Exit For
Next
While StopProcess = False
Thread.Sleep(1000)
UpdateCells(CampID, "Status", "Running Process (" & CampID & ")")
Thread.Sleep(1000)
For i = 0 To CheckEvery
UpdateCells(CampID, "Status", "Re-Checking In " & (CheckEvery - i) & " Seconds")
Thread.Sleep(1000)
Next
End While
' Closing Processes
Campaigns(CampID)(7) = 0
End Sub
End Class
You can use SyncLock to force your threads to wait.
class level so all threads access same lock
private myLock as new Object
Then use syncLock when you start your process and end it when you are done.
SyncLock myLock
'process code here
End SyncLock
More MSDN info on the subject
Try looking into QueueUserWorkItem():
Private Sub Button1_Click(ByVal sender As System.Object,
ByVal e As System.EventArgs) Handles Button1.Click
For i = 0 To Campaigns.Count - 1
ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf RunProcess), Campaigns[i])
Next
End Sub
Then change the RunProcess() method to include the Campaign object sent in by the work item:
Private Sub RunProcess(ByVal o As System.Object)
' Process the Campaign
Dim campaign As Campaign = Ctype(o, Campaign)
End Sub
There will be no need for inuse, plus threads will be managed by the managed ThreadPool!