Le PING avec les fonctions ICMP de Windows

Article lu fois.

L'auteur

L'article

Publié le 11 janvier 2003 - Mis à jour le 5 janvier 2013

1. Mentions légales▲

Comme souvent avec des codes très fréquemment utilisés, le copyright sur ce code a été perdu dans l'immensité de l'Internet. (ce code a été retrouvé avec plusieurs copyrights distincts sur des sites differents :o) . Bien sûr, je ne prétends pas être l'auteur de ce code, mais j'ai rajouté un certain nombre de commentaires pour une plus grande compréhension du fonctionnement de cette routine...

2. Qu'est-ce que le PING (petit rappel de base) ?▲

Envoyer un ping sur une machine consiste à envoyer un paquet spécial sur le port 7 (écho) de la machine distante. Celle-ci répond alors en renvoyant à l'identique le message envoyé. Mais les choses sont plus compliquées que ça (malheureusement). Le ping se fait à l'aide d'un protocole particulier nommé ICMP (Internet Control Message Protocol), qui ne se contente pas d'envoyer un packet sur le port 7 (chose qu'on pourrait faire plus simplement), mais récupère encore le temps de réponse et bien d'autres choses encore.

3. Comment coder le ping en VB ?▲

Tout d'abord, il est nécessaire de déclarer toutes les fonctions dans un module standard BAS.

Cacher/Afficher le codeSélectionnez

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.

'debut du code MODULE1.BAS (ou autre nom si vous voulez :o)


Option Explicit

'definition des constantes
Private Const IP_STATUS_BASE As Long = 11000
Private Const IP_SUCCESS As Long = 0
Private Const IP_BUF_TOO_SMALL As Long = (11000 + 1)
Private Const IP_DEST_NET_UNREACHABLE As Long = (11000 + 2)
Private Const IP_DEST_HOST_UNREACHABLE As Long = (11000 + 3)
Private Const IP_DEST_PROT_UNREACHABLE As Long = (11000 + 4)
Private Const IP_DEST_PORT_UNREACHABLE As Long = (11000 + 5)
Private Const IP_NO_RESOURCES As Long = (11000 + 6)
Private Const IP_BAD_OPTION As Long = (11000 + 7)
Private Const IP_HW_ERROR As Long = (11000 + 8)
Private Const IP_PACKET_TOO_BIG As Long = (11000 + 9)
Private Const IP_REQ_TIMED_OUT As Long = (11000 + 10)
Private Const IP_BAD_REQ As Long = (11000 + 11)
Private Const IP_BAD_ROUTE As Long = (11000 + 12)
Private Const IP_TTL_EXPIRED_TRANSIT As Long = (11000 + 13)
Private Const IP_TTL_EXPIRED_REASSEM As Long = (11000 + 14)
Private Const IP_PARAM_PROBLEM As Long = (11000 + 15)
Private Const IP_SOURCE_QUENCH As Long = (11000 + 16)
Private Const IP_OPTION_TOO_BIG As Long = (11000 + 17)
Private Const IP_BAD_DESTINATION As Long = (11000 + 18)
Private Const IP_ADDR_DELETED As Long = (11000 + 19)
Private Const IP_SPEC_MTU_CHANGE As Long = (11000 + 20)
Private Const IP_MTU_CHANGE As Long = (11000 + 21)
Private Const IP_UNLOAD As Long = (11000 + 22)
Private Const IP_ADDR_ADDED As Long = (11000 + 23)
Private Const IP_GENERAL_FAILURE As Long = (11000 + 50)
Private Const MAX_IP_STATUS As Long = (11000 + 50)
Private Const IP_PENDING As Long = (11000 + 255)
Private Const PING_TIMEOUT As Long = 500
Private Const WS_VERSION_REQD As Long = &H101
Private Const MIN_SOCKETS_REQD As Long = 1
Private Const SOCKET_ERROR As Long = -1
Private Const INADDR_NONE As Long = &HFFFFFFFF
Private Const MAX_WSADescription As Long = 256
Private Const MAX_WSASYSStatus As Long = 128
  
'Type de données Winsock Private Type WSADATA wVersion As Integer
wHighVersion As Integer
szDescription(0 To MAX_WSADescription) As Byte
szSystemStatus(0 To MAX_WSASYSStatus) As Byte
wMaxSockets As Long
wMaxUDPDG As Long
dwVendorInfo As Long
End Type 'type d'options ICMP
Private Type ICMP_OPTIONS
Ttl As Byte 'Time to live
Tos As Byte
Flags As Byte 'options
OptionsSize As Byte
OptionsData As Long
End Type 
'Packet de reponse ICMP
Public Type ICMP_ECHO_REPLY
Address As Long
status As Long
RoundTripTime As Long
DataSize As Long
'Reserved As Integer --> prévu mais pas encore implementé???
DataPointer As Long
Options As ICMP_OPTIONS Data As String * 250 End Type
'Type adresse
Private Type HOSTENT
hName As Long 'nom
hAliases As Long 'alias
hAddrType As Integer 'type adresse 
hLen As Integer 'longueur --> IP6 supporté???
hAddrList As Long
End Type
'GetHostByName --> cette fonction va nous permettre de résoudre le nom d'hote en adresse IP Private Declare Function gethostbyname Lib "wsock32" _
(ByVal hostname As String) As Long
'Fonction de copie memoire de la librairie Kernel Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(xDest As Any, _
xSource As Any, _
ByVal nbytes As Long) 'fonction longueur String du Kernel
Private Declare Function lstrlenA Lib "kernel32" _
(lpString As Any) As Long
'demarrage du Winsock 
Private Declare Function WSAStartup Lib "wsock32" _
(ByVal wVersionRequired As Long, _
lpWSADATA As WSADATA) As Long
'fonction de nettoyage du protocole Winsock pour eviter les conflits possibles et etre propre Private Declare Function WSACleanup Lib "wsock32" () As Long
'ouverture d'un port virtuel ICMP Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
'fermeture du handle ICMP Private Declare Function IcmpCloseHandle Lib "icmp.dll" _
(ByVal IcmpHandle As Long) As Long

