vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
sevAniGif - als kostenlose Vollversion auf unserer vb@rchiv CD Vol.5  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik:    |   VB-Versionen: VB.NET01.08.06
PingAsync - MultiThreading Klasse (VB 2005)

Mit diesem ExtraTipp möchten wir Ihnen einen Ping mit erweiterten Funktionen an die Hand geben.

Autor:  Roland WutzkeBewertung:     [ Jetzt bewerten ]Views:  1.598 
http://www.vb-power.netSystem:  WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt 

Mit diesem ExtraTipp möchten wir Ihnen einen Ping mit erweiterten Funktionen an die Hand geben. Das VB.Net 2005 Klassenmodul clsPingAsync stellt Ihnen nicht nur den Ping zur Verfügung, sondern direkt einen asynchronen MultiTreading Ping-Pool. Mittels der neu im FW2.0 implementierten SemaPhore Klasse ist es Möglich, eine begrenzte Anzahl von Threads gleichzeitig auszuführen. Diese Technik wird in unserer Ping Klasse verwendet.

Zusätzlich bietet unsere Ping Klasse Ihnen die Option an, den erreichten Host in den DNS-Namen aufzulösen. Dies ist besonders in LANs sehr hilfreich, da hier der DNS-Server den Hostnamen (i.d.R. den PC-Namen) im Klartext zurückgibt.

Ein weiterer Vorteil der MultiThreading Technik in Verbindung mit dem SemaPhore Buffer ist der, dass Ihre Anwendung nicht einfriert, wenn die asynchronen Ping´s ausgeführt werden. So können Sie bspw. Ihr gesamtes LAN in kürzester Zeit scannen und sehr schnell feststellen, welcher PC / Server erreichbar ist oder nicht.

Die Klasse clsPingAsync bietet Ihnen eine mehrfach überladene Ping-Methode an, die es zulässt, den Ping mit verschiedenen Optionen auszuführen. Weiterhin können Sie selber den Thread-Buffer setzen und dabei bestimmen, wie viele Threads (Ping´s) gleichzeitig im Hintergrund laufen sollen. Das Ergebnis (Reply) eines Ping-Threads wird Ihnen in einem Ereignis noch zur Laufzeit des gesamten Buffers zurückgegeben.

Diese Technik und die gesamte Verwendung der Klasse zeigen wir Ihnen in unserem Demoprojekt.

Nachfolgend die Auflistung der Klasse clsPingAsync:

Imports System.Net
Imports System.Threading
 
