5/5 (1 avis)
Vue 13 120 fois - Téléchargée 524 fois
Imports System.Runtime.InteropServices Imports System.Net Imports System.Text Public Class Ping Private Const LMEM_ZEROINIT As Integer = 64 #Region " Declaration des API" ' declaration des API <DllImport("coredll")> Public Shared Function LocalAlloc(ByVal flags As Integer, ByVal size As Integer) As IntPtr End Function <DllImport("coredll")> Public Shared Function LocalFree(ByVal pMem As IntPtr) As IntPtr End Function <DllImport("coredll")> Public Shared Function GetLastError() As Integer End Function <DllImport("iphlpapi")> Public Shared Function IcmpCreateFile() As IntPtr End Function <DllImport("iphlpapi")> Public Shared Function IcmpCloseHandle(ByVal h As IntPtr) As Boolean End Function <DllImport("iphlpapi")> Public Shared Function IcmpSendEcho(ByVal IcmpHandle As IntPtr, _ ByVal DestinationAddress As UInt32, ByVal RequestData As Byte(), ByVal RequestSize As Short, ByVal RequestOptions As IntPtr, _ ByVal ReplyBuffer As Byte(), ByVal ReplySize As Integer, ByVal Timeout As Integer) As UInt32 End Function #End Region Public Sub Execute(ByVal p_Adresse As String, ByVal Lbx_Ping As Windows.Forms.ListBox) ' creation des donnees envoyées = 64 bites Dim z_DataEnvoi As Byte() = Encoding.ASCII.GetBytes(New String("x", 64)) ' allocation de l'espace pour la reponse Dim z_Reponse As New ICMP_ECHO_REPLY(255) ' on recupere le pointeur sur l'espace reponse 'Dim pData As IntPtr = LocalAlloc(LMEM_ZEROINIT, z_Reponse.DataSize) z_Reponse.Data = LocalAlloc(LMEM_ZEROINIT, z_Reponse.DataSize) ' transformation de l'adresse a pinger en UInt32 Dim z_IPServeurHost As IPAddress = IPAddress.Parse(p_Adresse) Dim z_AddresseIp As UInt32 = Convert.ToUInt32(z_IPServeurHost.Address) ' creation de l'espace Icmp Dim z_hIcmp As IntPtr = IcmpCreateFile() ' boucle de Ping - 4 fois Dim z_i As Integer For z_i = 0 To 3 ' envoi de la requete Dim z_Retour As UInt32 = IcmpSendEcho(z_hIcmp, z_AddresseIp, z_DataEnvoi, z_DataEnvoi.Length, IntPtr.Zero, z_Reponse.DonneesRecus, z_Reponse.DonneesRecus.Length, 2000) ' initialisation du code erreur Dim z_Erreur As Integer = 0 If Convert.ToInt32(z_Retour) = 0 Then ' 0 - erreur dans la reponse ' on recupere l'erreur z_Erreur = GetLastError() If (z_Erreur <> 11010) Then ' erreur autre que TimeOut - on affiche et on arrete tout Lbx_Ping.Items.Add("Erreur de ping. Code Erreur : " + z_Erreur.ToString()) Lbx_Ping.Refresh() Exit For Else ' Erreur TimeOut Lbx_Ping.Items.Add("Pas de réponse.") Lbx_Ping.Refresh() End If Else ' pas d'erreur - on affiche le temps de reponse Lbx_Ping.Items.Add(String.Format("Réponse en {0} ms.", z_Reponse.RoundTripTime)) Lbx_Ping.Refresh() ' on attent avant la prochaine requete System.Threading.Thread.Sleep(2000) End If Next ' liberation des elements memoires IcmpCloseHandle(z_hIcmp) LocalFree(z_Reponse.Data) End Sub End Class #Region " Structure de reponse" ' structure de reponse Public Class ICMP_ECHO_REPLY Public Sub New(ByVal size As Integer) _DonneesRecus = New [Byte](size) {} DataSize = size End Sub Private _DonneesRecus As Byte() Public ReadOnly Property DonneesRecus() As Byte() Get Return _DonneesRecus End Get End Property Public ReadOnly Property Adress() As Integer Get Return BitConverter.ToInt32(_DonneesRecus, 0) End Get End Property Public ReadOnly Property Status() As Integer Get Return BitConverter.ToInt32(_DonneesRecus, 4) End Get End Property ' temps de reponse Public ReadOnly Property RoundTripTime() As Integer Get Return BitConverter.ToInt32(_DonneesRecus, 8) End Get End Property ' taille des donnees echangés Public Property DataSize() As Short Get Return BitConverter.ToInt16(_DonneesRecus, 12) End Get Set(ByVal Value As Short) BitConverter.GetBytes(Value).CopyTo(_DonneesRecus, 12) End Set End Property Public Property Data() As IntPtr Get Return New IntPtr(BitConverter.ToInt32(_DonneesRecus, 16)) End Get Set(ByVal Value As IntPtr) BitConverter.GetBytes(Value.ToInt32()).CopyTo(_DonneesRecus, 16) End Set End Property ' TTL Public ReadOnly Property Ttl() As Byte Get Return _DonneesRecus(20) End Get End Property End Class #End Region
25 mai 2009 à 16:10
Source très bien, très utile que j'ai utilisée et modifiée pour mes besoins.
Un bug constaté cependant.
Le buffer est alloué par : z_Reponse.Data = LocalAlloc(LMEM_ZEROINIT, z_Reponse.DataSize)
Selon le type d'erreur IcmpSendEcho change le pointeur pour retourner ses données associées à l'erreur.
Et du coup la désallaction LocalFree(z_Reponse.Data) plante avec une erreur d'accès mémoire !
J'ai donc mémorisé le pointeur juste après son allocation pour être sur de libérer ce que j'ai alloué.
Un doute subsiste sur la désallocation de la zone ré attribuée par IcmpSendEcho. Mais je n'ai pas constaté de perte de mémoire après de nombreuse exécutions.
Merci pour le source.
Philippe.
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.