'envoi du packet echo Private Declare Function IcmpSendEcho Lib "icmp.dll" _
(ByVal IcmpHandle As Long, _
ByVal DestinationAddress As Long, _
ByVal RequestData As String, _
ByVal RequestSize As Long, _
ByVal RequestOptions As Long, _
ReplyBuffer As ICMP_ECHO_REPLY, _
ByVal ReplySize As Long, _
ByVal Timeout As Long) As Long

'Fonction permettant la conversion en representation longue de l'Adresse IP Private Declare Function inet_addr Lib "wsock32" _
(ByVal s As String) As Long
'Ici se terminent les declarations de fonctions 'maintenant, on va faire une fonction ping plus utilisable :o) Public Function Ping(sAddress As String, _
sDataToSend As String, _
ECHO As ICMP_ECHO_REPLY) As Long 'Si le ping réussit, le resultat va contenir les données suivantes:
'.RoundTripTime = temps d'aller-retour en millisecondes
'.Data = données retournées (les memes qu'on a envoyé en principe) terminé par Null
'.Address = adresse IP qui a veritablement repondu (alias possibles)
'.DataSize = sizeOf(.data)
'.Status = 0 si le ping a réussi
'Si le ping echoue le .ping contiendra le code d'erreur
Dim hPort As Long
Dim dwAddress As Long
'conversion de l'adresse au format quad long
dwAddress = inet_addr(sAddress)
'si dwAdresse est invalide, la constante INADDR_NONE est retournée
If dwAddress <> INADDR_NONE Then
'ouverture d'un port ICMP
hPort = IcmpCreateFile()
'et si ca marche, on lance l'echo.
If hPort Then
Call IcmpSendEcho(hPort, _
dwAddress, _
sDataToSend, _
Len(sDataToSend), _
0, _
ECHO, _
Len(ECHO), _
PING_TIMEOUT) 'on recupere le statut pour voir si on a réussi Ping = ECHO.status 
'Fermeture du port virtuel ICMP
Call IcmpCloseHandle(hPort)
End If 'se rapportant au "If hPort"
Else:
'l'adresse a été mal specifiée
Ping = INADDR_NONE
End If 'se rapportant au If dwAddress <> INADDR_NONE
End Function
'cette fonction va nous permettre de determiner la réussite ou non du ping, 'et le cas écheant de trouver l'erreur...
Public Function GetStatusCode(status As Long) As String
Dim msg As String
Select Case status
Case IP_SUCCESS: msg = "ip success"
Case INADDR_NONE: msg = "inet_addr: bad IP format"
Case IP_BUF_TOO_SMALL: msg = "ip buf too_small"
Case IP_DEST_NET_UNREACHABLE: msg = "ip dest net unreachable"
Case IP_DEST_HOST_UNREACHABLE: msg = "ip dest host unreachable"
Case IP_DEST_PROT_UNREACHABLE: msg = "ip dest prot unreachable"
Case IP_DEST_PORT_UNREACHABLE: msg = "ip dest port unreachable"
Case IP_NO_RESOURCES: msg = "ip no resources"
Case IP_BAD_OPTION: msg = "ip bad option"
Case IP_HW_ERROR: msg = "ip hw_error"
Case IP_PACKET_TOO_BIG: msg = "ip packet too_big"
Case IP_REQ_TIMED_OUT: msg = "ip req timed out"
Case IP_BAD_REQ: msg = "ip bad req"
Case IP_BAD_ROUTE: msg = "ip bad route"
Case IP_TTL_EXPIRED_TRANSIT: msg = "ip ttl expired transit"
Case IP_TTL_EXPIRED_REASSEM: msg = "ip ttl expired reassem"
Case IP_PARAM_PROBLEM: msg = "ip param_problem"
Case IP_SOURCE_QUENCH: msg = "ip source quench"
Case IP_OPTION_TOO_BIG: msg = "ip option too_big"
Case IP_BAD_DESTINATION: msg = "ip bad destination"
Case IP_ADDR_DELETED: msg = "ip addr deleted"
Case IP_SPEC_MTU_CHANGE: msg = "ip spec mtu change"
Case IP_MTU_CHANGE: msg = "ip mtu_change"
Case IP_UNLOAD: msg = "ip unload"
Case IP_ADDR_ADDED: msg = "ip addr added"
Case IP_GENERAL_FAILURE: msg = "ip general failure"
Case IP_PENDING: msg = "ip pending"
Case PING_TIMEOUT: msg = "ping timeout"
Case Else: msg = "unknown msg returned"
End Select
GetStatusCode = CStr(status) & " [ " & msg & " ]"
End Function 

