Dns, ping, traceroute sans ocx, sans dll, sans shell

Soyez le premier à donner votre avis sur cette source.

Vue 22 881 fois - Téléchargée 2 185 fois

Télécharger le projet
Commenter

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!

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!).
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Signaler
cs_gowapinou
Messages postés
1
Date d'inscription
samedi 12 juin 2004
Statut
Membre
Dernière intervention
21 août 2006
Ce code ne fonctionne plus sous XP sp2. En effet, l'utilisation du WSAStartup ne fait plus rien ; la variable de type "tagWSAData" n'est pas affecté par l'appel ; aucune erreur n'est générée !
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
Signaler
cbnet
Messages postés
176
Date d'inscription
vendredi 29 octobre 2004
Statut
Membre
Dernière intervention
7 mars 2005
moi je dis bravo aussi 9/10 ;)
Signaler
cs_marm0tte
Messages postés
200
Date d'inscription
mercredi 5 février 2003
Statut
Membre
Dernière intervention
18 janvier 2009
Alors la moi je dis bravo franchement :D
Signaler
cs_aurbadguy
Messages postés
29
Date d'inscription
lundi 8 mars 2004
Statut
Membre
Dernière intervention
30 mai 2004
merci raph22 mais pourrait tu nous faire de ta modification ???
Signaler
Raph22
Messages postés
4
Date d'inscription
vendredi 12 juillet 2002
Statut
Membre
Dernière intervention
27 juillet 2005
Très pratique, mais dommage que easyping retourne un ping de 0 pour une machine non existante. Mais une p'tie modif et ca roule !

Good job Proger !
Afficher les 19 commentaires
S'inscrire maintenant

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.

Du même auteur (Proger)