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
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.