''' <summary>
''' Stellt einen asynchronen Ping zur Verfügung
''' </summary>
''' <remarks>
''' Dieses VB.Net 2005 Klassenmodul stellt einen asynchronen Ping
''' mittels MultiThreading zur Verfügung. Es können mehrere Pings
''' parallel ausgeführt werden, ohne das die Anwendung einfriert.
''' Die Ping Methode ist mehrfach Überladen und stellt dabei
''' Parameter für Timeout, Count, Delay und DNS Auflösung zur 
''' Verfügung. Über die Eigenschaften können die Thred-Buffer 
''' Größe und die max.Anzahl von parallel arbeitenden Threads
''' bestimmt werden. Diverse Events geben den Ping-Reply und
''' den Thread-Buffer Status an die aufrufende Form zurück.
''' 
''' Juli 2006 - VB-Power.net
''' http://www.vb-power.net
''' </remarks>
Public Class clsPingAsync
 
  ''' <summary>
  ''' Datenklasse - stellt die Ping-Reply Rückgabewerte zur Verfügung
  ''' </summary>
  Class PingArgs
    Implements ICloneable
 
    Friend Buffer() As Byte
    Friend Delay As Integer
    Friend Hostaddress As String
    Friend PingSuccess As Boolean
    Friend Status As String
    Friend ResolvedDNS As String
    Friend ResolvedIPAddress As String
    Friend RoundTripTime As Long
    Friend Timeout As Integer
    Friend TTL As Integer
 
    ''' <summary>
    ''' Erstellt eine Kopie der Datenklasse
    ''' </summary>
    Friend Function Clone() As Object Implements System.ICloneable.Clone
      Return Me.MemberwiseClone()
    End Function
  End Class
 
  ' Private Klassen-Vars
  Private Shared RunningThreads As Integer = 0
  Private Shared m_MaxRunningThreads As Integer = 2
  Private Shared m_ThreadBufferSize As Integer = 50
  Private Shared m_Pool As New Semaphore(m_MaxRunningThreads, m_ThreadBufferSize)
 
  ' Öffentliche Events
  Public Event AddThread(ByVal HostAddress As String)
  Public Event AddThreadComplete(ByVal HostAddress As String)
  Public Event EnterThreadToPool(ByVal Count As Integer)
  Public Event ReleaseThreadFromPool(ByVal Remaining As Integer)
  Public Event ReturnPingReply(ByVal e As PingArgs)
  Public Event ThreadBufferOverflow(ByVal RejectedHost As String)
 
 
#Region "Eigenschaften"
  ''' <summary>
  ''' Gibt die Anzahl Threads im Buffer zurück
  ''' </summary>
  Public ReadOnly Property TreadsInBuffer() As Integer
    Get
      Return Interlocked.Read(RunningThreads)
    End Get
  End Property
 
  ''' <summary>
  ''' Legt die Größe des Thread-Buffers fest, oder liest ihn aus.
  ''' </summary>
  Public Property ThreadBufferSize() As Integer
    Get
      Return m_ThreadBufferSize
    End Get
    Set(ByVal value As Integer)
      m_ThreadBufferSize = value
      SetPool()
    End Set
  End Property
 
  ''' <summary>
  ''' Legt die Anzahl der gleichzeitig laufenden Threads fest.
  ''' </summary>
  Public Property MaxRunningThreads() As Integer
    Get
      Return m_MaxRunningThreads
    End Get
    Set(ByVal value As Integer)
      m_MaxRunningThreads = value
      SetPool()
    End Set
  End Property
 
  ''' <summary>
  ''' Setzt den Semaphore Thread-Buffer
  ''' </summary>
  Private Sub SetPool()
    Try
      m_Pool = New Semaphore(m_MaxRunningThreads, m_ThreadBufferSize)
    Catch ex As Exception
      Throw ex
    End Try
  End Sub
#End Region
 
#Region "Ping mit seinen Überladungen"
  ''' <summary>
  ''' Führt einen asynchronen Ping auf eine Hostadresse aus
  ''' </summary>
  ''' <param name="Hostaddress">IP-Adresse oder Hostname</param>
  Public Sub Ping(ByVal Hostaddress As String)
    DoPing(Hostaddress, 1000, 1, 0, False, Nothing)
  End Sub
 
  ''' <param name="Hostaddress">IP-Adresse oder Hostname</param>
  ''' <param name="Timeout">Timeout in Millisekunden</param>
  Public Sub Ping(ByVal Hostaddress As String, ByVal Timeout As Integer)
    DoPing(Hostaddress, Timeout, 1, 0, False, Nothing)
  End Sub
 
  ''' <param name="Hostaddress">IP-Adresse oder Hostname</param>
  ''' <param name="Timeout">Timeout in Millisekunden</param>
  ''' <param name="Count">Die Anzahl von Pings, die auf die angegebene
  ''' Adresse ausgeführt werden</param>
  Public Sub Ping(ByVal Hostaddress As String, ByVal Timeout As Integer, _
    ByVal Count As Integer)
 
    DoPing(Hostaddress, Timeout, Count, 0, False, Nothing)
  End Sub
 
  ''' <param name="Hostaddress">IP-Adresse oder Hostname</param>
  ''' <param name="Timeout">Timeout in Millisekunden</param>
  ''' <param name="Count">Die Anzahl von Pings, die auf die angegebene
  ''' Adresse ausgeführt werden</param>
  ''' <param name="Delay">Zeitverzögerung in Millisekunden</param>
  Public Sub Ping(ByVal Hostaddress As String, ByVal Timeout As Integer, _
    ByVal Count As Integer, ByVal Delay As Integer)
 
    DoPing(Hostaddress, Timeout, Count, Delay, False, Nothing)
  End Sub
 
  ''' <param name="Hostaddress">IP-Adresse oder Hostname</param>
  ''' <param name="Timeout">Timeout in Millisekunden</param>
  ''' <param name="Count">Die Anzahl von Pings, die auf die angegebene
  ''' Adresse ausgeführt werden</param>
  ''' <param name="Delay">Zeitverzögerung in Millisekunden</param>
  ''' <param name="ResolveDNS">Gibt an, ob der DNS-Name aufgelöst werden soll</param>
  Public Sub Ping(ByVal Hostaddress As String, ByVal Timeout As Integer, _
    ByVal Count As Integer, ByVal Delay As Integer, ByVal ResolveDNS As Boolean)
 
    DoPing(Hostaddress, Timeout, Count, Delay, ResolveDNS, Nothing)
  End Sub
 
  ''' <param name="Hostaddress">IP-Adresse oder Hostname</param>
  ''' <param name="Timeout">Timeout in Millisekunden</param>
  ''' <param name="Count">Die Anzahl von Pings, die auf die angegebene
  ''' Adresse ausgeführt werden</param>
  ''' <param name="Delay">Zeitverzögerung in Millisekunden</param>
  ''' <param name="ResolveDNS">Gibt an, ob der DNS-Name aufgelöst werden soll</param>
  ''' <param name="Buffer">Legt den benutzerdefinierten Reply-Buffer fest</param>
  Public Sub Ping(ByVal Hostaddress As String, ByVal Timeout As Integer, _
    ByVal Count As Integer, ByVal Delay As Integer, _
    ByVal ResolveDNS As Boolean, ByVal Buffer() As Byte)
 
    DoPing(Hostaddress, Timeout, Count, Delay, ResolveDNS, Buffer)
  End Sub
 
  ''' <param name="HostList">Eine Liste mit IP-Adressen oder Hostnamen</param>
  ''' <param name="Timeout">Timeout in Millisekunden</param>
  ''' <param name="Count">Die Anzahl von Pings, die auf die angegebene
  ''' Adresse ausgeführt werden</param>
  ''' <param name="Delay">Zeitverzögerung in Millisekunden</param>
  ''' <param name="ResolveDNS">Gibt an, ob der DNS-Name aufgelöst werden soll</param>
  Public Sub Ping(ByVal HostList As List(Of String), ByVal Timeout As Integer, _
    ByVal Count As Integer, ByVal Delay As Integer, ByVal ResolveDNS As Boolean)
 
    If HostList.Count <= 0 Then Exit Sub
    For Each s As String In HostList
      DoPing(s, Timeout, Count, Delay, ResolveDNS, Nothing)
    Next
  End Sub
#End Region
 
#Region "Threads"
  ''' <summary>
  ''' Diese Methode startet die Ping Threads
  ''' </summary>
  Private Sub DoPing(ByVal Hostaddress As String, ByVal Timeout As Integer, _
    ByVal Count As Integer, ByVal Delay As Integer, ByVal ResolveDNS As Boolean, _
    ByVal Buffer() As Byte)
 
    For x As Integer = 1 To Count
      If Interlocked.Read(RunningThreads) >= m_ThreadBufferSize Then
        RaiseEvent ThreadBufferOverflow(Hostaddress)
      Else
        RaiseEvent AddThread(Hostaddress)
        Dim t As New Thread(AddressOf RunPingAsync)
        Interlocked.Increment(RunningThreads)
        RaiseEvent EnterThreadToPool(Interlocked.Read(RunningThreads))
        t.Start(New Object() {Hostaddress, Timeout, ResolveDNS, Delay, Buffer})
        RaiseEvent AddThreadComplete(Hostaddress)
      End If
    Next
  End Sub
 
  ''' <summary>
  ''' Der eigentliche Ping Thread. Übergeben wird ein
  ''' Param-Objekt mit den Ping-Daten. Die Rückgabe erfolgt
  ''' über den Event ReturnPingReply(Class PingArgs).
  ''' </summary>
  Private Sub RunPingAsync(ByVal Data As Object)
    Dim pInfo As New PingArgs
    Dim p As New NetworkInformation.Ping
    Dim r As NetworkInformation.PingReply
 
    ' Thread in den Semaphore-Buffer aufnehmen
    m_Pool.WaitOne()
 
    pInfo.Hostaddress = Data(0)
    pInfo.Timeout = Data(1)
    pInfo.Delay = Data(3)
 
    Try
      With pInfo
        ' Ping an Host senden
        If Data(4) Is Nothing Then
          r = p.Send(.Hostaddress, .Timeout)
        Else
          r = p.Send(.Hostaddress, .Timeout, Data(4))
        End If
 
        ' Ping-Reply in die Return-Klasse übertragen
        .Status = r.Status.ToString
        .PingSuccess = (r.Status.ToString.ToUpper = "SUCCESS")
        .Buffer = r.Buffer
        .ResolvedIPAddress = r.Address.ToString
        .RoundTripTime = r.RoundtripTime
        .TTL = r.Options.Ttl
 
        ' DNS-Name ermitteln
        If Data(2) Then
          Dim i As IPHostEntry = Dns.GetHostEntry(.Hostaddress)
          .ResolvedDNS = i.HostName
        End If
 
        ' Den Thread ggf. Schlafen legen
        Thread.CurrentThread.Sleep(Data(3))
      End With
    Catch ex As NetworkInformation.PingException
      pInfo.Status = ex.Message
      pInfo.PingSuccess = False
    Catch ex As Sockets.SocketException
      pInfo.Status = ex.Message
       pInfo.PingSuccess = False
    Catch ex As ThreadAbortException
      pInfo.Status = ex.Message
      pInfo.PingSuccess = False
    Catch ex As Exception
      pInfo.PingSuccess = False
    Finally
      p.Dispose()
    End Try
 
    ' Rückgabe der Ping-Reply Informationen
    SyncLock (Me)
      RaiseEvent ReturnPingReply(pInfo)
      m_Pool.Release(1)
      Interlocked.Decrement(RunningThreads)
      RaiseEvent ReleaseThreadFromPool(Interlocked.Read(RunningThreads))
    End SyncLock
  End Sub
#End Region
 
End Class

Viel Spaß beim Pingen...
Roland Wutzke