Bonjour,
"marcel"
| Bonjour, je désire pouvoir exécuter l'équivalent du ping sous access
<snip>
| existe t'il une manière d'exécuter l'équivalent du ping dans du code
access
| Merci à vous je sèche
| Marcel
<CODE>
Option Compare Database
Option Explicit
Type IP_OPTION_INFORMATION
TTL As Byte ' Time to Live (used for traceroute)
Tos As Byte ' Type of Service (usually 0)
Flags As Byte ' IP header Flags (usually 0)
OptionsSize As Long ' Size of Options data (usually 0, max
40)
OptionsData As String * 128 ' Options data buffer
End Type
Type IP_ECHO_REPLY
Address(0 To 3) As Byte ' Replying Address
Status As Long ' Reply Status
RoundTripTime As Long ' Round Trip Time in milliseconds
DataSize As Integer ' reply data size
Reserved As Integer ' for system use
data As Long ' pointer to echo data
Options As IP_OPTION_INFORMATION ' Reply Options
End Type
Declare Function IcmpCreateFile Lib "ICMP" () As Long
Declare Function IcmpSendEcho Lib "ICMP" ( _
ByVal IcmpHandle As Long, _
ByVal DestAddress As Long, _
ByVal RequestData As String, _
ByVal RequestSize As Integer, _
RequestOptns As IP_OPTION_INFORMATION, _
ReplyBuffer As IP_ECHO_REPLY, _
ByVal ReplySize As Long, _
ByVal TimeOut As Long _
) As Boolean
Declare Function IcmpCloseHandle Lib "ICMP" ( _
ByVal HANDLE As Long _
) As Boolean
' Usage : Retour = vbPing "207.46.130.14", 16, 2000
' Avec : "207.46.130.14" Adresse que l'on veut pinguer
' 16 : TTL de la socket ICMP (en gros, le NB max de routeurs a
traverser.Utile
' lors d'un traceroute...
' 2000 : Timeout en millisecondes.
Function vbPing(IPAddress As String, TTL As Integer, TimeOut As Integer)
As Long
Dim bRC As Boolean
Dim Buff As String
Dim RespHost As String
Dim hIP As Long
Dim addr As Long
Dim IP_OPT As IP_OPTION_INFORMATION
Dim IP_REP As IP_ECHO_REPLY
Dim OldPointer As Long
OldPointer = Screen.MousePointer
''Screen.MousePointer = vbHourglass
' Ouverture de la DLL ICMP
hIP = IcmpCreateFile()
If hIP = 0 Then
vbPing = -1&
Screen.MousePointer = OldPointer
Exit Function
End If
' Convertion IPAddress Dotted-Decimal IP en Long
addr = vbInet_Addr(IPAddress)
If addr = -1 Then
vbPing = -1&
Screen.MousePointer = OldPointer
Exit Function
End If
' Initialisation du Buffer a 64 caractères
Buff = Space(64)
' Initialisation des options TCP/IP
IP_OPT.TTL = TTL
IP_OPT.Tos = 8
' Envoie du PING
bRC = IcmpSendEcho(hIP, addr, Buff, Len(Buff) _
, IP_OPT, IP_REP, Len(IP_REP) + 8, TimeOut)
' Traite la réponse
If bRC Then
RespHost = ""
' Convertion IP Addresse en notation point.
RespHost = CStr(IP_REP.Address(0)) _
& "." & CStr(IP_REP.Address(1)) _
& "." & CStr(IP_REP.Address(2)) _
& "." & CStr(IP_REP.Address(3))
If IP_REP.Status = 0 Then
' l'hote testé à répondu
vbPing = IP_REP.RoundTripTime
Else
' Mauvaise réponse
vbPing = -1&
End If
Else
' TimeOut a été atteind sans réponse
vbPing = -1&
End If
' On Ferme ICMP.DLL
bRC = IcmpCloseHandle(hIP)
Screen.MousePointer = OldPointer
End Function
Private Function vbInet_Addr(strAddr As String) As Long
Dim pDot As Integer
Dim strTmp As String
Dim strAdd1 As String, strAdd2 As String
Dim strAdd3 As String, strAdd4 As String
strTmp = Trim(strAddr)
' Découpage des champs de l'adresse
pDot = InStr(strTmp, ".")
If pDot <> 0 Then
strAdd1 = Hex(Val(Left(strTmp, pDot - 1)))
strTmp = Mid(strTmp, pDot + 1)
Else
' Argument invalide
vbInet_Addr = -1
Exit Function
End If
pDot = InStr(strTmp, ".")
If pDot <> 0 Then
strAdd2 = Hex(Val(Left(strTmp, pDot - 1)))
strTmp = Mid(strTmp, pDot + 1)
Else
Error 5 ' Argument invalide
End If
pDot = InStr(strTmp, ".")
If pDot <> 0 Then
strAdd3 = Hex(Val(Left(strTmp, pDot - 1)))
strAdd4 = Hex(Val(Mid(strTmp, pDot + 1)))
Else
Error 5 ' Argument invalide
End If
If Len(strAdd1) < 2 Then strAdd1 = "0" & strAdd1
If Len(strAdd2) < 2 Then strAdd2 = "0" & strAdd2
If Len(strAdd3) < 2 Then strAdd3 = "0" & strAdd3
If Len(strAdd4) < 2 Then strAdd4 = "0" & strAdd4
If Len(strAdd1) > 2 Then Error 5 ' Argument invalide
If Len(strAdd2) > 2 Then Error 5
If Len(strAdd3) > 2 Then Error 5
If Len(strAdd4) > 2 Then Error 5
vbInet_Addr = CLng("&h" & strAdd4 & strAdd3 & strAdd2 & strAdd1)
End Function
</CODE>
--
a+
Gloubi
http://users.skynet.be/mpfa/
Bonjour,
"marcel" <titi@toto.fr>
| Bonjour, je désire pouvoir exécuter l'équivalent du ping sous access
<snip>
| existe t'il une manière d'exécuter l'équivalent du ping dans du code
access
| Merci à vous je sèche
| Marcel
<CODE>
Option Compare Database
Option Explicit
Type IP_OPTION_INFORMATION
TTL As Byte ' Time to Live (used for traceroute)
Tos As Byte ' Type of Service (usually 0)
Flags As Byte ' IP header Flags (usually 0)
OptionsSize As Long ' Size of Options data (usually 0, max
40)
OptionsData As String * 128 ' Options data buffer
End Type
Type IP_ECHO_REPLY
Address(0 To 3) As Byte ' Replying Address
Status As Long ' Reply Status
RoundTripTime As Long ' Round Trip Time in milliseconds
DataSize As Integer ' reply data size
Reserved As Integer ' for system use
data As Long ' pointer to echo data
Options As IP_OPTION_INFORMATION ' Reply Options
End Type
Declare Function IcmpCreateFile Lib "ICMP" () As Long
Declare Function IcmpSendEcho Lib "ICMP" ( _
ByVal IcmpHandle As Long, _
ByVal DestAddress As Long, _
ByVal RequestData As String, _
ByVal RequestSize As Integer, _
RequestOptns As IP_OPTION_INFORMATION, _
ReplyBuffer As IP_ECHO_REPLY, _
ByVal ReplySize As Long, _
ByVal TimeOut As Long _
) As Boolean
Declare Function IcmpCloseHandle Lib "ICMP" ( _
ByVal HANDLE As Long _
) As Boolean
' Usage : Retour = vbPing "207.46.130.14", 16, 2000
' Avec : "207.46.130.14" Adresse que l'on veut pinguer
' 16 : TTL de la socket ICMP (en gros, le NB max de routeurs a
traverser.Utile
' lors d'un traceroute...
' 2000 : Timeout en millisecondes.
Function vbPing(IPAddress As String, TTL As Integer, TimeOut As Integer)
As Long
Dim bRC As Boolean
Dim Buff As String
Dim RespHost As String
Dim hIP As Long
Dim addr As Long
Dim IP_OPT As IP_OPTION_INFORMATION
Dim IP_REP As IP_ECHO_REPLY
Dim OldPointer As Long
OldPointer = Screen.MousePointer
''Screen.MousePointer = vbHourglass
' Ouverture de la DLL ICMP
hIP = IcmpCreateFile()
If hIP = 0 Then
vbPing = -1&
Screen.MousePointer = OldPointer
Exit Function
End If
' Convertion IPAddress Dotted-Decimal IP en Long
addr = vbInet_Addr(IPAddress)
If addr = -1 Then
vbPing = -1&
Screen.MousePointer = OldPointer
Exit Function
End If
' Initialisation du Buffer a 64 caractères
Buff = Space(64)
' Initialisation des options TCP/IP
IP_OPT.TTL = TTL
IP_OPT.Tos = 8
' Envoie du PING
bRC = IcmpSendEcho(hIP, addr, Buff, Len(Buff) _
, IP_OPT, IP_REP, Len(IP_REP) + 8, TimeOut)
' Traite la réponse
If bRC Then
RespHost = ""
' Convertion IP Addresse en notation point.
RespHost = CStr(IP_REP.Address(0)) _
& "." & CStr(IP_REP.Address(1)) _
& "." & CStr(IP_REP.Address(2)) _
& "." & CStr(IP_REP.Address(3))
If IP_REP.Status = 0 Then
' l'hote testé à répondu
vbPing = IP_REP.RoundTripTime
Else
' Mauvaise réponse
vbPing = -1&
End If
Else
' TimeOut a été atteind sans réponse
vbPing = -1&
End If
' On Ferme ICMP.DLL
bRC = IcmpCloseHandle(hIP)
Screen.MousePointer = OldPointer
End Function
Private Function vbInet_Addr(strAddr As String) As Long
Dim pDot As Integer
Dim strTmp As String
Dim strAdd1 As String, strAdd2 As String
Dim strAdd3 As String, strAdd4 As String
strTmp = Trim(strAddr)
' Découpage des champs de l'adresse
pDot = InStr(strTmp, ".")
If pDot <> 0 Then
strAdd1 = Hex(Val(Left(strTmp, pDot - 1)))
strTmp = Mid(strTmp, pDot + 1)
Else
' Argument invalide
vbInet_Addr = -1
Exit Function
End If
pDot = InStr(strTmp, ".")
If pDot <> 0 Then
strAdd2 = Hex(Val(Left(strTmp, pDot - 1)))
strTmp = Mid(strTmp, pDot + 1)
Else
Error 5 ' Argument invalide
End If
pDot = InStr(strTmp, ".")
If pDot <> 0 Then
strAdd3 = Hex(Val(Left(strTmp, pDot - 1)))
strAdd4 = Hex(Val(Mid(strTmp, pDot + 1)))
Else
Error 5 ' Argument invalide
End If
If Len(strAdd1) < 2 Then strAdd1 = "0" & strAdd1
If Len(strAdd2) < 2 Then strAdd2 = "0" & strAdd2
If Len(strAdd3) < 2 Then strAdd3 = "0" & strAdd3
If Len(strAdd4) < 2 Then strAdd4 = "0" & strAdd4
If Len(strAdd1) > 2 Then Error 5 ' Argument invalide
If Len(strAdd2) > 2 Then Error 5
If Len(strAdd3) > 2 Then Error 5
If Len(strAdd4) > 2 Then Error 5
vbInet_Addr = CLng("&h" & strAdd4 & strAdd3 & strAdd2 & strAdd1)
End Function
</CODE>
--
a+
Gloubi
http://users.skynet.be/mpfa/
Bonjour,
"marcel"
| Bonjour, je désire pouvoir exécuter l'équivalent du ping sous access
<snip>
| existe t'il une manière d'exécuter l'équivalent du ping dans du code
access
| Merci à vous je sèche
| Marcel
<CODE>
Option Compare Database
Option Explicit
Type IP_OPTION_INFORMATION
TTL As Byte ' Time to Live (used for traceroute)
Tos As Byte ' Type of Service (usually 0)
Flags As Byte ' IP header Flags (usually 0)
OptionsSize As Long ' Size of Options data (usually 0, max
40)
OptionsData As String * 128 ' Options data buffer
End Type
Type IP_ECHO_REPLY
Address(0 To 3) As Byte ' Replying Address
Status As Long ' Reply Status
RoundTripTime As Long ' Round Trip Time in milliseconds
DataSize As Integer ' reply data size
Reserved As Integer ' for system use
data As Long ' pointer to echo data
Options As IP_OPTION_INFORMATION ' Reply Options
End Type
Declare Function IcmpCreateFile Lib "ICMP" () As Long
Declare Function IcmpSendEcho Lib "ICMP" ( _
ByVal IcmpHandle As Long, _
ByVal DestAddress As Long, _
ByVal RequestData As String, _
ByVal RequestSize As Integer, _
RequestOptns As IP_OPTION_INFORMATION, _
ReplyBuffer As IP_ECHO_REPLY, _
ByVal ReplySize As Long, _
ByVal TimeOut As Long _
) As Boolean
Declare Function IcmpCloseHandle Lib "ICMP" ( _
ByVal HANDLE As Long _
) As Boolean
' Usage : Retour = vbPing "207.46.130.14", 16, 2000
' Avec : "207.46.130.14" Adresse que l'on veut pinguer
' 16 : TTL de la socket ICMP (en gros, le NB max de routeurs a
traverser.Utile
' lors d'un traceroute...
' 2000 : Timeout en millisecondes.
Function vbPing(IPAddress As String, TTL As Integer, TimeOut As Integer)
As Long
Dim bRC As Boolean
Dim Buff As String
Dim RespHost As String
Dim hIP As Long
Dim addr As Long
Dim IP_OPT As IP_OPTION_INFORMATION
Dim IP_REP As IP_ECHO_REPLY
Dim OldPointer As Long
OldPointer = Screen.MousePointer
''Screen.MousePointer = vbHourglass
' Ouverture de la DLL ICMP
hIP = IcmpCreateFile()
If hIP = 0 Then
vbPing = -1&
Screen.MousePointer = OldPointer
Exit Function
End If
' Convertion IPAddress Dotted-Decimal IP en Long
addr = vbInet_Addr(IPAddress)
If addr = -1 Then
vbPing = -1&
Screen.MousePointer = OldPointer
Exit Function
End If
' Initialisation du Buffer a 64 caractères
Buff = Space(64)
' Initialisation des options TCP/IP
IP_OPT.TTL = TTL
IP_OPT.Tos = 8
' Envoie du PING
bRC = IcmpSendEcho(hIP, addr, Buff, Len(Buff) _
, IP_OPT, IP_REP, Len(IP_REP) + 8, TimeOut)
' Traite la réponse
If bRC Then
RespHost = ""
' Convertion IP Addresse en notation point.
RespHost = CStr(IP_REP.Address(0)) _
& "." & CStr(IP_REP.Address(1)) _
& "." & CStr(IP_REP.Address(2)) _
& "." & CStr(IP_REP.Address(3))
If IP_REP.Status = 0 Then
' l'hote testé à répondu
vbPing = IP_REP.RoundTripTime
Else
' Mauvaise réponse
vbPing = -1&
End If
Else
' TimeOut a été atteind sans réponse
vbPing = -1&
End If
' On Ferme ICMP.DLL
bRC = IcmpCloseHandle(hIP)
Screen.MousePointer = OldPointer
End Function
Private Function vbInet_Addr(strAddr As String) As Long
Dim pDot As Integer
Dim strTmp As String
Dim strAdd1 As String, strAdd2 As String
Dim strAdd3 As String, strAdd4 As String
strTmp = Trim(strAddr)
' Découpage des champs de l'adresse
pDot = InStr(strTmp, ".")
If pDot <> 0 Then
strAdd1 = Hex(Val(Left(strTmp, pDot - 1)))
strTmp = Mid(strTmp, pDot + 1)
Else
' Argument invalide
vbInet_Addr = -1
Exit Function
End If
pDot = InStr(strTmp, ".")
If pDot <> 0 Then
strAdd2 = Hex(Val(Left(strTmp, pDot - 1)))
strTmp = Mid(strTmp, pDot + 1)
Else
Error 5 ' Argument invalide
End If
pDot = InStr(strTmp, ".")
If pDot <> 0 Then
strAdd3 = Hex(Val(Left(strTmp, pDot - 1)))
strAdd4 = Hex(Val(Mid(strTmp, pDot + 1)))
Else
Error 5 ' Argument invalide
End If
If Len(strAdd1) < 2 Then strAdd1 = "0" & strAdd1
If Len(strAdd2) < 2 Then strAdd2 = "0" & strAdd2
If Len(strAdd3) < 2 Then strAdd3 = "0" & strAdd3
If Len(strAdd4) < 2 Then strAdd4 = "0" & strAdd4
If Len(strAdd1) > 2 Then Error 5 ' Argument invalide
If Len(strAdd2) > 2 Then Error 5
If Len(strAdd3) > 2 Then Error 5
If Len(strAdd4) > 2 Then Error 5
vbInet_Addr = CLng("&h" & strAdd4 & strAdd3 & strAdd2 & strAdd1)
End Function
</CODE>
--
a+
Gloubi
http://users.skynet.be/mpfa/