'conversion nom d'hote --> adresse IP Public Function GetIPFromHostName(ByVal sHostName As String) As String
Dim nbytes As Long
Dim ptrHosent As Long 'pointeur vers la structure "adresse hote"
Dim ptrName As Long 'pointeur vers le Nom d'hote
Dim ptrAddress As Long 'adresse du pointeur adresse (vous ne comprenez rien? Vous etes pas le seul! :o)
Dim ptrIPAddress As Long 'pointeur vers l'adresse IP
Dim sAddress As String
sAddress = Space$(4) ptrHosent = gethostbyname(sHostName & vbNullChar) If ptrHosent <> 0 Then
'on assigne l'adresse et l'offset du pointeur
'ptrName est le nom officiel de l'hote
ptrName = ptrHosent
'liste des adresses de l'hote terminée par un Null
'l'adresse est à 12 octets du demarrage...
ptrAddress = ptrHosent + 12
'on recupere l'adresse IP
CopyMemory ptrName, ByVal ptrName, 4
CopyMemory ptrAddress, ByVal ptrAddress, 4
CopyMemory ptrIPAddress, ByVal ptrAddress, 4
CopyMemory ByVal sAddress, ByVal ptrIPAddress, 4
GetIPFromHostName = IPToText(sAddress)
End If
End Function
'fonction permettant de convertir une IP en txt
Private Function IPToText(ByVal IPAddress As String) As String IPToText = CStr(Asc(IPAddress)) & "." & _
CStr(Asc(Mid$(IPAddress, 2, 1))) & "." & _
CStr(Asc(Mid$(IPAddress, 3, 1))) & "." & _
CStr(Asc(Mid$(IPAddress, 4, 1)))
End Function 'routine de nettoyage du socket
Public Sub SocketsCleanup()
If WSACleanup() <> 0 Then
MsgBox "Erreur lors du nettoyage du socket.", vbCritical
End If
End Sub
'Procedure d'initialisation du socket
Public Function SocketsInitialize() As Boolean
Dim WSAD As WSADATA
SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
End Function
'FIN DU MODULE DE CODE

