je suis en Windows NT4, et dans unn programme en vb la=20
fonction gethostbyname me retourne une Adresse IP=20
a "0.0.0.0", pour un nom poste pass=E9 en argument???
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
ng
Salut,
Peut-on voir le code source ?
-- Nicolas G. FAQ VB : http://faq.vb.free.fr API Guide : http://www.allapi.net Google Groups : http://groups.google.fr/ MZ-Tools : http://www.mztools.com/
"" a écrit dans le message de news: 13c4a01c3f7a2$eb835040$ je suis en Windows NT4, et dans unn programme en vb la fonction gethostbyname me retourne une Adresse IP a "0.0.0.0", pour un nom poste passé en argument???
Salut,
Peut-on voir le code source ?
--
Nicolas G.
FAQ VB : http://faq.vb.free.fr
API Guide : http://www.allapi.net
Google Groups : http://groups.google.fr/
MZ-Tools : http://www.mztools.com/
"bruno.maignan@ca-atlantica.fr" <anonymous@discussions.microsoft.com> a
écrit dans le message de news: 13c4a01c3f7a2$eb835040$a601280a@phx.gbl...
je suis en Windows NT4, et dans unn programme en vb la
fonction gethostbyname me retourne une Adresse IP
a "0.0.0.0", pour un nom poste passé en argument???
-- Nicolas G. FAQ VB : http://faq.vb.free.fr API Guide : http://www.allapi.net Google Groups : http://groups.google.fr/ MZ-Tools : http://www.mztools.com/
"" a écrit dans le message de news: 13c4a01c3f7a2$eb835040$ je suis en Windows NT4, et dans unn programme en vb la fonction gethostbyname me retourne une Adresse IP a "0.0.0.0", pour un nom poste passé en argument???
'Voici le code source : 'La function pour effectuer le test : Test_GetHostByName() 'et la fonction ou il y a le problème : GetIPofHost()
DefLng A-Z Option Explicit
'Déclaration pour créer un paquet ICMP d'echo Private Type ip_option_information 'structure envoyé TTL As Integer 'TimeToLive, nombre de saut d'hôtes Tos As Byte 'Type de service Flags As Byte 'nb flag OptionsSize As Byte 'Taille en byte des datas OptionsData As Long 'Pointeur vers des datas End Type
Private Type icmp_echo_reply 'structure en réponse Address As Long 'Retourne l'adresse Status As Long 'Retourne IP_STATUS RoundTripTime As Long 'RTT en ms DataSize As Integer 'Retourne la taille des données Reserved As Integer 'Reservé à une utilisation système... DataPointer As Long 'Pointeur vers le buffer retournée Options As ip_option_information 'option de retour Data As String * 10000 'buffer : en cas d'erreur 11001, l'agrandir 'note : le buffer contient les données type string qui ont été envoyé pour faire l'echo, 'c'est-à-dire "PINGECHOICMPTEST" si un ping est envoyé avec EasyPing() End Type
'API de icmp.dll utilisé Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal IcmpHandle As Long) As Long Private Declare Function IcmpSendEcho Lib "icmp.dll" (ByVal IcmpHandle As Long, ByVal DestinationAddress As Long, ByVal RequestData As String, ByVal RequestSize As Integer, RequestOptions As ip_option_information , ReplyBuffer As icmp_echo_reply, ByVal ReplySize As Long, ByVal Timeout As Long) As Long
Private Type tagWSAData wVersion As Integer wHighVersion As Integer szDescription As String * WSADESCRIPTION_LEN_1 szSystemStatus As String * WSASYSSTATUS_LEN_1 iMaxSockets As Integer iMaxUdpDg As Integer lpVendorInfo As String * 200 End Type
Private Declare Function WSAStartup Lib "WSOCK32" (ByVal wVersionRequested As Integer, lpWSADATA As tagWSAData) As Integer Private Declare Function WSACleanup Lib "WSOCK32" () As Integer
'Déclaration pour convertir un nom de domaine en adresse IP Private Type HOSTENT hName As Long 'pointeur vers le premier nom de domaine de la machine (s'il y en a plusieurs rattaché) ~FQDN hAliases As Long 'pointeurs vers les autres noms de domaine hAddrType As Integer 'type d'adresse retournée hLen As Integer 'longueur de l'adresse retournée hAddrList As Long 'pointeur vers l'adresse End Type
Private Declare Function gethostbyname Lib "WSOCK32" (ByValszHost As String) As Long Private Declare Function gethostbyaddr Lib "WSOCK32" (haddr As Long, ByVal hnlen As Long, ByVal addrtype As Long) As Long Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Public autrIP(25) As Long 'liste interne des IP possible d'un hôte Public autrIPCnt As Long
'Déclarations pour conversion IP 32bits <> strings Private Declare Function inet_ntoa Lib "wsock32.dll" (ByVal inn As Long) As Long Private Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long Private Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Any) As Long
'======================== ================== ' FONCTIONS DE CONVERSION IP$ <> IP <> DNS '======================== ================== Function GetIPofHost(NomH As String) As Long 'GetIPofHost renvoie l'adresse IP type Long IPv4 d'une machine 'paramètre : 'NomH : nom DNS de la machine, exemple : www.google.com Dim exeAPI As Long, i Dim HostInfo As HOSTENT Dim IPv4Adr As Long Dim SockStart As Long Dim SockInf As tagWSAData
SockStart = WSAStartup(&H101, SockInf) 'ouvre un socket 'Voici le pb car gethostbyname retourne 0 exeAPI = gethostbyname(NomH) 'recupère le pointeur vers un HOSTENT SockStart = WSACleanup() 'ferme le socket
If exeAPI > 0 Then 'pour récupérer des valeurs dont on ne connais que le pointeur, on utilise 'RtlMoveMemory RtlMoveMemory HostInfo, exeAPI, ByVal (LenB (HostInfo)) RtlMoveMemory exeAPI, ByVal HostInfo.hAddrList, 4 RtlMoveMemory IPv4Adr, ByVal exeAPI, HostInfo.hLen GetIPofHost = IPv4Adr autrIP(0) = IPv4Adr
For i = 1 To 25 'on cherche jusqu'a 25 autres IP pour la même machine RtlMoveMemory exeAPI, ByVal HostInfo.hAddrList + (i * 4), 4
If exeAPI <> 0 Then RtlMoveMemory IPv4Adr, ByVal exeAPI, HostInfo.hLen autrIP(i) = IPv4Adr Else autrIPCnt = i Exit For End If
Next i
Else 'erreur : l'hôte n'a pas d'IP. GetIPofHost = 0 End If
End Function
Function GetHostofIP(IPAdr As Long) As String 'GetIPofHost renvoie le premier nom DNS d'une machine dont on connais l'IP 'paramètre : 'IPAdr : adresse IP de la machine, type Long IPv4 Dim exeAPI As Long Dim HostInfo As HOSTENT Dim TmpNm As String * 255 'tampon reçevant le nom de domaine Dim SockStart As Long Dim SockInf As tagWSAData
SockStart = WSAStartup(&H101, SockInf) 'ouvre un socket exeAPI = gethostbyaddr(IPAdr, Len(IPAdr), 2) 'récupère le pointeur vers un HOSTENT SockStart = WSACleanup() 'ferme le socket
If exeAPI <> 0 Then RtlMoveMemory HostInfo, exeAPI, ByVal (LenB (HostInfo)) RtlMoveMemory ByVal TmpNm, HostInfo.hName, 255 'le nom de domaine se termine par un &H00&, mais à cause que l'on alloue 255 octets, il y a 'plein de vide, donc cela nécessite deux traitement. If InStr(1, TmpNm, Chr$(0)) > 0 Then TmpNm = Left$(TmpNm, InStr(1, TmpNm, Chr$(0))) GetHostofIP = Trim$(TmpNm)
Else 'erreur : l'IP n'a pas de nom DNS GetHostofIP = "" End If
End Function
Function GetIPbinaryVal(ByVal IPAdr As String) As Long 'GetIpbinaryVal converti une adresse IP type string (a.b.c.d) en type Long 32-bits IPv4 'API Powa :)
GetIPbinaryVal = inet_addr(IPAdr)
End Function
Function GetIPstringVal(IPlng As Long) As String 'GetIPstringVal renvoie une valeur string "a.b.c.d" a partir d'une valeur IP Long 32-bits IPv4 Dim lpStr As Long, Strl As Long, BufStr As String * 32
lpStr = inet_ntoa(IPlng) If lpStr = 0 Then GetIPstringVal = "255.255.255.255" Else Strl = lstrlenA(lpStr) If Strl > 32 Then Strl = 32 RtlMoveMemory ByVal BufStr, lpStr, Strl GetIPstringVal = Left$(BufStr, InStr(1, BufStr, Chr$(0)) - 1) End If
End Function
Function GetIPofCible(Cible As String) As Long 'Fonction renvoyant l'adresse IP de la cible, peu importe si la Cible est une IP ou un nom de domaine 'paramètre : 'Cible : nom de domaine ou adresse IP 'donnée retournée : 'GetIPofCible : renvoie la valeur Long IPv4 de l'IP de la cible Dim TmIP As Long
'PS : 16 octets car Len("xxx.xxx.xxx.xxx") = 15 If Len(Cible) < 16 Then TmIP = GetIPbinaryVal(Cible) If TmIP <= 0 Then TmIP = GetIPofHost(Cible) End If Else TmIP = GetIPofHost(Cible) End If
GetIPofCible = TmIP
End Function
'======================== === ' FONCTION ENVOYANT LE PING '======================== === Function GetEcho(AdrIP As Long, RTT As Long, TTL As Long, DtSend As String, ByRef PingStat As icmp_echo_reply) As Long 'GetEcho : envoie un Ping et le récupère 'paramètres : 'AdrIP : adresse IP Type Long IPv4 de la destination 'RTT : durée en millisecondes du temps d'attente de l'echo, max 32767 'TTL : nombre de saut d'hôtes à faire 'DtSend : chaine de caractère qui sera envoyé dans le paquet ICMP 'données retournées : 'GetEcho : valeur en milliseconde du trajet, -1 si timeout, -2 si problème de socket 'PingStat : type icmp_echo_reply, pour gérer le resultat dans un autre sub
Dim hICMP As Long Dim exeAPI As Long Dim PingSet As ip_option_information Dim PingGet As icmp_echo_reply Dim pWsaData As tagWSAData Dim SockState As Long
'définition du TTL du ping PingSet.TTL = TTL 'anti-erreur : traitement du RTT RTT = Abs(RTT) If RTT > 32767 Then RTT = 32767
'création d'un socket SockState = WSAStartup(&H101, pWsaData)
If SockState = SOCKET_ERROR Then 'en cas d'erreur de création du socket, quitter GetEcho = -2 Exit Function End If
'ouvre un handle ICMP hICMP = IcmpCreateFile() 'envoie d'un paquet ICMP d'echo - et réception par la même occasion exeAPI = IcmpSendEcho(hICMP, AdrIP, DtSend, Len (DtSend), PingSet, PingGet, Len(PingGet), RTT)
PingStat = PingGet
'ferme le handle ICMP exeAPI = IcmpCloseHandle(hICMP) 'ferme le socket SockState = WSACleanup()
End Function
'======================== ===== ' FONCTION DE GESTION DU PING '======================== ===== Function GesPing(ByRef PingEcho As icmp_echo_reply, AdrRet As Long) As Long 'Fonction de gestion du résultat du ping 'paramètre : 'PingEcho : un pointeur vers une variable de type icmp_echo_reply, résultat d'un ping 'données retournées : 'GesPing : durée en millisecondes du ping, ou -1 en cas de timeout, ou -2 en cas de problème de ' paramètres (genre ttl=0), -3 en cas de taille de tampon trop grosse. 'AdrRet : en cas de TTL expiré, renvoi l'adresse de l'hôte atteint, sinon 0
'gestion du retour (ajouté dans la màj du 24 mai 2002) 'attention, la plupart des messages ne concerne pas l'ICMP echo Select Case PingEcho.Status Case 0 'ip réalisé avec succès GesPing = PingEcho.RoundTripTime AdrRet = 0 Case 11001 'buffer de retour trop petit - erreur dû à VB n'autorisant pas un tampon de plus de 10000 octets GesPing = -3 Case 11002 'destination inatteignable Case 11003 'hôte inatteignable Case 11004 'protocole inaccessible Case 11005 'port inaccessible Case 11006 'pas de ressources Case 11007 'mauvais paramètres - vérifer le TTL GesPing = -2 Case 11008 'problème matériel Case 11009 'paquet trop gros Case 11010 'timeout GesPing = -1 AdrRet = 0 Case 11011 'mauvaise requête Case 11012 'mauvaise route Case 11013 'temps de transit expiré (ttl trop petit) GesPing = PingEcho.RoundTripTime AdrRet = PingEcho.Address Case 11014 'ttl trop petit pour le réassemblement Case 11015 'problème de paramètre Case 11016 'source arreté Case 11017 'trop d'options Case 11018 'mauvaise destination Case 11019 'adresse supprimé Case 11020 'changement de MTU nécessaire Case 11021 'changement MTU effectué Case 11022 'déchargement de la mémoire Case 11023 'adresse rajouté Case 11050 'defaillance générale Case 11255 'en suspend End Select
End Function
'======================== ================== ' FONCTIONS SIMPLIFIE ou PRE-CODE ' (vous pouvez les supprimer de ce module) '======================== ================== Function EasyPing(ByVal Adresse As String) As String 'Fonction d'envoie de ping simplifié. 'paramètre : 'Adresse : adresse IP de type "a.b.c.d" ou nom de domaine de la cible 'donnée retournée : 'StandardPing : renvoie une chaine de caractère avec soit "n ms" soit "Timeout" Dim Rping As icmp_echo_reply Dim BadAdr As Long Dim Tp As Long
Select Case Tp Case -3 EasyPing = "SZErr" Case -2 EasyPing = "Err" Case -1 EasyPing = "Timeout" Case Else EasyPing = Tp & " ms" End Select
End Function
Function IncrTracert(ByVal Adresse As String, ByVal TTL As Long, ByRef HoteRTT As Long) As String 'Fonction à utiliser pour faire un traceroute vers la machine Adresse 'paramètre : 'Adresse : adresse IP de type "a.b.c.d" ou nom de domaine de la cible à traçer 'TTL : valeur à incrémenter a partir de 0 jusqu'a ce que IncrTracert = Adresse 'données retournées : 'IncrTracert : adresse IP de l'hôte numéro "TTL" 'HoteRTT : durée, en millisecondes, de l'echo vers cet hôte; non formaté
Dim Ptmp As icmp_echo_reply Dim HotAddr As Long Dim EchoMS As Long
If HotAddr <> 0 Then IncrTracert = GetIPstringVal(HotAddr) Else IncrTracert = AlwaysGetIP(Adresse) End If
HoteRTT = EchoMS
End Function
Function GetNbHope(Adresse As String) As Long 'Fonction renvoyant le nombre de "saut" (ou de machines) nécessaire pour aller jusqu'à la cible 'Code de Proger - code à usage déconseillé (gaspillage de temps pour faire un traceroute interne) 'paramètre : 'Adresse : adresse IP de type "a.b.c.d" de la cible 'donnée retournée : 'EasyNbHope : nombre de saut Dim TPng As icmp_echo_reply Dim HopeAddr As Long Dim HopeEcho As Long Dim i As Long
For i = 0 To 255 DoEvents 'permet à votre machine de "souffler un peu" entre chaque recherche de saut 'HopeAddr = IncrTracert(Adresse, i, HopeEcho) HopeEcho = GetEcho(GetIPbinaryVal(Adresse), 10&, i, "PINGECHO", TPng) HopeEcho = GesPing(TPng, HopeAddr) If HopeAddr = Adresse Then Exit For Next i
GetNbHope = i
End Function
Function AlwaysGetDNS(ByVal Nval As String) As String 'Fonction renvoyant toujours le nom de domaine, peu importe si le paramètre d'entrée ' est un nom de domaine ou une IP
AlwaysGetDNS = GetHostofIP(GetIPofCible(Nval))
End Function
Function AlwaysGetIP(ByVal Nval As String) As String 'Fonction renvoyant toujours l'IP de la machine, peu importe si le paramètre d'entrée ' est un nom de domaine ou une IP
AlwaysGetIP = GetIPstringVal(GetIPofCible(Nval))
End Function
'Sub ExempleDeTraceRoute(ByVal LaCible As String, ByVal MaxSaut As Long, OutListe As ListBox) ''DEMONSTRATION : réalise un traceroute vers la machine LaCible (défini avec son ip ou dnsname) ''Code de Proger - usage déconseillé (la présentation dans une ListBox, c'est pas top) ''Paramètre : ''LaCible : adresse IP de type "a.b.c.d" ou nom de domaine de la cible à traçer ''MaxSaut : nombre d'hôtes qui seront parcourus avant d'abandonner le traçage. 30 est une bonne valeur. ''OutListe : nom d'un objet ListBox (liste déroulante standard) de sortie ' 'Dim TraceChaine As String 'Dim OutPchaine As String 'Dim RTTofSaut As Long 'Dim RTTstr As String 'Dim i As Long ' ' OutListe.Clear ' OutListe.FontName = "Courier New" 'police à chasse fixe ' ' For i = 1 To MaxSaut ' ' OutPchaine = IncrTracert(LaCible, i, RTTofSaut) ' ' Select Case RTTofSaut 'formatage en string de la durée de l'echo ' Case -3 ' RTTstr = "SZErr" ' Case -2 ' RTTstr = "Err!" ' Case -1 ' RTTstr = "Timeout" ' Case Else ' RTTstr = RTTofSaut & " ms" ' End Select ' ' 'formatage de la chaine de sortie du traçage. La fonction String() permet de générer des caractères ' ' espace (" ") pour simuler des colonnes dans la liste. ' TraceChaine = i & String$(4 - Len(CStr(i)), " ") & RTTstr & String$(8 - Len(RTTstr), " ") & OutPchaine & String$(16 - Len(OutPchaine), " ") & AlwaysGetDNS (OutPchaine) ' OutListe.AddItem TraceChaine ' OutListe.ListIndex = i - 1 'avance du curseur ' DoEvents 'laisse windows afficher le contenu de la liste ' ' If GetIPbinaryVal(OutPchaine) = GetIPofCible (LaCible) Then Exit For 'permet de savoir si on a atteint la cible ' ' Next i ' 'End Sub
Function PingDef(Adresse As String, SzPing As Long, Optional sTTL As Long) As String 'Fonction ajouté dans la mise à jour du 24 mai 2002 'Ping simplifié, avec comme paramètre obligatoire la taille du "tampon" 'et comme paramètre optionnel le TTL de l'echo
Dim TmpPng As icmp_echo_reply Dim BadAdr As Long Dim Tp As Long
Select Case Tp Case -3 PingDef = "SZErr" Case -2 PingDef = "Err" Case -1 PingDef = "Timeout" Case Else PingDef = Tp & " ms" End Select
End Function
Function Test_GetHostByName()
Dim Nom_Poste As String Dim Adresse_IP As String
'Mettre le nom du Poste Nom_Poste = "NS572102"
Adresse_IP = AlwaysGetIP(Nom_Poste)
MsgBox Adresse_IP
End Function
'Voici le code source :
'La function pour effectuer le test : Test_GetHostByName()
'et la fonction ou il y a le problème : GetIPofHost()
DefLng A-Z
Option Explicit
'Déclaration pour créer un paquet ICMP d'echo
Private Type ip_option_information 'structure envoyé
TTL As Integer 'TimeToLive, nombre de
saut d'hôtes
Tos As Byte 'Type de service
Flags As Byte 'nb flag
OptionsSize As Byte 'Taille en byte des datas
OptionsData As Long 'Pointeur vers des datas
End Type
Private Type icmp_echo_reply 'structure en réponse
Address As Long 'Retourne l'adresse
Status As Long 'Retourne IP_STATUS
RoundTripTime As Long 'RTT en ms
DataSize As Integer 'Retourne la taille des
données
Reserved As Integer 'Reservé à une utilisation
système...
DataPointer As Long 'Pointeur vers le buffer
retournée
Options As ip_option_information 'option de retour
Data As String * 10000 'buffer : en cas d'erreur
11001, l'agrandir
'note : le buffer contient les données type string qui
ont été envoyé pour faire l'echo,
'c'est-à-dire "PINGECHOICMPTEST" si un ping est envoyé
avec EasyPing()
End Type
'API de icmp.dll utilisé
Private Declare Function IcmpCreateFile Lib "icmp.dll" ()
As Long
Private Declare Function IcmpCloseHandle Lib "icmp.dll"
(ByVal IcmpHandle As Long) As Long
Private Declare Function IcmpSendEcho Lib "icmp.dll"
(ByVal IcmpHandle As Long, ByVal DestinationAddress As
Long, ByVal RequestData As String, ByVal RequestSize As
Integer, RequestOptions As ip_option_information ,
ReplyBuffer As icmp_echo_reply, ByVal ReplySize As Long,
ByVal Timeout As Long) As Long
Private Type tagWSAData
wVersion As Integer
wHighVersion As Integer
szDescription As String * WSADESCRIPTION_LEN_1
szSystemStatus As String * WSASYSSTATUS_LEN_1
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As String * 200
End Type
Private Declare Function WSAStartup Lib "WSOCK32" (ByVal
wVersionRequested As Integer, lpWSADATA As tagWSAData) As
Integer
Private Declare Function WSACleanup Lib "WSOCK32" () As
Integer
'Déclaration pour convertir un nom de domaine en adresse IP
Private Type HOSTENT
hName As Long 'pointeur vers le premier nom de domaine
de la machine (s'il y en a plusieurs rattaché) ~FQDN
hAliases As Long 'pointeurs vers les autres noms de
domaine
hAddrType As Integer 'type d'adresse retournée
hLen As Integer 'longueur de l'adresse retournée
hAddrList As Long 'pointeur vers l'adresse
End Type
Private Declare Function gethostbyname Lib "WSOCK32"
(ByValszHost As String) As Long
Private Declare Function gethostbyaddr Lib "WSOCK32"
(haddr As Long, ByVal hnlen As Long, ByVal addrtype As
Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest
As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Public autrIP(25) As Long 'liste interne des IP possible
d'un hôte
Public autrIPCnt As Long
'Déclarations pour conversion IP 32bits <> strings
Private Declare Function inet_ntoa Lib "wsock32.dll"
(ByVal inn As Long) As Long
Private Declare Function inet_addr Lib "wsock32.dll"
(ByVal cp As String) As Long
Private Declare Function lstrlenA Lib "kernel32" (ByVal
lpString As Any) As Long
'======================== ==================
' FONCTIONS DE CONVERSION IP$ <> IP <> DNS
'======================== ==================
Function GetIPofHost(NomH As String) As Long
'GetIPofHost renvoie l'adresse IP type Long IPv4 d'une
machine
'paramètre :
'NomH : nom DNS de la machine, exemple : www.google.com
Dim exeAPI As Long, i
Dim HostInfo As HOSTENT
Dim IPv4Adr As Long
Dim SockStart As Long
Dim SockInf As tagWSAData
SockStart = WSAStartup(&H101, SockInf) 'ouvre un
socket
'Voici le pb car gethostbyname retourne 0
exeAPI = gethostbyname(NomH) 'recupère le
pointeur vers un HOSTENT
SockStart = WSACleanup() 'ferme le
socket
If exeAPI > 0 Then
'pour récupérer des valeurs dont on ne connais que
le pointeur, on utilise
'RtlMoveMemory
RtlMoveMemory HostInfo, exeAPI, ByVal (LenB
(HostInfo))
RtlMoveMemory exeAPI, ByVal HostInfo.hAddrList, 4
RtlMoveMemory IPv4Adr, ByVal exeAPI, HostInfo.hLen
GetIPofHost = IPv4Adr
autrIP(0) = IPv4Adr
For i = 1 To 25 'on cherche jusqu'a 25 autres IP
pour la même machine
RtlMoveMemory exeAPI, ByVal HostInfo.hAddrList
+ (i * 4), 4
If exeAPI <> 0 Then
RtlMoveMemory IPv4Adr, ByVal exeAPI,
HostInfo.hLen
autrIP(i) = IPv4Adr
Else
autrIPCnt = i
Exit For
End If
Next i
Else
'erreur : l'hôte n'a pas d'IP.
GetIPofHost = 0
End If
End Function
Function GetHostofIP(IPAdr As Long) As String
'GetIPofHost renvoie le premier nom DNS d'une machine dont
on connais l'IP
'paramètre :
'IPAdr : adresse IP de la machine, type Long IPv4
Dim exeAPI As Long
Dim HostInfo As HOSTENT
Dim TmpNm As String * 255 'tampon reçevant le nom de
domaine
Dim SockStart As Long
Dim SockInf As tagWSAData
SockStart = WSAStartup(&H101, SockInf) 'ouvre un
socket
exeAPI = gethostbyaddr(IPAdr, Len(IPAdr), 2) 'récupère
le pointeur vers un HOSTENT
SockStart = WSACleanup() 'ferme le socket
If exeAPI <> 0 Then
RtlMoveMemory HostInfo, exeAPI, ByVal (LenB
(HostInfo))
RtlMoveMemory ByVal TmpNm, HostInfo.hName, 255
'le nom de domaine se termine par un &H00&, mais à
cause que l'on alloue 255 octets, il y a
'plein de vide, donc cela nécessite deux
traitement.
If InStr(1, TmpNm, Chr$(0)) > 0 Then TmpNm =
Left$(TmpNm, InStr(1, TmpNm, Chr$(0)))
GetHostofIP = Trim$(TmpNm)
Else
'erreur : l'IP n'a pas de nom DNS
GetHostofIP = ""
End If
End Function
Function GetIPbinaryVal(ByVal IPAdr As String) As Long
'GetIpbinaryVal converti une adresse IP type string
(a.b.c.d) en type Long 32-bits IPv4
'API Powa :)
GetIPbinaryVal = inet_addr(IPAdr)
End Function
Function GetIPstringVal(IPlng As Long) As String
'GetIPstringVal renvoie une valeur string "a.b.c.d" a
partir d'une valeur IP Long 32-bits IPv4
Dim lpStr As Long, Strl As Long, BufStr As String * 32
lpStr = inet_ntoa(IPlng)
If lpStr = 0 Then
GetIPstringVal = "255.255.255.255"
Else
Strl = lstrlenA(lpStr)
If Strl > 32 Then Strl = 32
RtlMoveMemory ByVal BufStr, lpStr, Strl
GetIPstringVal = Left$(BufStr, InStr(1, BufStr,
Chr$(0)) - 1)
End If
End Function
Function GetIPofCible(Cible As String) As Long
'Fonction renvoyant l'adresse IP de la cible, peu importe
si la Cible est une IP ou un nom de domaine
'paramètre :
'Cible : nom de domaine ou adresse IP
'donnée retournée :
'GetIPofCible : renvoie la valeur Long IPv4 de l'IP de la
cible
Dim TmIP As Long
'PS : 16 octets car Len("xxx.xxx.xxx.xxx") = 15
If Len(Cible) < 16 Then
TmIP = GetIPbinaryVal(Cible)
If TmIP <= 0 Then
TmIP = GetIPofHost(Cible)
End If
Else
TmIP = GetIPofHost(Cible)
End If
GetIPofCible = TmIP
End Function
'======================== ===
' FONCTION ENVOYANT LE PING
'======================== ===
Function GetEcho(AdrIP As Long, RTT As Long, TTL As Long,
DtSend As String, ByRef PingStat As icmp_echo_reply) As
Long
'GetEcho : envoie un Ping et le récupère
'paramètres :
'AdrIP : adresse IP Type Long IPv4 de la destination
'RTT : durée en millisecondes du temps d'attente de
l'echo, max 32767
'TTL : nombre de saut d'hôtes à faire
'DtSend : chaine de caractère qui sera envoyé dans le
paquet ICMP
'données retournées :
'GetEcho : valeur en milliseconde du trajet, -1 si
timeout, -2 si problème de socket
'PingStat : type icmp_echo_reply, pour gérer le resultat
dans un autre sub
Dim hICMP As Long
Dim exeAPI As Long
Dim PingSet As ip_option_information
Dim PingGet As icmp_echo_reply
Dim pWsaData As tagWSAData
Dim SockState As Long
'définition du TTL du ping
PingSet.TTL = TTL
'anti-erreur : traitement du RTT
RTT = Abs(RTT)
If RTT > 32767 Then RTT = 32767
'création d'un socket
SockState = WSAStartup(&H101, pWsaData)
If SockState = SOCKET_ERROR Then
'en cas d'erreur de création du socket, quitter
GetEcho = -2
Exit Function
End If
'ouvre un handle ICMP
hICMP = IcmpCreateFile()
'envoie d'un paquet ICMP d'echo - et réception par la
même occasion
exeAPI = IcmpSendEcho(hICMP, AdrIP, DtSend, Len
(DtSend), PingSet, PingGet, Len(PingGet), RTT)
PingStat = PingGet
'ferme le handle ICMP
exeAPI = IcmpCloseHandle(hICMP)
'ferme le socket
SockState = WSACleanup()
End Function
'======================== =====
' FONCTION DE GESTION DU PING
'======================== =====
Function GesPing(ByRef PingEcho As icmp_echo_reply, AdrRet
As Long) As Long
'Fonction de gestion du résultat du ping
'paramètre :
'PingEcho : un pointeur vers une variable de type
icmp_echo_reply, résultat d'un ping
'données retournées :
'GesPing : durée en millisecondes du ping, ou -1 en cas de
timeout, ou -2 en cas de problème de
' paramètres (genre ttl=0), -3 en cas de taille de
tampon trop grosse.
'AdrRet : en cas de TTL expiré, renvoi l'adresse de l'hôte
atteint, sinon 0
'gestion du retour (ajouté dans la màj du 24 mai 2002)
'attention, la plupart des messages ne concerne pas
l'ICMP echo
Select Case PingEcho.Status
Case 0
'ip réalisé avec succès
GesPing = PingEcho.RoundTripTime
AdrRet = 0
Case 11001
'buffer de retour trop petit - erreur dû à VB
n'autorisant pas un tampon de plus de 10000 octets
GesPing = -3
Case 11002
'destination inatteignable
Case 11003
'hôte inatteignable
Case 11004
'protocole inaccessible
Case 11005
'port inaccessible
Case 11006
'pas de ressources
Case 11007
'mauvais paramètres - vérifer le TTL
GesPing = -2
Case 11008
'problème matériel
Case 11009
'paquet trop gros
Case 11010
'timeout
GesPing = -1
AdrRet = 0
Case 11011
'mauvaise requête
Case 11012
'mauvaise route
Case 11013
'temps de transit expiré (ttl trop petit)
GesPing = PingEcho.RoundTripTime
AdrRet = PingEcho.Address
Case 11014
'ttl trop petit pour le réassemblement
Case 11015
'problème de paramètre
Case 11016
'source arreté
Case 11017
'trop d'options
Case 11018
'mauvaise destination
Case 11019
'adresse supprimé
Case 11020
'changement de MTU nécessaire
Case 11021
'changement MTU effectué
Case 11022
'déchargement de la mémoire
Case 11023
'adresse rajouté
Case 11050
'defaillance générale
Case 11255
'en suspend
End Select
End Function
'======================== ==================
' FONCTIONS SIMPLIFIE ou PRE-CODE
' (vous pouvez les supprimer de ce module)
'======================== ==================
Function EasyPing(ByVal Adresse As String) As String
'Fonction d'envoie de ping simplifié.
'paramètre :
'Adresse : adresse IP de type "a.b.c.d" ou nom de domaine
de la cible
'donnée retournée :
'StandardPing : renvoie une chaine de caractère avec
soit "n ms" soit "Timeout"
Dim Rping As icmp_echo_reply
Dim BadAdr As Long
Dim Tp As Long
Select Case Tp
Case -3
EasyPing = "SZErr"
Case -2
EasyPing = "Err"
Case -1
EasyPing = "Timeout"
Case Else
EasyPing = Tp & " ms"
End Select
End Function
Function IncrTracert(ByVal Adresse As String, ByVal TTL As
Long, ByRef HoteRTT As Long) As String
'Fonction à utiliser pour faire un traceroute vers la
machine Adresse
'paramètre :
'Adresse : adresse IP de type "a.b.c.d" ou nom de domaine
de la cible à traçer
'TTL : valeur à incrémenter a partir de 0 jusqu'a ce que
IncrTracert = Adresse
'données retournées :
'IncrTracert : adresse IP de l'hôte numéro "TTL"
'HoteRTT : durée, en millisecondes, de l'echo vers cet
hôte; non formaté
Dim Ptmp As icmp_echo_reply
Dim HotAddr As Long
Dim EchoMS As Long
If HotAddr <> 0 Then
IncrTracert = GetIPstringVal(HotAddr)
Else
IncrTracert = AlwaysGetIP(Adresse)
End If
HoteRTT = EchoMS
End Function
Function GetNbHope(Adresse As String) As Long
'Fonction renvoyant le nombre de "saut" (ou de machines)
nécessaire pour aller jusqu'à la cible
'Code de Proger - code à usage déconseillé (gaspillage de
temps pour faire un traceroute interne)
'paramètre :
'Adresse : adresse IP de type "a.b.c.d" de la cible
'donnée retournée :
'EasyNbHope : nombre de saut
Dim TPng As icmp_echo_reply
Dim HopeAddr As Long
Dim HopeEcho As Long
Dim i As Long
For i = 0 To 255
DoEvents 'permet à votre machine de "souffler
un peu" entre chaque recherche de saut
'HopeAddr = IncrTracert(Adresse, i, HopeEcho)
HopeEcho = GetEcho(GetIPbinaryVal(Adresse), 10&,
i, "PINGECHO", TPng)
HopeEcho = GesPing(TPng, HopeAddr)
If HopeAddr = Adresse Then Exit For
Next i
GetNbHope = i
End Function
Function AlwaysGetDNS(ByVal Nval As String) As String
'Fonction renvoyant toujours le nom de domaine, peu
importe si le paramètre d'entrée
' est un nom de domaine ou une IP
AlwaysGetDNS = GetHostofIP(GetIPofCible(Nval))
End Function
Function AlwaysGetIP(ByVal Nval As String) As String
'Fonction renvoyant toujours l'IP de la machine, peu
importe si le paramètre d'entrée
' est un nom de domaine ou une IP
AlwaysGetIP = GetIPstringVal(GetIPofCible(Nval))
End Function
'Sub ExempleDeTraceRoute(ByVal LaCible As String, ByVal
MaxSaut As Long, OutListe As ListBox)
''DEMONSTRATION : réalise un traceroute vers la machine
LaCible (défini avec son ip ou dnsname)
''Code de Proger - usage déconseillé (la présentation dans
une ListBox, c'est pas top)
''Paramètre :
''LaCible : adresse IP de type "a.b.c.d" ou nom de domaine
de la cible à traçer
''MaxSaut : nombre d'hôtes qui seront parcourus avant
d'abandonner le traçage. 30 est une bonne valeur.
''OutListe : nom d'un objet ListBox (liste déroulante
standard) de sortie
'
'Dim TraceChaine As String
'Dim OutPchaine As String
'Dim RTTofSaut As Long
'Dim RTTstr As String
'Dim i As Long
'
' OutListe.Clear
' OutListe.FontName = "Courier New" 'police à chasse
fixe
'
' For i = 1 To MaxSaut
'
' OutPchaine = IncrTracert(LaCible, i, RTTofSaut)
'
' Select Case RTTofSaut 'formatage en string de
la durée de l'echo
' Case -3
' RTTstr = "SZErr"
' Case -2
' RTTstr = "Err!"
' Case -1
' RTTstr = "Timeout"
' Case Else
' RTTstr = RTTofSaut & " ms"
' End Select
'
' 'formatage de la chaine de sortie du traçage. La
fonction String() permet de générer des caractères
' ' espace (" ") pour simuler des colonnes dans la
liste.
' TraceChaine = i & String$(4 - Len(CStr(i)), " ")
& RTTstr & String$(8 - Len(RTTstr), " ") & OutPchaine &
String$(16 - Len(OutPchaine), " ") & AlwaysGetDNS
(OutPchaine)
' OutListe.AddItem TraceChaine
' OutListe.ListIndex = i - 1 'avance du curseur
' DoEvents 'laisse windows afficher le contenu de
la liste
'
' If GetIPbinaryVal(OutPchaine) = GetIPofCible
(LaCible) Then Exit For 'permet de savoir si on a atteint
la cible
'
' Next i
'
'End Sub
Function PingDef(Adresse As String, SzPing As Long,
Optional sTTL As Long) As String
'Fonction ajouté dans la mise à jour du 24 mai 2002
'Ping simplifié, avec comme paramètre obligatoire la
taille du "tampon"
'et comme paramètre optionnel le TTL de l'echo
Dim TmpPng As icmp_echo_reply
Dim BadAdr As Long
Dim Tp As Long
'Voici le code source : 'La function pour effectuer le test : Test_GetHostByName() 'et la fonction ou il y a le problème : GetIPofHost()
DefLng A-Z Option Explicit
'Déclaration pour créer un paquet ICMP d'echo Private Type ip_option_information 'structure envoyé TTL As Integer 'TimeToLive, nombre de saut d'hôtes Tos As Byte 'Type de service Flags As Byte 'nb flag OptionsSize As Byte 'Taille en byte des datas OptionsData As Long 'Pointeur vers des datas End Type
Private Type icmp_echo_reply 'structure en réponse Address As Long 'Retourne l'adresse Status As Long 'Retourne IP_STATUS RoundTripTime As Long 'RTT en ms DataSize As Integer 'Retourne la taille des données Reserved As Integer 'Reservé à une utilisation système... DataPointer As Long 'Pointeur vers le buffer retournée Options As ip_option_information 'option de retour Data As String * 10000 'buffer : en cas d'erreur 11001, l'agrandir 'note : le buffer contient les données type string qui ont été envoyé pour faire l'echo, 'c'est-à-dire "PINGECHOICMPTEST" si un ping est envoyé avec EasyPing() End Type
'API de icmp.dll utilisé Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal IcmpHandle As Long) As Long Private Declare Function IcmpSendEcho Lib "icmp.dll" (ByVal IcmpHandle As Long, ByVal DestinationAddress As Long, ByVal RequestData As String, ByVal RequestSize As Integer, RequestOptions As ip_option_information , ReplyBuffer As icmp_echo_reply, ByVal ReplySize As Long, ByVal Timeout As Long) As Long
Private Type tagWSAData wVersion As Integer wHighVersion As Integer szDescription As String * WSADESCRIPTION_LEN_1 szSystemStatus As String * WSASYSSTATUS_LEN_1 iMaxSockets As Integer iMaxUdpDg As Integer lpVendorInfo As String * 200 End Type
Private Declare Function WSAStartup Lib "WSOCK32" (ByVal wVersionRequested As Integer, lpWSADATA As tagWSAData) As Integer Private Declare Function WSACleanup Lib "WSOCK32" () As Integer
'Déclaration pour convertir un nom de domaine en adresse IP Private Type HOSTENT hName As Long 'pointeur vers le premier nom de domaine de la machine (s'il y en a plusieurs rattaché) ~FQDN hAliases As Long 'pointeurs vers les autres noms de domaine hAddrType As Integer 'type d'adresse retournée hLen As Integer 'longueur de l'adresse retournée hAddrList As Long 'pointeur vers l'adresse End Type
Private Declare Function gethostbyname Lib "WSOCK32" (ByValszHost As String) As Long Private Declare Function gethostbyaddr Lib "WSOCK32" (haddr As Long, ByVal hnlen As Long, ByVal addrtype As Long) As Long Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Public autrIP(25) As Long 'liste interne des IP possible d'un hôte Public autrIPCnt As Long
'Déclarations pour conversion IP 32bits <> strings Private Declare Function inet_ntoa Lib "wsock32.dll" (ByVal inn As Long) As Long Private Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long Private Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Any) As Long
'======================== ================== ' FONCTIONS DE CONVERSION IP$ <> IP <> DNS '======================== ================== Function GetIPofHost(NomH As String) As Long 'GetIPofHost renvoie l'adresse IP type Long IPv4 d'une machine 'paramètre : 'NomH : nom DNS de la machine, exemple : www.google.com Dim exeAPI As Long, i Dim HostInfo As HOSTENT Dim IPv4Adr As Long Dim SockStart As Long Dim SockInf As tagWSAData
SockStart = WSAStartup(&H101, SockInf) 'ouvre un socket 'Voici le pb car gethostbyname retourne 0 exeAPI = gethostbyname(NomH) 'recupère le pointeur vers un HOSTENT SockStart = WSACleanup() 'ferme le socket
If exeAPI > 0 Then 'pour récupérer des valeurs dont on ne connais que le pointeur, on utilise 'RtlMoveMemory RtlMoveMemory HostInfo, exeAPI, ByVal (LenB (HostInfo)) RtlMoveMemory exeAPI, ByVal HostInfo.hAddrList, 4 RtlMoveMemory IPv4Adr, ByVal exeAPI, HostInfo.hLen GetIPofHost = IPv4Adr autrIP(0) = IPv4Adr
For i = 1 To 25 'on cherche jusqu'a 25 autres IP pour la même machine RtlMoveMemory exeAPI, ByVal HostInfo.hAddrList + (i * 4), 4
If exeAPI <> 0 Then RtlMoveMemory IPv4Adr, ByVal exeAPI, HostInfo.hLen autrIP(i) = IPv4Adr Else autrIPCnt = i Exit For End If
Next i
Else 'erreur : l'hôte n'a pas d'IP. GetIPofHost = 0 End If
End Function
Function GetHostofIP(IPAdr As Long) As String 'GetIPofHost renvoie le premier nom DNS d'une machine dont on connais l'IP 'paramètre : 'IPAdr : adresse IP de la machine, type Long IPv4 Dim exeAPI As Long Dim HostInfo As HOSTENT Dim TmpNm As String * 255 'tampon reçevant le nom de domaine Dim SockStart As Long Dim SockInf As tagWSAData
SockStart = WSAStartup(&H101, SockInf) 'ouvre un socket exeAPI = gethostbyaddr(IPAdr, Len(IPAdr), 2) 'récupère le pointeur vers un HOSTENT SockStart = WSACleanup() 'ferme le socket
If exeAPI <> 0 Then RtlMoveMemory HostInfo, exeAPI, ByVal (LenB (HostInfo)) RtlMoveMemory ByVal TmpNm, HostInfo.hName, 255 'le nom de domaine se termine par un &H00&, mais à cause que l'on alloue 255 octets, il y a 'plein de vide, donc cela nécessite deux traitement. If InStr(1, TmpNm, Chr$(0)) > 0 Then TmpNm = Left$(TmpNm, InStr(1, TmpNm, Chr$(0))) GetHostofIP = Trim$(TmpNm)
Else 'erreur : l'IP n'a pas de nom DNS GetHostofIP = "" End If
End Function
Function GetIPbinaryVal(ByVal IPAdr As String) As Long 'GetIpbinaryVal converti une adresse IP type string (a.b.c.d) en type Long 32-bits IPv4 'API Powa :)
GetIPbinaryVal = inet_addr(IPAdr)
End Function
Function GetIPstringVal(IPlng As Long) As String 'GetIPstringVal renvoie une valeur string "a.b.c.d" a partir d'une valeur IP Long 32-bits IPv4 Dim lpStr As Long, Strl As Long, BufStr As String * 32
lpStr = inet_ntoa(IPlng) If lpStr = 0 Then GetIPstringVal = "255.255.255.255" Else Strl = lstrlenA(lpStr) If Strl > 32 Then Strl = 32 RtlMoveMemory ByVal BufStr, lpStr, Strl GetIPstringVal = Left$(BufStr, InStr(1, BufStr, Chr$(0)) - 1) End If
End Function
Function GetIPofCible(Cible As String) As Long 'Fonction renvoyant l'adresse IP de la cible, peu importe si la Cible est une IP ou un nom de domaine 'paramètre : 'Cible : nom de domaine ou adresse IP 'donnée retournée : 'GetIPofCible : renvoie la valeur Long IPv4 de l'IP de la cible Dim TmIP As Long
'PS : 16 octets car Len("xxx.xxx.xxx.xxx") = 15 If Len(Cible) < 16 Then TmIP = GetIPbinaryVal(Cible) If TmIP <= 0 Then TmIP = GetIPofHost(Cible) End If Else TmIP = GetIPofHost(Cible) End If
GetIPofCible = TmIP
End Function
'======================== === ' FONCTION ENVOYANT LE PING '======================== === Function GetEcho(AdrIP As Long, RTT As Long, TTL As Long, DtSend As String, ByRef PingStat As icmp_echo_reply) As Long 'GetEcho : envoie un Ping et le récupère 'paramètres : 'AdrIP : adresse IP Type Long IPv4 de la destination 'RTT : durée en millisecondes du temps d'attente de l'echo, max 32767 'TTL : nombre de saut d'hôtes à faire 'DtSend : chaine de caractère qui sera envoyé dans le paquet ICMP 'données retournées : 'GetEcho : valeur en milliseconde du trajet, -1 si timeout, -2 si problème de socket 'PingStat : type icmp_echo_reply, pour gérer le resultat dans un autre sub
Dim hICMP As Long Dim exeAPI As Long Dim PingSet As ip_option_information Dim PingGet As icmp_echo_reply Dim pWsaData As tagWSAData Dim SockState As Long
'définition du TTL du ping PingSet.TTL = TTL 'anti-erreur : traitement du RTT RTT = Abs(RTT) If RTT > 32767 Then RTT = 32767
'création d'un socket SockState = WSAStartup(&H101, pWsaData)
If SockState = SOCKET_ERROR Then 'en cas d'erreur de création du socket, quitter GetEcho = -2 Exit Function End If
'ouvre un handle ICMP hICMP = IcmpCreateFile() 'envoie d'un paquet ICMP d'echo - et réception par la même occasion exeAPI = IcmpSendEcho(hICMP, AdrIP, DtSend, Len (DtSend), PingSet, PingGet, Len(PingGet), RTT)
PingStat = PingGet
'ferme le handle ICMP exeAPI = IcmpCloseHandle(hICMP) 'ferme le socket SockState = WSACleanup()
End Function
'======================== ===== ' FONCTION DE GESTION DU PING '======================== ===== Function GesPing(ByRef PingEcho As icmp_echo_reply, AdrRet As Long) As Long 'Fonction de gestion du résultat du ping 'paramètre : 'PingEcho : un pointeur vers une variable de type icmp_echo_reply, résultat d'un ping 'données retournées : 'GesPing : durée en millisecondes du ping, ou -1 en cas de timeout, ou -2 en cas de problème de ' paramètres (genre ttl=0), -3 en cas de taille de tampon trop grosse. 'AdrRet : en cas de TTL expiré, renvoi l'adresse de l'hôte atteint, sinon 0
'gestion du retour (ajouté dans la màj du 24 mai 2002) 'attention, la plupart des messages ne concerne pas l'ICMP echo Select Case PingEcho.Status Case 0 'ip réalisé avec succès GesPing = PingEcho.RoundTripTime AdrRet = 0 Case 11001 'buffer de retour trop petit - erreur dû à VB n'autorisant pas un tampon de plus de 10000 octets GesPing = -3 Case 11002 'destination inatteignable Case 11003 'hôte inatteignable Case 11004 'protocole inaccessible Case 11005 'port inaccessible Case 11006 'pas de ressources Case 11007 'mauvais paramètres - vérifer le TTL GesPing = -2 Case 11008 'problème matériel Case 11009 'paquet trop gros Case 11010 'timeout GesPing = -1 AdrRet = 0 Case 11011 'mauvaise requête Case 11012 'mauvaise route Case 11013 'temps de transit expiré (ttl trop petit) GesPing = PingEcho.RoundTripTime AdrRet = PingEcho.Address Case 11014 'ttl trop petit pour le réassemblement Case 11015 'problème de paramètre Case 11016 'source arreté Case 11017 'trop d'options Case 11018 'mauvaise destination Case 11019 'adresse supprimé Case 11020 'changement de MTU nécessaire Case 11021 'changement MTU effectué Case 11022 'déchargement de la mémoire Case 11023 'adresse rajouté Case 11050 'defaillance générale Case 11255 'en suspend End Select
End Function
'======================== ================== ' FONCTIONS SIMPLIFIE ou PRE-CODE ' (vous pouvez les supprimer de ce module) '======================== ================== Function EasyPing(ByVal Adresse As String) As String 'Fonction d'envoie de ping simplifié. 'paramètre : 'Adresse : adresse IP de type "a.b.c.d" ou nom de domaine de la cible 'donnée retournée : 'StandardPing : renvoie une chaine de caractère avec soit "n ms" soit "Timeout" Dim Rping As icmp_echo_reply Dim BadAdr As Long Dim Tp As Long
Select Case Tp Case -3 EasyPing = "SZErr" Case -2 EasyPing = "Err" Case -1 EasyPing = "Timeout" Case Else EasyPing = Tp & " ms" End Select
End Function
Function IncrTracert(ByVal Adresse As String, ByVal TTL As Long, ByRef HoteRTT As Long) As String 'Fonction à utiliser pour faire un traceroute vers la machine Adresse 'paramètre : 'Adresse : adresse IP de type "a.b.c.d" ou nom de domaine de la cible à traçer 'TTL : valeur à incrémenter a partir de 0 jusqu'a ce que IncrTracert = Adresse 'données retournées : 'IncrTracert : adresse IP de l'hôte numéro "TTL" 'HoteRTT : durée, en millisecondes, de l'echo vers cet hôte; non formaté
Dim Ptmp As icmp_echo_reply Dim HotAddr As Long Dim EchoMS As Long
If HotAddr <> 0 Then IncrTracert = GetIPstringVal(HotAddr) Else IncrTracert = AlwaysGetIP(Adresse) End If
HoteRTT = EchoMS
End Function
Function GetNbHope(Adresse As String) As Long 'Fonction renvoyant le nombre de "saut" (ou de machines) nécessaire pour aller jusqu'à la cible 'Code de Proger - code à usage déconseillé (gaspillage de temps pour faire un traceroute interne) 'paramètre : 'Adresse : adresse IP de type "a.b.c.d" de la cible 'donnée retournée : 'EasyNbHope : nombre de saut Dim TPng As icmp_echo_reply Dim HopeAddr As Long Dim HopeEcho As Long Dim i As Long
For i = 0 To 255 DoEvents 'permet à votre machine de "souffler un peu" entre chaque recherche de saut 'HopeAddr = IncrTracert(Adresse, i, HopeEcho) HopeEcho = GetEcho(GetIPbinaryVal(Adresse), 10&, i, "PINGECHO", TPng) HopeEcho = GesPing(TPng, HopeAddr) If HopeAddr = Adresse Then Exit For Next i
GetNbHope = i
End Function
Function AlwaysGetDNS(ByVal Nval As String) As String 'Fonction renvoyant toujours le nom de domaine, peu importe si le paramètre d'entrée ' est un nom de domaine ou une IP
AlwaysGetDNS = GetHostofIP(GetIPofCible(Nval))
End Function
Function AlwaysGetIP(ByVal Nval As String) As String 'Fonction renvoyant toujours l'IP de la machine, peu importe si le paramètre d'entrée ' est un nom de domaine ou une IP
AlwaysGetIP = GetIPstringVal(GetIPofCible(Nval))
End Function
'Sub ExempleDeTraceRoute(ByVal LaCible As String, ByVal MaxSaut As Long, OutListe As ListBox) ''DEMONSTRATION : réalise un traceroute vers la machine LaCible (défini avec son ip ou dnsname) ''Code de Proger - usage déconseillé (la présentation dans une ListBox, c'est pas top) ''Paramètre : ''LaCible : adresse IP de type "a.b.c.d" ou nom de domaine de la cible à traçer ''MaxSaut : nombre d'hôtes qui seront parcourus avant d'abandonner le traçage. 30 est une bonne valeur. ''OutListe : nom d'un objet ListBox (liste déroulante standard) de sortie ' 'Dim TraceChaine As String 'Dim OutPchaine As String 'Dim RTTofSaut As Long 'Dim RTTstr As String 'Dim i As Long ' ' OutListe.Clear ' OutListe.FontName = "Courier New" 'police à chasse fixe ' ' For i = 1 To MaxSaut ' ' OutPchaine = IncrTracert(LaCible, i, RTTofSaut) ' ' Select Case RTTofSaut 'formatage en string de la durée de l'echo ' Case -3 ' RTTstr = "SZErr" ' Case -2 ' RTTstr = "Err!" ' Case -1 ' RTTstr = "Timeout" ' Case Else ' RTTstr = RTTofSaut & " ms" ' End Select ' ' 'formatage de la chaine de sortie du traçage. La fonction String() permet de générer des caractères ' ' espace (" ") pour simuler des colonnes dans la liste. ' TraceChaine = i & String$(4 - Len(CStr(i)), " ") & RTTstr & String$(8 - Len(RTTstr), " ") & OutPchaine & String$(16 - Len(OutPchaine), " ") & AlwaysGetDNS (OutPchaine) ' OutListe.AddItem TraceChaine ' OutListe.ListIndex = i - 1 'avance du curseur ' DoEvents 'laisse windows afficher le contenu de la liste ' ' If GetIPbinaryVal(OutPchaine) = GetIPofCible (LaCible) Then Exit For 'permet de savoir si on a atteint la cible ' ' Next i ' 'End Sub
Function PingDef(Adresse As String, SzPing As Long, Optional sTTL As Long) As String 'Fonction ajouté dans la mise à jour du 24 mai 2002 'Ping simplifié, avec comme paramètre obligatoire la taille du "tampon" 'et comme paramètre optionnel le TTL de l'echo
Dim TmpPng As icmp_echo_reply Dim BadAdr As Long Dim Tp As Long