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... |