4. Comment utiliser ce code?▲

Une fois qu'on a tout ce code, on va faire un petit exemple d'application.
Créez un Exe Standard VB et placez dans le formulaire:

Un bouton de commande (Command1)
Trois champs de texte nommés Text1,Text2 et Text3
Un tableau de six champs de texte (de Text4(0) à Text4(5))

Les correspondances entre les résultats et les champs sont décrits sur cette image:

Image non disponible

Puis, ajoutez dans la section Général --> Déclarations du formulaire le code suivant:

Cacher/Afficher le codeSélectionnez

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.

Option Explicit


Private Sub Command1_Click()


   Dim ECHO As ICMP_ECHO_REPLY
   Dim pos As Long
   Dim success As Long
   Dim sIPAddress As String
   
   If SocketsInitialize() Then 'si le socket est a été  correctement initalisé


     'Conversion du nom d'hote en IP
      sIPAddress = GetIPFromHostName(Text1.Text)
      Text2.Text = sIPAddress
      
     'on effecture le ping à l'adresse indiquée
      success = Ping(sIPAddress, (Text3.Text), ECHO)
      
     'affichage des résultats
      Text4(0).Text = GetStatusCode(success)
      Text4(1) = ECHO.Address
      Text4(2) = ECHO.RoundTripTime & " ms"
      Text4(3) = ECHO.DataSize & " bytes"
      
      If Left$(ECHO.Data, 1) <> Chr$(0) Then
         pos = InStr(ECHO.Data, Chr$(0))
         Text4(4) = Left$(ECHO.Data, pos - 1)
      End If
   
      Text4(5) = ECHO.DataPointer
      'Nettoyage      
      SocketsCleanup
      
   Else
   ' GROS probleme système!
        MsgBox "Windows Sockets for 32 bit Windows ne répond pas.", vbCritical
   
   End If
   
End Sub
'Fin du code formulaire

Entrez un nom (ex. "www.google.fr" dans le champ text1), cliquez, et admirez le résultat!

Voilà, maintenant vous savez faire un ping sur une machine! C'est-y pas merveilleux??? :o)

Bon, c'est un peu compliqué, mais le copier-coller est là pour ça...

Note ultra-importante: Beaucoup d'administrateurs désactivent le ping sur leurs machines pour éviter les attaques DoS de type flood. Par conséquent, le code (aussi bien que la commande ping traditionnelle) ne recevra pas de réponse de ce genre de serveurs.

Télécharger le projet exemple (ExemplePing.zip, 5.5ko)

Ce code a été testé sous Win98, NT4, 2000 et XP Pro sans problèmes...

Copyright © 2003 Alexandre Lokchine. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.