Dns, ping, traceroute sans ocx, sans dll, sans shell
Soyez le premier à donner votre avis sur cette source.
Vue 24 144 fois - Téléchargée 2 270 fois
Description
Module autonome tout-en-un.
Permet de faire les opérations Ping et NsLookUp.
Par la même occasion, un exemple de Traceroute a été rajouté.
- La fonction EasyPing permet de faire un ping en une ligne de code.
- Les fonctions AlwaysGetIP et AlwaysGetDNS permettent aussi une mise en oeuvre rapide.
Il y a bien sûr la redirection automatique vers la-fonction-qui-va-bien si l'utilisateur mets une adresse IP au lieu d'un nom de domaine, et inversement.
J'espère que les commentaires dans le code sont suffisant.
Dans le zip, il y a un programme d'exemple d'utilisation de ce module.
PS : Je remercie mes différentes sources originels :) le module ci-dessous n'a presque plus rien en commun!
J'ai vu plusieurs autres codes source de Ping et DNS dans ce site, mais à chaque fois ils nécessitaient soit un ocx, soit une dll ... certes les API utilisent aussi des dll, mais elles sont incluses dans Windows.
MàJ :
- rajout de la fonction PingDef, pour définir manuellement la taille de l'echo, et en option, le TTL
- débogage, comme indiqué dans les commentaires
- simplifications des fonctions GetIPbinary/stringVal() via API
- simplifications de la fonction GetIPofCible()
- deux exemples d'utilisation dans le zip
- code simplifié
Bug connu : il est impossible d'envoyer un Ping de plus de 10000 octets : VB6 n'autorise pas de créer une variable de taille supérieur à 10Ko (dans le Type icmp_echo_reply en tout cas!).
Permet de faire les opérations Ping et NsLookUp.
Par la même occasion, un exemple de Traceroute a été rajouté.
- La fonction EasyPing permet de faire un ping en une ligne de code.
- Les fonctions AlwaysGetIP et AlwaysGetDNS permettent aussi une mise en oeuvre rapide.
Il y a bien sûr la redirection automatique vers la-fonction-qui-va-bien si l'utilisateur mets une adresse IP au lieu d'un nom de domaine, et inversement.
J'espère que les commentaires dans le code sont suffisant.
Dans le zip, il y a un programme d'exemple d'utilisation de ce module.
PS : Je remercie mes différentes sources originels :) le module ci-dessous n'a presque plus rien en commun!
Source / Exemple :
'==========================================
' MODULE PING & DNS
'*******************
'
'Par Proger
' mai 2002
' révision aout 2003
' protocole ICMP sur IPv4
'
'Module permettant de faire des ping et des nslookup !
'Module totalement autonome.
'source : basé à l'origine sur une idée de c2i
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
'Déclarations pour ouvrir un socket, permettant l'envoie de l'echo
Private Const WSADESCRIPTION_LEN = 256
Private Const WSASYSSTATUS_LEN = 256
Private Const WSADESCRIPTION_LEN_1 = WSADESCRIPTION_LEN + 1
Private Const WSASYSSTATUS_LEN_1 = WSASYSSTATUS_LEN + 1
Private Const SOCKET_ERROR = -1
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" (ByVal szHost 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
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
Tp = GetEcho(GetIPofCible(Adresse), 2000, 128, "PINGECHOICMPTEST", Rping)
Tp = GesPing(Rping, BadAdr)
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
EchoMS = GetEcho(GetIPofCible(Adresse), 2500, TTL, "PINGECHOICMPTEST", Ptmp)
EchoMS = GesPing(Ptmp, HotAddr)
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
If sTTL <= 0 Then sTTL = 128
Tp = GetEcho(GetIPofCible(Adresse), 2000, sTTL, String$(SzPing, "A"), TmpPng)
Tp = GesPing(TmpPng, BadAdr)
Select Case Tp
Case -3
PingDef = "SZErr"
Case -2
PingDef = "Err"
Case -1
PingDef = "Timeout"
Case Else
PingDef = Tp & " ms"
End Select
End Function
Conclusion :
J'ai vu plusieurs autres codes source de Ping et DNS dans ce site, mais à chaque fois ils nécessitaient soit un ocx, soit une dll ... certes les API utilisent aussi des dll, mais elles sont incluses dans Windows.
MàJ :
- rajout de la fonction PingDef, pour définir manuellement la taille de l'echo, et en option, le TTL
- débogage, comme indiqué dans les commentaires
- simplifications des fonctions GetIPbinary/stringVal() via API
- simplifications de la fonction GetIPofCible()
- deux exemples d'utilisation dans le zip
- code simplifié
Bug connu : il est impossible d'envoyer un Ping de plus de 10000 octets : VB6 n'autorise pas de créer une variable de taille supérieur à 10Ko (dans le Type icmp_echo_reply en tout cas!).
Codes Sources
A voir également
- Vb.net ping
- Visual basic ping - Meilleures réponses
- Ping vb.net - Meilleures réponses
- Visual Basic / VB.NET : Ping ocx - CodeS SourceS - Guide
- Visual Basic / VB.NET : Ping réseau - CodeS SourceS - Guide
- Visual Basic / VB.NET : Ping pong time - CodeS SourceS - Guide
- Visual Basic / VB.NET : Ping de trois serveur - CodeS SourceS - Guide
- Visual Basic / VB.NET : Ping ponge - CodeS SourceS - Guide
21 août 2006 à 16:42
J'ai recherché sur le Net des informations sur une solution de remplacement, mais personne ne répond.
Si vous avez une nouvelle méthode, je suis preneur.
GOWAP
9 févr. 2005 à 21:30
30 août 2004 à 23:28
7 avril 2004 à 11:30
11 avril 2003 à 02:40
Good job Proger !
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.