[x]
Posted via EE Mobile

Search, ask, and monitor your questions on the go with EE Mobile. Visit Experts Exchange from your mobile device and never be out of touch again.
Question
[x]
Attachment Details
[x]
The Solution Rating System

With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.

  • The Grade of the Solution
  • The Zone Rank of the Expert Providing the Solution
  • The Number of Author and Expert Comments
  • The Number of Experts Contributing
  • The Feedback of the Community

Your Input Matters
Because of the way the system is set up, the most important variable in this equation is you. As a member of Experts Exchange, you are able to cast your vote on the quality of the solutions in regard to how complete, accurate, helpful and easy to understand each solution is. When you provide your feedback, each rating is adjusted accordingly. So, if you see a solution that has a poor rating that you think is a good solution, let us know by rating it. As you do, the rating will be adjusted and will become more accurate for other members of our site.

If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support.

Thank you!
8.9

How do I create a multhreaded app and pass multiple variables in and postback results?

Asked by kevin_buchanan in Visual Studio, Microsoft Visual Basic.Net

Tags: vb.net, multi-threading

I have to write an application that will perform a network scan (port probe and icmp sweep).  The app works fine without multi-threading, but I am trying to add multi-threading.

The "problem area" is in the Button_Start_Click sub-routine.  I need help with several things:
-what kind of logic do I need for allowing multi-threading to accept params and update the main UI?
-how can I limit the number of threads?
-the threads must accept multi parameters (or I can parse a single param).
-the thread must update the main UI form (progress bar and results).

Thanks!! 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
569:
570:
571:
572:
573:
574:
575:
576:
577:
578:
579:
580:
581:
582:
583:
584:
585:
586:
587:
588:
589:
590:
591:
592:
593:
594:
595:
596:
597:
598:
599:
600:
601:
602:
603:
604:
605:
606:
607:
608:
609:
610:
611:
612:
613:
614:
615:
616:
617:
618:
619:
620:
621:
622:
623:
624:
625:
626:
627:
628:
629:
630:
631:
632:
633:
634:
635:
636:
637:
638:
639:
640:
641:
642:
643:
644:
645:
646:
647:
648:
649:
650:
651:
652:
653:
654:
655:
656:
657:
658:
659:
660:
661:
662:
663:
664:
665:
666:
667:
668:
669:
670:
671:
672:
673:
674:
675:
676:
677:
678:
679:
680:
681:
682:
683:
684:
685:
686:
687:
688:
689:
690:
691:
692:
693:
694:
695:
696:
697:
698:
699:
700:
701:
702:
703:
704:
705:
706:
707:
708:
709:
710:
711:
712:
713:
714:
715:
716:
717:
718:
719:
720:
721:
722:
723:
724:
725:
726:
727:
728:
729:
730:
731:
732:
733:
734:
735:
736:
737:
738:
739:
740:
741:
742:
743:
744:
745:
746:
747:
748:
749:
750:
751:
752:
753:
754:
755:
756:
757:
758:
759:
760:
761:
762:
763:
764:
765:
766:
767:
768:
769:
770:
771:
772:
773:
774:
775:
776:
777:
778:
779:
780:
781:
782:
783:
784:
785:
786:
787:
788:
789:
790:
791:
792:
793:
794:
795:
796:
797:
798:
799:
800:
801:
802:
803:
804:
805:
806:
807:
808:
809:
810:
811:

Option Explicit On
 
#Region "Imports Declarations"
Imports System
Imports System.Net
Imports System.Net.Sockets
Imports System.IO
Imports System.Diagnostics.Process
Imports System.Threading
#End Region
 
Public Class Form2
 
#Region "Variable Declarations"
   'This region stores all global Form2 variables
   Private ScanPorts() As String
   'Multi-dim array  (Hosts,Ports)
   '0 = host, x = Ports
   'SocketArray stores the IP Address at (x,0) and the ports are stored at (x,y)
   Public SocketArray(0, 0) As String
   'ResultArray stores the ICMP result at (x,0) and the TCP Port results are stored at (x,y)
   Public ResultArray(0, 0) As String
   Private ScanIPNetwork As String
   Private ScanIPStart As String
   Private ScanIPEnd As String
   Private ScanScope_ICMP As Integer
   Private ScanScope_TCP As Integer
   Private ScanScope_ICMP_TCP As Integer
   Private ScanDelay As Integer
   Private NumberofPorts As Integer
   Private NumberofHosts As Integer
   Private NumberofThreads As Integer
   Private ScanTimeLengthSecs As Integer
   Private ScanTimeStart As Date
   Private ScanTimeStop As Date
   Private HTMLFileOutput As String = Path.GetTempPath() & "ScanResults.html"
   'Variables for Supporting TCP Connection and Timeout
   'Dim connectionTCP As New TcpClient
   'WithEvents TCPtimeouttimer As System.Timers.Timer
   'Private TCPtimeout As Boolean = False
   'Private networkStream As NetworkStream
   Private ProgressBarMaxValue
 
   'This is an arraby to hold the Thread ojbects.
   Dim ThreadObj() As Thread
   'This is an object to hold the instantiated worker thread
   Dim WorkerThread() As WorkerThreadClass
   'This is to allow call backs - to update the UI when the worker thread has completed processing
   Delegate Sub CallBackFunction(ByVal [text] As String)
 
#End Region
 
