Ping vb sous vb (maj)

Soyez le premier à donner votre avis sur cette source.

Vue 11 430 fois - Téléchargée 1 071 fois

Description

Rien à faire seulement modifier pour obtenir ce que vous voulez :-)

Source / Exemple :


'*******************************************************************
'   PingVB
'
'   Cette application sert a faire un ping vb en utilisant
'    ICMP.DLL
'
'
'*******************************************************************
Private Const IP_STATUS_BASE = 11000

Private Const IP_SUCCESS = 0
Private Const IP_BUF_TOO_SMALL = (11000 + 1)
Private Const IP_DEST_NET_UNREACHABLE = (11000 + 2)
Private Const IP_DEST_HOST_UNREACHABLE = (11000 + 3)
Private Const IP_DEST_PROT_UNREACHABLE = (11000 + 4)
Private Const IP_DEST_PORT_UNREACHABLE = (11000 + 5)
Private Const IP_NO_RESOURCES = (11000 + 6)
Private Const IP_BAD_OPTION = (11000 + 7)
Private Const IP_HW_ERROR = (11000 + 8)
Private Const IP_PACKET_TOO_BIG = (11000 + 9)
Private Const IP_REQ_TIMED_OUT = (11000 + 10)
Private Const IP_BAD_REQ = (11000 + 11)
Private Const IP_BAD_ROUTE = (11000 + 12)
Private Const IP_TTL_EXPIRED_TRANSIT = (11000 + 13)
Private Const IP_TTL_EXPIRED_REASSEM = (11000 + 14)
Private Const IP_PARAM_PROBLEM = (11000 + 15)
Private Const IP_SOURCE_QUENCH = (11000 + 16)
Private Const IP_OPTION_TOO_BIG = (11000 + 17)
Private Const IP_BAD_DESTINATION = (11000 + 18)
'

Private Const IP_ADDR_DELETED = (11000 + 19)
Private Const IP_SPEC_MTU_CHANGE = (11000 + 20)
Private Const IP_MTU_CHANGE = (11000 + 21)
Private Const IP_UNLOAD = (11000 + 22)
Private Const IP_ADDR_ADDED = (11000 + 23)

Private Const IP_GENERAL_FAILURE = (11000 + 50)
Private Const MAX_IP_STATUS = 11000 + 50
Private Const IP_PENDING = (11000 + 255)

Private Type ip_option_information
    Ttl             As Byte     'duree de vie
    Tos             As Byte     'Type de service
    Flags           As Byte     'nb flag
    OptionsSize     As Byte     'Taille en byte des dats
    OptionsData     As Long     'Pointer vers options data
End Type

'   structure retourné pas le ping pour donner le statur ou les error information
Private Type icmp_echo_reply
    Address         As Long             'Retourne l'@
    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èem
    DataPointer     As Long             'Pointeur vers la donné retourné
    Options         As ip_option_information    'option de retour
    Data            As String * 250
End Type

'   fonction 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 Const PING_TIMEOUT = 200        ' nb seconde a attendre

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

Private Sub btnExit_Click()
    End
End Sub

Private Sub btnPing_Click()

    Dim hFile       As Long
    Dim lRet        As Long
    Dim lIPAddress  As Long
    Dim strMessage  As String
    Dim pOptions    As ip_option_information
    Dim pReturn     As icmp_echo_reply
    Dim iVal        As Integer
    Dim lPingRet    As Long
    Dim pWsaData    As tagWSAData
    
    strMessage = "Echo cette chaine de donnée"
    
    iVal = WSAStartup(&H101, pWsaData)
    
    'Convertit l'adresse ip en long
    lIPAddress = ConvertIPAddressToLong(txIPAddress)
    
    '   ouvre un fichier pour le ping
    hFile = IcmpCreateFile()
    
    '   met la duréee de vie du ping
    pOptions.Ttl = Val(txTTL)
    
    'Fonction qui ping
    lRet = IcmpSendEcho(hFile, _
                        lIPAddress, _
                        strMessage, _
                        Len(strMessage), _
                        pOptions, _
                        pReturn, _
                        Len(pReturn), _
                        PING_TIMEOUT)

    If lRet = 0 Then
        'Error buffer
        lbReturn.AddItem "Erreur ping " & pReturn.Status
        lbReturn.ListIndex = lbReturn.ListCount - 1
    Else
        'Ping effectué status doit = 0
        If pReturn.Status <> 0 Then
            lbReturn.AddItem "Erreurr -> Ping non terminé = " & pReturn.Status
            lbReturn.ListIndex = lbReturn.ListCount - 1
        Else
            lbReturn.AddItem "Réussite => Temps -> " & pReturn.RoundTripTime & "ms."
            lbReturn.ListIndex = lbReturn.ListCount - 1
        End If
    End If
                        
    '   ferme le file
    lRet = IcmpCloseHandle(hFile)
    
    iVal = WSACleanup()
    
End Sub

'
'   ConvertIPAddressToLong
'
'   Convertit l'adresse ip avec ses points en long

'   on a "a.b.c.d" et nous voulons Val(&Hddccbbaa).
'

Function ConvertIPAddressToLong(strAddress As String) As Long

    Dim strTemp             As String
    Dim lAddress            As Long
    Dim iValCount           As Integer
    Dim lDotValues(1 To 4)  As String
    
 
    strTemp = strAddress
    iValCount = 0
    
    ' tant qu'il y a des points
    While InStr(strTemp, ".") > 0
        iValCount = iValCount + 1   'ben compte
        lDotValues(iValCount) = Mid(strTemp, 1, InStr(strTemp, ".") - 1)    ' vire le point et convertit
        strTemp = Mid(strTemp, InStr(strTemp, ".") + 1)
        Wend
        

    iValCount = iValCount + 1
    lDotValues(iValCount) = strTemp
    
   'Si il n'y a pas quatre element ben le ping marchera po alors il s'arrete
    If iValCount <> 4 Then
        ConvertIPAddressToLong = 0
        Exit Function
        End If
        
   'hex les 4 valeurs
    lAddress = Val("&H" & Right("00" & Hex(lDotValues(4)), 2) & _
                Right("00" & Hex(lDotValues(3)), 2) & _
                Right("00" & Hex(lDotValues(2)), 2) & _
                Right("00" & Hex(lDotValues(1)), 2))
                
    '  valeur de retour
    ConvertIPAddressToLong = lAddress
    
End Function

Conclusion :


Ben rien jamais eu de probleme avec ben si vous en avez un mailez moi .

::Je vous met un zip un an après !!:: pardonnez moi lol

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Votre Site est SUPER...
Je teste le PING VB et je vous dis comment ca marche
C'est Vrai que c'est super, mais je débute en VB et j'aimerais bien que quelqu'u m'aide à le rattacher à un pgorramme
C'est quoi un ping ???
Merci
Je voudrais savoir comment cela fonctionne,ou on met l @ de la machine que l'on veut pinger?? merci
esce que tu pourraias me dire les controle a ajouter dans form merci

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.