Option Strict On
Imports System.ComponentModel
Imports System.Threading
Public Class Form1
Dim devicesOnlineCount As Integer = 0
Dim devicesOfflineCount As Integer = 0
'delegates used to access the UI.
Public Delegate Sub pingDelegate(ByVal id As String)
Public Delegate Sub pingClassDelegate(ByVal index As Integer, ByVal status As Boolean)
'tracks the number of threads currently running.
Shared threadcount As Integer = 0
'Create a flickerfree listview class.
Public Class FlickerFreeListView
Inherits ListView
Public Sub New()
MyBase.New()
Me.DoubleBuffered = True
End Sub
End Class
Dim lv As New FlickerFreeListView
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'setup the listivew.
With lv
.Dock = System.Windows.Forms.DockStyle.Fill
.UseCompatibleStateImageBehavior = False
.View = View.List
.Columns.Add("IP Address", 100)
End With
Me.mainPanel.Controls.Add(lv)
threadcount = 0
Controls_Lock()
Me.lv.Items.Clear()
lv.Refresh()
filllv()
Try
Ping_Threadpool()
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
'Populates the listview with IP range
Private Sub filllv()
Dim i As Integer
Dim xitem As ListViewItem
'load the listview
For i = 1 To 255
xitem = lv.Items.Add("192.168.1." & i)
Next
lv.Refresh()
End Sub
Private Sub Ping_Threadpool()
Dim i As Integer
For i = 1 To lv.Items.Count
'create class
Dim cping As New classPing
'setup class for each ping
cping.index = i
cping.host = lv.Items(i - 1).Text
cping.pingDelegate = AddressOf pingdone
'track thread count
Interlocked.Increment(threadcount)
Try
'Assign each ping to a threadpool.
ThreadPool.QueueUserWorkItem(AddressOf cping.ping)
Catch ex As Exception
MsgBox(ex.Message)
End Try
Next
End Sub
Private Class classPing
Public host As String
Public index As Integer
Public pingDelegate As pingClassDelegate
Public Sub ping(ByVal callback As Object)
Dim pingreply As Boolean
'ping host
Try
pingreply = My.Computer.Network.Ping(host, 200)
'Call delegate sub and send back results
pingDelegate(index, pingreply)
Catch ex As Exception
'do nothing
End Try
End Sub
End Class
'delegate sub called from the thread
Private Sub pingdone(ByVal index As Integer, ByVal result As Boolean)
If lv.InvokeRequired Then
lv.Invoke(New pingClassDelegate(AddressOf PingResult), New Object() {index, result})
Else
PingResult(index, result)
End If
End Sub
'PingResult runs on the UI thread, but is called via a delegate so it is allowed to update the control.
Public Sub PingResult(ByVal index As Integer, ByVal result As Boolean)
Dim itemcolor As Color
'Displays Success in Green and everything else in red
If result Then
itemcolor = Color.Green
Else
itemcolor = Color.Red
End If
lv.Items(index - 1).ForeColor = itemcolor
devicesOfflineLabel.Text = CStr(devicesOfflineCount + 1) 'This only works once
'If threads are all done, begin new scan
If Interlocked.Decrement(threadcount) = 0 Then
threadcount = 0
Controls_Lock()
Me.lv.Items.Clear()
lv.Refresh()
filllv()
Try
Ping_Threadpool()
Catch ex As Exception
MsgBox(ex.Message)
End Try
'Controls_UnLock()
End If
End Sub
Private Sub Controls_Lock()
Me.cmdPing.Enabled = False
Me.Refresh()
End Sub
Private Sub Controls_UnLock()
Me.cmdPing.Enabled = True
Me.Refresh()
End Sub
End Class