#Region "Initialization Routines"
   'This region contains code that initializes or updates variables and arrays
   Private Sub LoadVariable_Values()
      'Put the Scan ports into the ScanPorts array
      Call GetScanPorts()
      'Assemble the IP address range
      Call GetIPAddressRange()
      'Init Socket and Result Arrays
      Call InitArrays()
      'Init Scan Scope
      Call GetScanScope()
      'Init Communication Variables
      Call GetCommunicationSettings()
   End Sub
   Private Sub GetLocalIPAddress()
      Try
         'Get the local IP Address of the client
         Dim h As System.Net.IPHostEntry = System.Net.Dns.GetHostEntry(System.Net.Dns.GetHostName)
         Dim ipfull As String = h.AddressList.GetValue(0).ToString
         'Parse the IP address into it's octects
         Dim IPOctect() As String = ipfull.Split(".".ToArray)
         'Display the IP Address in the UI Form
         Me.TextBox_StartIPFirstOctect.Text = IPOctect(0).ToString
         Me.TextBox_StartIPSecondOctect.Text = IPOctect(1).ToString
         Me.TextBox_StartIPThirdOctect.Text = IPOctect(2).ToString
         Me.TextBox_StartIPFourthOctect.Text = IPOctect(3).ToString
         Me.Label_EndIPFirstOctect.Text = IPOctect(0).ToString
         Me.Label_EndIPSecondOctect.Text = IPOctect(1).ToString
         Me.Label_EndIPThirdOctect.Text = IPOctect(2).ToString
         Me.TextBox_EndIPFourthOctect.Text = IPOctect(3).ToString
      Catch ex As Exception
         MsgBox("Error: " & ex.Message & vbCrLf & vbCrLf & "Enter a valid IP Address.  Each octect must be in the range of 1-255!", MsgBoxStyle.Critical)
      End Try
   End Sub
   Private Sub GetScanPorts()
      'Remove spaces in the Port text box and split into an array.
      Dim strTemp As String
      strTemp = Replace(Me.TextBox_ScanPorts.Text, " ", "")
      ScanPorts = strTemp.Split(",")
      Me.TextBox_ScanPorts.Text = strTemp.ToString
   End Sub
   Private Sub GetIPAddressRange()
      ScanIPNetwork = TextBox_StartIPFirstOctect.Text & "." & TextBox_StartIPSecondOctect.Text & "." & TextBox_StartIPThirdOctect.Text & "."
      ScanIPStart = TextBox_StartIPFourthOctect.Text
      ScanIPEnd = TextBox_EndIPFourthOctect.Text
   End Sub
   Private Sub InitArrays()
      NumberofPorts = ScanPorts.Length
      NumberofHosts = CInt(TextBox_EndIPFourthOctect.Text) - CInt(TextBox_StartIPFourthOctect.Text)
      ReDim SocketArray(NumberofHosts, NumberofPorts)
      ReDim ResultArray(NumberofHosts, NumberofPorts)
      Dim i As Integer
      Dim y As Integer
      'For i = CInt(Me.TextBoxStartOctect4.Text.ToString) To CInt(Me.TextBoxEndOctect4.Text.ToString)
      For i = 0 To NumberofHosts
         SocketArray(i, 0) = ScanIPNetwork & Me.TextBox_StartIPFourthOctect.Text.ToString + i
         ResultArray(i, 0) = ""
         For y = 1 To NumberofPorts
            SocketArray(i, y) = ScanPorts(y - 1).ToString
            ResultArray(i, y) = ""
         Next
         y = 0
      Next
   End Sub
   Private Sub GetScanScope()
      'This will set the ScanScope variables
      If RadioButton_ICMP.Checked Then
         Me.ScanScope_ICMP = True
         Me.ScanScope_ICMP_TCP = False
         Me.ScanScope_TCP = False
      ElseIf RadioButton_ICMP_TCP.Checked Then
         Me.ScanScope_ICMP = False
         Me.ScanScope_ICMP_TCP = True
         Me.ScanScope_TCP = False
      ElseIf RadioButton_TCP.Checked Then
         Me.ScanScope_ICMP = False
         Me.ScanScope_ICMP_TCP = False
         Me.ScanScope_TCP = True
      End If
   End Sub
   Private Sub GetCommunicationSettings()
      'Set the default Communication Values
      Try
         Me.ScanDelay = CInt(Me.ComboBox_ScanProbeDelay.SelectedItem) * 1000
         If Me.ScanDelay = 0 Then
            Me.ScanDelay = 10
         End If
         Me.NumberofThreads = Me.ComboBox_Threads.SelectedItem
         MsgBox(NumberofThreads)
      Catch ex As Exception
      End Try
   End Sub
   Private Sub EnableControls(ByVal enabled_state As Boolean)
      Dim ctl As Control
 
      ' Examine every control.
      For Each ctl In Me.Controls
         ctl.Enabled = enabled_state
         ' Don't disable the form's CheckBox or the user
         ' won't be able to reenable it.
         'If Not (ctl Is chkControlsEnabled) Then
         '   On Error Resume Next
         'ctl.Enabled = enabled_state
         '   On Error GoTo 0
         'End If
      Next ctl
   End Sub
   Private Sub InitializeProgressBar()
      Me.ProgressBar1.Minimum = 0
      If RadioButton_ICMP.Checked Then
         Me.ProgressBar1.Maximum = (Me.NumberofHosts + 1)
      ElseIf RadioButton_ICMP_TCP.Checked Then
         Me.ProgressBar1.Maximum = (Me.NumberofHosts + 1) + ((Me.NumberofHosts + 1) * (Me.NumberofPorts))
      ElseIf RadioButton_TCP.Checked Then
         Me.ProgressBar1.Maximum = (Me.NumberofHosts + 1) * (Me.NumberofPorts)
      End If
      Me.ProgressBar1.Value = 0
   End Sub
#End Region
 
#Region "GLOBAL UI USER VARIABLES ROUTINES"
   'This region will raise the input validation events and call the appropriate validation routines
   Private Sub TextBox_StartIPFirstOctect_TextChanged1(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox_StartIPFirstOctect.TextChanged
      Me.Label_EndIPFirstOctect.Text = Me.TextBox_StartIPFirstOctect.Text.ToString
      Call OctectValidation(TextBox_StartIPFirstOctect)
   End Sub
   Private Sub TextBox_StartIPSecondOctect_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox_StartIPSecondOctect.TextChanged
      Me.Label_EndIPSecondOctect.Text = Me.TextBox_StartIPSecondOctect.Text.ToString
      Call OctectValidation(TextBox_StartIPSecondOctect)
   End Sub
   Private Sub TextBox_StartIPThirdOctect_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox_StartIPThirdOctect.TextChanged
      Me.Label_EndIPThirdOctect.Text = Me.TextBox_StartIPThirdOctect.Text.ToString
      Call OctectValidation(TextBox_StartIPThirdOctect)
   End Sub
   Private Sub TextBox_StartIPFourthOctect_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox_StartIPFourthOctect.TextChanged
      Me.TextBox_EndIPFourthOctect.Text = Me.TextBox_StartIPFourthOctect.Text.ToString
      Call OctectValidation(TextBox_StartIPFourthOctect)
   End Sub
   Private Sub TextBox_EndIPFourthOctect_LostFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox_EndIPFourthOctect.LostFocus
      Call OctectValidation(TextBox_EndIPFourthOctect)
   End Sub
#End Region
 
#Region "VARIABLE VALIDATION CONTROL ROUTINES"
   'This region will execute the validation routines which validates the UI variables
   Private Sub OctectValidation(ByVal vObj As Object)
      'This subroutine will check the values entered in the IP Address boxes to ensure valid entries.
      Try
         Dim vValue As String = vObj.Text.ToString
         If IsNumeric(vObj.Text.ToString) Then
            If InStr(vObj.text, ".") Then
               Select Case vObj.name
                  Case ("TextBox_StartIPFirstOctect")
                     vObj.text = CStr(Replace(vObj.text, ".", ""))
                     Me.TextBox_StartIPSecondOctect.Focus()
                     Me.TextBox_StartIPSecondOctect.SelectAll()
                  Case ("TextBox_StartIPSecondOctect")
                     vObj.text = CStr(Replace(vObj.text, ".", ""))
                     Me.TextBox_StartIPThirdOctect.Focus()
                     Me.TextBox_StartIPThirdOctect.SelectAll()
                  Case ("TextBox_StartIPThirdOctect")
                     vObj.text = CStr(Replace(vObj.text, ".", ""))
                     Me.TextBox_StartIPFourthOctect.Focus()
                     Me.TextBox_StartIPFourthOctect.SelectAll()
                  Case ("TextBox_StartIPFourthOctect")
                     vObj.text = CStr(Replace(vObj.text, ".", ""))
                     Me.TextBox_EndIPFourthOctect.Focus()
                     Me.TextBox_EndIPFourthOctect.SelectAll()
                  Case ("TextBox_EndIPFourthOctect")
                     vObj.text = CStr(Replace(vObj.text, ".", ""))
               End Select
               Return
            ElseIf InStr(vObj.text, ".") Or InStr(vObj.text, ",") Or InStr(vObj.text, " ") Then
               MsgBox("Error: Only use Integers (no commas or spaces)!", MsgBoxStyle.Critical)
               vObj.text = CStr(Replace(vObj.text, ",", ""))
               vObj.text = CStr(Replace(vObj.text, " ", ""))
               vObj.Focus()
               vObj.SelectAll()
               Return
            End If
         Else
            MsgBox("Not an Integer!")
            vObj.Focus()
            vObj.SelectAll()
            Return
         End If
 
         'This secions will validate the numerical range value to ensure a valid IP address can be generated.
         'Each octect is checked for a valid range
         'The 4th octect of the End IP address must be the same or greater than the 4th Octect of the Starting Ip Address
         Select Case vObj.Name
            Case "TextBox_StartIPFirstOctect"
               If Not (CInt(vObj.text) >= 1 And CInt(vObj.text) < 255) Then
                  MsgBox("Error:  You must choose a number between 1 and 254!", MsgBoxStyle.Critical)
                  vObj.Focus()
                  vObj.SelectAll()
               End If
            Case "TextBox_StartIPSecondOctect"
               If Not (CInt(vObj.text) >= 0 And CInt(vObj.text) <= 255) Then
                  MsgBox("Error:  You must choose a number between 1 and 254!", MsgBoxStyle.Critical)
                  vObj.Focus()
                  vObj.SelectAll()
               End If
            Case "TextBox_StartIPThirdOctect"
               If Not (CInt(vObj.text) >= 0 And CInt(vObj.text) <= 255) Then
                  MsgBox("Error:  You must choose a number between 1 and 254!", MsgBoxStyle.Critical)
                  vObj.Focus()
                  vObj.SelectAll()
               End If
            Case "TextBox_StartIPFourthOctect"
               If Not (CInt(vObj.text) >= 1 And CInt(vObj.text) <= 254) Then
                  MsgBox("Error:  You must choose a number between 1 and 254!", MsgBoxStyle.Critical)
                  vObj.Focus()
                  vObj.SelectAll()
               End If
            Case "TextBox_EndIPFourthOctect"
               If Not (CInt(vObj.text) >= 1 And CInt(vObj.text) <= 254) Then
                  MsgBox("Error:  You must choose a number between 1 and 254!", MsgBoxStyle.Critical)
                  vObj.Focus()
                  vObj.SelectAll()
                  Return
               End If
               If CInt(vObj.text) < CInt(TextBox_StartIPFourthOctect.Text) Then
                  MsgBox("Error: This value must be equal to greater than the 4th octect of the Starting IP Address", MsgBoxStyle.Critical)
                  vObj.Focus()
                  vObj.SelectAll()
                  Return
               End If
         End Select
      Catch ex As Exception
         MsgBox("Error: " & ex.Message.ToString, MsgBoxStyle.Critical)
      End Try
   End Sub
   Private Sub TextBox_ConnectionTimeout_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox_ConnectionTimeout.TextChanged
      Try
         If Not IsNumeric(TextBox_ConnectionTimeout.Text) Then
            MsgBox("Error : Must enter a numeric value beytween 30 and 1500!", MsgBoxStyle.Critical)
            Return
         End If
      Catch ex As Exception
      End Try
   End Sub
   Private Sub TextBox_ConnectionTimeout_LostFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox_ConnectionTimeout.LostFocus
      Try
         If Not (CInt(TextBox_ConnectionTimeout.Text) >= 30 And CInt(TextBox_ConnectionTimeout.Text) <= 1500) Then
            MsgBox("Error : Must enter a numeric value beytween 30 and 1500!", MsgBoxStyle.Critical)
            Return
         End If
      Catch ex As Exception
      End Try
   End Sub
   Private Sub TextBox_ScanPorts_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox_ScanPorts.TextChanged
      Try
         If Me.TextBox_ScanPorts.Text.Length = 0 Then
            MsgBox("Error: You must enter a integer value!  " & vbCrLf & "Port value can not be blank!", MsgBoxStyle.Critical)
            Me.TextBox_ScanPorts.Text = "80"
            Me.TextBox_ScanPorts.SelectAll()
         End If
      Catch ex As Exception
      End Try
   End Sub
#End Region
 
 
#Region "Result Output Code"
   'This region contains the code related to reporting the results
   Private Function FormatOutputHTML() As String
      Dim x As Integer
      Dim y As Integer
      Dim strOutput As String = ""
 
      strOutput = strOutput & "<html>"
      strOutput = strOutput & "<head>"
      strOutput = strOutput & "<title>Scanner Results</title>"
      strOutput = strOutput & "<style type=""text/css"">"
      strOutput = strOutput & "body{"
      strOutput = strOutput & "font-family:Arial;"
      strOutput = strOutput & "}"
      strOutput = strOutput & "td{"
      strOutput = strOutput & "text-align:center;"
      strOutput = strOutput & "font-size:8pt;"
      strOutput = strOutput & "}"
      strOutput = strOutput & ""
      strOutput = strOutput & ""
      strOutput = strOutput & ""
      strOutput = strOutput & ""
      strOutput = strOutput & "</style>"
      strOutput = strOutput & "</head>"
      strOutput = strOutput & "<body>"
      strOutput = strOutput & "<center>"
      strOutput = strOutput & "<table border=1 cellpadding=2 cellspacing=0>"
      'Write Column headers
      strOutput = strOutput & "<tr>"
      strOutput = strOutput & "<td></td>"    'Address placeholder
      strOutput = strOutput & "<td></td>"    'ICMP placeholder
      strOutput = strOutput & "<td colspan=" & Me.NumberofPorts & " style=""color:White;background:Black;font-weight:bold;"">Ports</td>"
      strOutput = strOutput & "</tr>"
 
      'Write Colum sub-headings
      strOutput = strOutput & "<tr>"
      strOutput = strOutput & "<td style=""color:White;background:#0066ff;font-weight:bold;"">Address</td>"
      strOutput = strOutput & "<td style=""color:White;background:#0066ff;font-weight:bold;"">ICMP</td>"
 
      For x = 0 To Me.NumberofPorts - 1
         strOutput = strOutput & "<td style=""color:White;background:Black;font-weight:bold;"">" & Me.ScanPorts(x) & "</td>"
      Next
      strOutput = strOutput & "</tr>"
 
      'Write each row as a record
      For x = 0 To Me.NumberofHosts
         strOutput = strOutput & "<tr>"
         strOutput = strOutput & "<td>" & Me.SocketArray(x, 0) & "</td>"
         For y = 0 To Me.NumberofPorts
            strOutput = strOutput & "<td style=""color:White;background:" & _StyleResult(Me.ResultArray(x, y)) & """>" & Me.ResultArray(x, y) & "</td>"
         Next
         strOutput = strOutput & "</tr>"
      Next
 
      strOutput = strOutput & "</table>"
      strOutput = strOutput & "<hr>"
      strOutput = strOutput & "<table border=0 cellpadding=2 cellspacing=0>"
      strOutput = strOutput & "<tr>"
      strOutput = strOutput & "<td style=""text-align:right;"">Scan Start Time</td>"
      strOutput = strOutput & "<td style=""text-align:left;"">" & Me.ScanTimeStart.ToLocalTime & "</td>"
      strOutput = strOutput & "</tr><tr>"
      strOutput = strOutput & "<td style=""text-align:right;"">Scan Stop Time</td>"
      strOutput = strOutput & "<td style=""text-align:left;"">" & Me.ScanTimeStop.ToLocalTime & "</td>"
      strOutput = strOutput & "</tr><tr>"
      strOutput = strOutput & "<td style=""text-align:right;"">Scan Time</td>"
      strOutput = strOutput & "<td style=""text-align:left;"">" & Me.ScanTimeLengthSecs.ToString & " secs</td>"
      strOutput = strOutput & "</tr>"
      strOutput = strOutput & "</table>"
      strOutput = strOutput & "</center>"
      strOutput = strOutput & "<br><br>"
      strOutput = strOutput & "<font style=""font-family:Arial;text-align:center;font-size:7pt;font-style:italic;"">Created by Scanner v" & _VersionNumber() & "</font>"
      strOutput = strOutput & "</body></html>"
      FormatOutputHTML = strOutput.ToString
   End Function
   Private Function FormatOutputCSVFile() As String
      Dim x As Integer
      Dim y As Integer
      Dim strOutput As String = ""
 
      'Write Column headers
      strOutput = strOutput & "IP_Address,"
      strOutput = strOutput & "ICMP_Reply,"
      For x = 0 To Me.NumberofPorts - 1
         strOutput = strOutput & "TCP_PORT_" & Me.ScanPorts(x) & ","
      Next
      strOutput = strOutput & vbCrLf
 
      'Write each row as a record
      For x = 0 To Me.NumberofHosts
         strOutput = strOutput & Me.SocketArray(x, 0) & ","
         For y = 0 To Me.NumberofPorts
            strOutput = strOutput & Me.ResultArray(x, y) & ","
         Next
         strOutput = strOutput & vbCrLf
      Next
 
      FormatOutputCSVFile = strOutput.ToString
   End Function
   Private Sub WriteToFile(ByVal FilePath As String, ByVal strData As String)
      Dim objReader As StreamWriter
      Try
         objReader = New StreamWriter(FilePath)
         objReader.Write(strData)
         objReader.Close()
      Catch Ex As Exception
         Dim ErrInfo As String
         ErrInfo = Ex.Message
      End Try
   End Sub
   Public Sub OpenDocument(ByVal DocName As String)
      'Opens a document in it's associated application
      'also works with web pages.
      'Examples:
      'OpenDocument("C:\MyDocument.doc")
      'OpenDocument("http://www.freevbcode.com")
      Try
         Start(DocName)
      Catch ex As Exception
         MsgBox("Error: " & ex.Message, MsgBoxStyle.Critical)
      End Try
   End Sub
   Private Function _StyleResult(ByVal vIn As Object) As String
      _StyleResult = ""
      If vIn.ToString = "Replied" Then
         _StyleResult = "Green"
      ElseIf vIn.ToString = "No Response" Then
         _StyleResult = "Red"
      ElseIf vIn.ToString = "Open" Then
         _StyleResult = "Green"
      ElseIf vIn.ToString = "Closed" Then
         _StyleResult = "Red"
      End If
   End Function
   Private Function _VersionNumber() As String
      Dim VersionNo As System.Version = System.Reflection.Assembly.GetExecutingAssembly.GetName.Version()
      Return VersionNo.Major.ToString & "." & _
      VersionNo.Minor.ToString & "." & _
      VersionNo.Build.ToString & "." & _
      VersionNo.Revision.ToString
   End Function
#End Region
 
#Region "User-Initiated Form-Controls Events"
   'This region has all the event-initiated coding (Form Load, Button Click, etc...)
   Private Sub Form2_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
      'Get the Local Client IP Address (as a default host to scan)
      Call GetLocalIPAddress()
      'Set the default value for ScanDelay
      Me.ComboBox_ScanProbeDelay.SelectedIndex = 0
      'Set default values for Ports
      Me.TextBox_ScanPorts.Text = "20, 21, 22, 23, 25, 53, 69, 80, 110, 119, 143, 443, 445, 3389"
      'Load Values into the global variables
      Call LoadVariable_Values()
      'Set default focus to the first octect textbox
      Me.TextBox_StartIPFirstOctect.Select()
      'Set default number of Threads
      Me.ComboBox_Threads.SelectedIndex = 0
      'Set location of the form on the desktop
      Me.Top = 0
      Me.Left = 0
      'Disable Results buttons (at form load, there are no results! Scan hasn't started yet!)
      Me.Button_SaveCSV.Enabled = False
      Me.Button_ShowHTML.Enabled = False
      Me.Button_Start.BackColor = Color.LightGreen
      Me.LabelScanTime.Text = ""
   End Sub
   Private Sub Button_Start_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button_Start.Click
      'This starts the programs main job - to scan the network!
      'Capture the scan start time
      Me.ScanTimeStart = Now()
      Me.LabelScanTime.Text = ""
      'change bkground color on the buttons
      Me.Button_Start.BackColor = Color.Transparent
      Me.Button_SaveCSV.BackColor = Color.Transparent
      Me.Button_ShowHTML.BackColor = Color.Transparent
      'disable all controsl on the form until the scan is completed
      Call EnableControls(False)
      Me.Refresh()
      'Update variables - ensures all variables are updated before we begin scanning!
      Call LoadVariable_Values()
      'Initialize Progress Bar
      Call InitializeProgressBar()
      Dim h As Integer
      Dim p As Integer
      'Cycle through the number of hosts
      'This section works without the multi-threading
      'For h = 0 To Me.NumberofHosts
      '   'Based on User preference, perform ICMP sweep for each host
      '   If ScanScope_ICMP Or ScanScope_ICMP_TCP Then ResultArray(h, 0) = PingIPAddress(SocketArray(h, 0), h, 0)
      '   'Cycle through each port for each host
      '   For p = 1 To Me.NumberofPorts
      '      'Based on User preference, perform TCP probe
      '      If ScanScope_ICMP_TCP Or ScanScope_TCP Then ResultArray(h, p) = PortProbe(SocketArray(h, 0), SocketArray(h, p))
      '      'Based on User preference, slow down the TCP Port probes
      '      Thread.Sleep(ScanDelay)
      '      'Update the progress of the scan
      '      Me.ProgressBar1.Increment(1)
      '      Me.Button_Start.Text = FormatNumber(ProgressBar1.Value / Me.ProgressBar1.Maximum * 100, 1) & "%"
      '      Me.Refresh()
      '   Next
      '   'Based on User preference, slow down the ICMP sweeps
      '   Me.ProgressBar1.Increment(1)
      '   Me.Button_Start.Text = FormatNumber(ProgressBar1.Value / Me.ProgressBar1.Maximum * 100, 1) & "%"
      '   Me.Refresh()
      '   Thread.Sleep(ScanDelay)
      'Next
 
      'Now - try multi-threading...
      'ICMP Sweep
      
      If ScanScope_ICMP Or ScanScope_ICMP_TCP Then
         ReDim ThreadObj(NumberofThreads)
         ReDim WorkerThread(NumberofThreads)
         For h = 0 To Me.NumberofHosts
            'Based on User preference, perform ICMP sweep for each host
            For x = 1 To NumberofThreads
               'Instantiate the worker thread
               WorkerThread(x) = New WorkerThreadClass(Me)
               'Create the thread as a new worker thread and set thread properties
               ThreadObj(x) = New Thread(AddressOf WorkerThread(x).ICMP_Sweep)
               ThreadObj(x).Priority = ThreadPriority.AboveNormal
               ThreadObj(x).IsBackground = True
               'Pass a value into the worker class fields
               WorkerThread(x).vIPAddress = SocketArray(h, 0)
               WorkerThread(x).intIPLoc = h
               WorkerThread(x).intresultLoc = 0
               'start the thread
               ThreadObj(x).Start()
            Next
            'Cycle through each port for each host
            'Based on User preference, slow down the ICMP sweeps
            Thread.Sleep(ScanDelay)
         Next
      End If
 
 
      ''Port Probe
      If ScanScope_ICMP_TCP Or ScanScope_TCP Then
         ReDim ThreadObj(NumberofThreads)
         ReDim WorkerThread(NumberofThreads)
         For h = 0 To Me.NumberofHosts
            'Based on User preference, perform ICMP sweep for each host
            'Cycle through each port for each host
            For p = 1 To Me.NumberofPorts
               'Based on User preference, perform TCP probe
               For x = 1 To NumberofThreads
                  'Instantiate the worker thread
                  WorkerThread(x) = New WorkerThreadClass(Me)
                  'Create the thread as a new worker thread and set thread properties
                  ThreadObj(x) = New Thread(AddressOf WorkerThread(x).Port_Probe)
                  ThreadObj(x).Priority = ThreadPriority.AboveNormal
                  ThreadObj(x).IsBackground = True
                  'Pass a value into the worker class fields
                  WorkerThread(x).vIPAddress = SocketArray(h, 0)
                  WorkerThread(x).intIPLoc = h
                  WorkerThread(x).intPort = SocketArray(h, p)
                  WorkerThread(x).intresultLoc = p
                  WorkerThread(x).ConnectionTimeout = ScanDelay
 
                  'start the thread
                  ThreadObj(x).Start()
               Next
 
               'Based on User preference, slow down the TCP Port probes
               Thread.Sleep(ScanDelay)
            Next
            'Based on User preference, slow down the ICMP sweeps
            Thread.Sleep(ScanDelay)
         Next
      End If
 
      'Capture the Scan end time and calculate the time in seconds to complete the scan
      'Me.ScanTimeStop = Now()
      'Me.ScanTimeLengthSecs = DateDiff(DateInterval.Second, Me.ScanTimeStart, Me.ScanTimeStop)
      ''Re-enable Form controls
      'Call EnableControls(True)
      'Me.Button_ShowHTML.BackColor = Color.LightGreen
      'Me.Button_SaveCSV.BackColor = Color.LightGreen
      'Me.Button_Start.Text = "&Start"
 
   End Sub
   Private Sub Button_ShowHTML_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button_ShowHTML.Click
      Call WriteToFile(HTMLFileOutput, FormatOutputHTML)
      OpenDocument(Me.HTMLFileOutput.ToString)
      Button_Start.BackColor = Color.LightGreen
      Button_ShowHTML.BackColor = Color.Transparent
   End Sub
   Private Sub Button_SaveCSV_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button_SaveCSV.Click
      'Create and SaveFileDialog object and set default values.  This will let the user choose where to save the CSV file.
      Dim dlgSave As New SaveFileDialog
      dlgSave.InitialDirectory = Path.GetTempPath()
      dlgSave.AddExtension = True
      dlgSave.DefaultExt = "csv"
      dlgSave.Filter = "Comma Delimited File (CSV)|*.csv"
      dlgSave.FileName = "Scanner_Result_" & Year(Now()) & "-" & Month(Now()) & "-" & Microsoft.VisualBasic.Day(Now()) & "-" & Hour(Now()) & "-" & Minute(Now()) & ".csv"
      dlgSave.ShowDialog()
      Call WriteToFile(dlgSave.FileName, FormatOutputCSVFile)
      OpenDocument(dlgSave.FileName)
      Button_Start.BackColor = Color.LightGreen
      Button_SaveCSV.BackColor = Color.Transparent
   End Sub
#End Region
 
   Friend Sub UpdateUI_ICMP(ByVal vIn As String)
      'This sub will update the UI.  The SyncLock will prevent any other code from updating the object
 
      'Delcare the SyncLock object and begin the synclock
      Dim SyncLockObj As New Object()
      SyncLock SyncLockObj
         If Me.ProgressBar1.InvokeRequired Then
            Dim _delegate As New CallBackFunction(AddressOf UpdateUI_ICMP)
            Me.Invoke(_delegate, New Object() {vIn})
         Else
            'Since we are "here", the thread is calling the update, so it will be _
            'performed: "thread safe" and "SyncLocked"-ed
            
            Dim t As Integer
            Dim vResultArray As Array = Split(vIn, ",")
            For t = 0 To UBound(vResultArray)
               Dim HostArrayLocation As Integer = vResultArray(2)
               Dim ICMPResultValue As String = vResultArray(0)
               ResultArray(HostArrayLocation, 0) = ICMPResultValue.ToString
            Next
            Me.ProgressBar1.Increment(1)
            Me.Button_Start.Text = FormatNumber(ProgressBar1.Value / Me.ProgressBar1.Maximum * 100, 1) & "%" & vbCrLf & _
               ProgressBar1.Value & " 0f " & ProgressBar1.Maximum.ToString & " tests completed."
            Me.Refresh()
         End If
      End SyncLock
   End Sub
 
   Friend Sub UpdateUI_Port(ByVal vIn As String)
      'This sub will update the UI.  The SyncLock will prevent any other code from updating the object
 
      'Delcare the SyncLock object and begin the synclock
      Dim SyncLockObj As New Object()
      SyncLock SyncLockObj
         If Me.ProgressBar1.InvokeRequired Then
            Dim _delegate As New CallBackFunction(AddressOf UpdateUI_Port)
            Me.Invoke(_delegate, New Object() {vIn})
         Else
            'Since we are "here", the thread is calling the update, so it will be _
            'performed: "thread safe" and "SyncLocked"-ed
 
            Dim t As Integer
            Dim vResultArray As Array = Split(vIn, ",")
            For t = 0 To UBound(vResultArray)
               Dim HostArrayLocation As Integer = vResultArray(2)
               Dim ProbeResultValue As String = vResultArray(0)
               Dim ProbeArrayLocation As String = vResultArray(3)
               ResultArray(HostArrayLocation, ProbeArrayLocation) = ProbeResultValue.ToString
            Next
            'MsgBox(vIn & ProgressBar1.Value.ToString)
 
            Me.ProgressBar1.Increment(1)
            Me.Button_Start.Text = FormatNumber(ProgressBar1.Value / Me.ProgressBar1.Maximum * 100, 1) & "%" & vbCrLf & _
               ProgressBar1.Value & " 0f " & ProgressBar1.Maximum.ToString & " tests completed."
            Me.Refresh()
         End If
      End SyncLock
   End Sub
 
   Private Sub Button_Start_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button_Start.TextChanged
      If InStr(Button_Start.Text, "100.0%") > 0 Then
         ' Mid(Button_Start.Text, 6) = "100.0%" Then
         'Capture the Scan end time and calculate the time in seconds to complete the scan
         Me.ScanTimeStop = Now()
         Me.ScanTimeLengthSecs = DateDiff(DateInterval.Second, Me.ScanTimeStart, Me.ScanTimeStop)
         'Re-enable Form controls
         Call EnableControls(True)
         Me.Button_ShowHTML.BackColor = Color.LightGreen
         Me.Button_SaveCSV.BackColor = Color.LightGreen
         Me.Button_Start.Text = "&Start"
         Me.LabelScanTime.Text = Me.ScanTimeLengthSecs.ToString & " seconds"
      End If
   End Sub
 
End Class
 
Public Class WorkerThreadClass
   'This is an example that will allow variables to be passed in - either as public variables whenthe 
   'object is defined, or as input parms when the workerthread object is instaniated in the calling thread (UI)
 
 
   Private Event ThreadComplete_ICMPSweep(ByVal vOutput As String)
   Private Event ThreadComplete_PortProbe(ByVal vOutput As String)
   'this is a reference to the main UI class...necessary for the UpdateUI routine
   Dim frm_Main_ref As Form2
   
   'Public vInputField As Integer
 
   'Public Variables used for ICMP_Sweep
   Public vIPAddress As String
   Public intIPLoc As Integer
   Public intresultLoc As Integer
   Public vResultPostBack As String
 
   'Public Variables used for Port_Probe
   Public intPort As Integer
   Public ConnectionTimeout As Integer
 
   Dim connectionTCP As New TcpClient
   WithEvents TCPtimeouttimer As System.Timers.Timer
   Private TCPtimeout As Boolean = False
   Private networkStream As NetworkStream
 
 
   Public Sub New(ByRef FormObject As Form2)
      'Instantiate the reference class object
      frm_Main_ref = FormObject
   End Sub
 
   'Public Sub DoWork()
   '   'This is where the work is performed by the thread
   '   'vResultPostBack = xThreadArrayIndex
   '   vResultPostBack = vInputField
   '   System.Threading.Thread.Sleep(2000)
   '   'frm_Main_ref.UpdateUI(Square)
   '   RaiseEvent ThreadComplete(vResultPostBack)
   'End Sub
 
   Public Sub ICMP_Sweep()
      Dim strPingFromComputer, objWMIService, colPings, objStatus
      Dim vICMPResult As String = ""
      strPingFromComputer = "."
      objWMIService = GetObject("winmgmts:\\" & strPingFromComputer & "\root\cimv2")
      colPings = objWMIService.ExecQuery _
          ("Select * From Win32_PingStatus where Address = '" & vIPAddress & "'")
      For Each objStatus In colPings
         If IsDBNull(objStatus.StatusCode) _
             Or objStatus.StatusCode <> 0 Then
            vICMPResult = "No Response"
         Else
            vICMPResult = "Replied"
         End If
      Next
      'This is where the work is performed by the thread
      RaiseEvent ThreadComplete_ICMPSweep(vICMPResult)
   End Sub
 
   Public Sub Port_Probe()
      'Private Function PortProbe(ByVal Host As String, ByVal Port As Integer) ' Create new connection over TCPIP
      Dim vPortProbeResult As String = ""
      connectionTCP = New TcpClient
      TCPtimeout = False
      Try
         TCPtimeouttimer = New System.Timers.Timer(ConnectionTimeout)
         TCPtimeouttimer.Start()
         connectionTCP.Connect(vIPAddress, intPort)
         NetworkStream = connectionTCP.GetStream()
         TCPtimeouttimer.Stop()
         TCPtimeouttimer.Close()
         If connectionTCP.Connected Then
            vPortProbeResult = "Open"
         Else
            vPortProbeResult = "Closed"
         End If
      Catch ex As Exception
         vPortProbeResult = "Closed"
         'Dim x As String = ex.Message
         'MsgBox(x.ToString)
      End Try
 
      If (TCPtimeout = True) Then
         '   PortProbe = "Open" 'MsgBox("Connected.")
         'Else
         vPortProbeResult = "Closed" 'MsgBox("Timed-Out.")
      End If
 
      'This is where the work is performed by the thread
      RaiseEvent ThreadComplete_PortProbe(vPortProbeResult)
   End Sub
 
   Private Sub TCPtimeouthandler(ByVal source As Object, ByVal e As System.Timers.ElapsedEventArgs) Handles TCPtimeouttimer.Elapsed
      Try
         TCPtimeout = True
         connectionTCP.LingerState.Enabled = False
         connectionTCP.Close()
      Catch ex As Exception
         'MsgBox(ex.Message)
      End Try
   End Sub
 
   Sub Eventhandler_ThreadComplete_ICMPSweep(ByVal vOutput As String) Handles Me.ThreadComplete_ICMPSweep
      'Although the event is "manually" raised by code, it will fire and update the UI
      Dim vReturn As String = vOutput & "," & vIPAddress & "," & intIPLoc & "," & intresultLoc
      frm_Main_ref.UpdateUI_ICMP(vReturn)
   End Sub
 
   Sub Eventhandler_ThreadComplete_PortProbe(ByVal vOutput As String) Handles Me.ThreadComplete_PortProbe
      'Although the event is "manually" raised by code, it will fire and update the UI
      Dim vReturn As String = vOutput & "," & vIPAddress & "," & intIPLoc & "," & intresultLoc
      frm_Main_ref.UpdateUI_Port(vReturn)
   End Sub
End Class
[+][-]04/03/08 05:05 PM, ID: 21278066Accepted Solution

View this solution now by starting your 30-day free trial. Setting up your free trial is quick, easy, and secure. We will return you to this solution, unlocked, when you're done.

About this solution

Zones: Visual Studio, Microsoft Visual Basic.Net
Tags: vb.net, multi-threading
Sign Up Now!
Solution Provided By: GreenGhost
Participating Experts: 1
Solution Grade: A
 
[+][-]04/01/08 09:11 PM, ID: 21260149Author Comment

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 30-day free trial to view this Author Comment or ask the Experts your question.

 
[+][-]04/02/08 09:55 AM, ID: 21264988Expert Comment

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 30-day free trial to view this Expert Comment or ask the Experts your question.

 
[+][-]04/02/08 05:07 PM, ID: 21268703Author Comment

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 30-day free trial to view this Author Comment or ask the Experts your question.

 
[+][-]04/02/08 08:22 PM, ID: 21269519Expert Comment

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 30-day free trial to view this Expert Comment or ask the Experts your question.

 
[+][-]04/03/08 03:04 PM, ID: 21277399Author Comment

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 30-day free trial to view this Author Comment or ask the Experts your question.

 
 
Loading Advertisement...
20091118-EE-VQP-93 / EE_QW_2_20070628