[vb6] Ping [FAQ]

**demercel** · 12/09/2003, 11h52

j'aurais enffectuer un ping sur un pc distant et connaitre son état : ouvert ou fermer?

Oui, mais comment faire?
Quel est son code?

**grafikm_fr** · 12/09/2003, 11h56

Et rechercher les posts sur le sujet, c'est quoi?

http://www.developpez.net/forums/vie...highlight=ping

**ThierryAIM** · 12/09/2003, 11h59

le seul hic, c'est que le lien dans ce topic n'existe plus

**benoist** · 12/09/2003, 12h03

Il va bien falloir que l'on écrive un morceau de Faq sur ce sujet. Il reviens presque toute les semaines.

**ThierryAIM** · 12/09/2003, 12h08

Envoyé par benoist

Il va bien falloir que l'on écrive un morceau de Faq sur ce sujet. Il reviens presque toute les semaines.

Ne te genes sourtout pas http://www.developpez.net/forums/viewtopic.php?t=88677

**grafikm_fr** · 12/09/2003, 12h45

J'ai bien un bout de code, mais y a un copyright dessus, et on peut pas le publier sans permission de l'auteur...

http://www.mvps.org/vbnet/index.html?code/internet/ping.htm

Alors bon, je sais pas comment faire

**bhaal76** · 15/09/2003, 11h48

aller, va, je le remets ...

dans un module

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
Option Explicit
 
Public Const IP_STATUS_BASE = 11000
Public Const IP_SUCCESS = 0
Public Const IP_BUF_TOO_SMALL = (11000 + 1)
Public Const IP_DEST_NET_UNREACHABLE = (11000 + 2)
Public Const IP_DEST_HOST_UNREACHABLE = (11000 + 3)
Public Const IP_DEST_PROT_UNREACHABLE = (11000 + 4)
Public Const IP_DEST_PORT_UNREACHABLE = (11000 + 5)
Public Const IP_NO_RESOURCES = (11000 + 6)
Public Const IP_BAD_OPTION = (11000 + 7)
Public Const IP_HW_ERROR = (11000 + 8)
Public Const IP_PACKET_TOO_BIG = (11000 + 9)
Public Const IP_REQ_TIMED_OUT = (11000 + 10)
Public Const IP_BAD_REQ = (11000 + 11)
Public Const IP_BAD_ROUTE = (11000 + 12)
Public Const IP_TTL_EXPIRED_TRANSIT = (11000 + 13)
Public Const IP_TTL_EXPIRED_REASSEM = (11000 + 14)
Public Const IP_PARAM_PROBLEM = (11000 + 15)
Public Const IP_SOURCE_QUENCH = (11000 + 16)
Public Const IP_OPTION_TOO_BIG = (11000 + 17)
Public Const IP_BAD_DESTINATION = (11000 + 18)
Public Const IP_ADDR_DELETED = (11000 + 19)
Public Const IP_SPEC_MTU_CHANGE = (11000 + 20)
Public Const IP_MTU_CHANGE = (11000 + 21)
Public Const IP_UNLOAD = (11000 + 22)
Public Const IP_ADDR_ADDED = (11000 + 23)
Public Const IP_GENERAL_FAILURE = (11000 + 50)
Public Const MAX_IP_STATUS = 11000 + 50
Public Const IP_PENDING = (11000 + 255)
Public Const PING_TIMEOUT = 200
Public Const WS_VERSION_REQD = &H101
Public Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Public Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Public Const MIN_SOCKETS_REQD = 1
Public Const SOCKET_ERROR = -1
 
Public Const MAX_WSADescription = 256
Public Const MAX_WSASYSStatus = 128
 
Public Type ICMP_OPTIONS
    Ttl             As Byte
    Tos             As Byte
    Flags           As Byte
    OptionsSize     As Byte
    OptionsData     As Long
End Type
 
Dim ICMPOPT As ICMP_OPTIONS
 
Public Type ICMP_ECHO_REPLY
    Address         As Long
    status          As Long
    RoundTripTime   As Long
    DataSize        As Integer
    Reserved        As Integer
    DataPointer     As Long
    Options         As ICMP_OPTIONS
    Data            As String * 250
End Type
 
Public Type HOSTENT
    hName As Long
    hAliases As Long
    hAddrType As Integer
    hLen As Integer
    hAddrList As Long
End Type
 
Public Type WSADATA
    wVersion As Integer
    wHighVersion As Integer
    szDescription(0 To MAX_WSADescription) As Byte
    szSystemStatus(0 To MAX_WSASYSStatus) As Byte
    wMaxSockets As Integer
    wMaxUDPDG As Integer
    dwVendorInfo As Long
End Type
 
 
Public Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
 
Public Declare Function IcmpCloseHandle Lib "icmp.dll" _
   (ByVal IcmpHandle As Long) As Long
 
Public Declare Function IcmpSendEcho Lib "icmp.dll" _
   (ByVal IcmpHandle As Long, _
    ByVal DestinationAddress As Long, _
    ByVal RequestData As String, _
    ByVal RequestSize As Integer, _
    ByVal RequestOptions As Long, _
    ReplyBuffer As ICMP_ECHO_REPLY, _
    ByVal ReplySize As Long, _
    ByVal Timeout As Long) As Long
 
Public Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
Public Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long
Public Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Public Declare Function gethostname Lib "WSOCK32.DLL" (ByVal szHost As String, ByVal dwHostLen As Long) As Long
Public Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal szHost As String) As Long
Public Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
 
Public Function GetStatusCode(status As Long) As String
 
   Dim msg As String
 
   Select Case status
      Case IP_SUCCESS:               msg = "ip success"
      Case IP_BUF_TOO_SMALL:         msg = "ip buf too_small"
      Case IP_DEST_NET_UNREACHABLE:  msg = "ip dest net unreachable"
      Case IP_DEST_HOST_UNREACHABLE: msg = "ip dest host unreachable"
      Case IP_DEST_PROT_UNREACHABLE: msg = "ip dest prot unreachable"
      Case IP_DEST_PORT_UNREACHABLE: msg = "ip dest port unreachable"
      Case IP_NO_RESOURCES:          msg = "ip no resources"
      Case IP_BAD_OPTION:            msg = "ip bad option"
      Case IP_HW_ERROR:              msg = "ip hw_error"
      Case IP_PACKET_TOO_BIG:        msg = "ip packet too_big"
      Case IP_REQ_TIMED_OUT:         msg = "ip req timed out"
      Case IP_BAD_REQ:               msg = "ip bad req"
      Case IP_BAD_ROUTE:             msg = "ip bad route"
      Case IP_TTL_EXPIRED_TRANSIT:   msg = "ip ttl expired transit"
      Case IP_TTL_EXPIRED_REASSEM:   msg = "ip ttl expired reassem"
      Case IP_PARAM_PROBLEM:         msg = "ip param_problem"
      Case IP_SOURCE_QUENCH:         msg = "ip source quench"
      Case IP_OPTION_TOO_BIG:        msg = "ip option too_big"
      Case IP_BAD_DESTINATION:       msg = "ip bad destination"
      Case IP_ADDR_DELETED:          msg = "ip addr deleted"
      Case IP_SPEC_MTU_CHANGE:       msg = "ip spec mtu change"
      Case IP_MTU_CHANGE:            msg = "ip mtu_change"
      Case IP_UNLOAD:                msg = "ip unload"
      Case IP_ADDR_ADDED:            msg = "ip addr added"
      Case IP_GENERAL_FAILURE:       msg = "ip general failure"
      Case IP_PENDING:               msg = "ip pending"
      Case PING_TIMEOUT:             msg = "ping timeout"
      Case Else:                     msg = "unknown  msg returned"
   End Select
   GetStatusCode = CStr(status) & "   [ " & msg & " ]"
End Function
 
Public Function HiByte(ByVal wParam As Integer)
    HiByte = wParam \ &H100 And &HFF&
End Function
 
Public Function LoByte(ByVal wParam As Integer)
    LoByte = wParam And &HFF&
End Function
 
Public Function Ping(szAddress As String, ECHO As ICMP_ECHO_REPLY) As Long
    Dim hPort As Long
    Dim dwAddress As Long
    Dim sDataToSend As String
    Dim iOpt As Long
 
    sDataToSend = "Echo This"
    dwAddress = AddressStringToLong(szAddress)
 
    Call SocketsInitialize
    hPort = IcmpCreateFile()
 
    If IcmpSendEcho(hPort, dwAddress, sDataToSend, Len(sDataToSend), 0, ECHO, Len(ECHO), PING_TIMEOUT) Then
        'le ping réussi,
        '.Status prend 0
        '.RoundTripTime le temps en ms pour que le ping soit complet,
        '.Data est la donnée retournée (NULL terminaison)
        '.Address l'adresse IP qu'il rappelle actuellement
        '.DataSize la taille de la chaine de caractère dans .Data
        Ping = ECHO.RoundTripTime
    Else
        Ping = ECHO.status * -1
    End If
    Call IcmpCloseHandle(hPort)
    Call SocketsCleanup
End Function
 
Function AddressStringToLong(ByVal tmp As String) As Long
    Dim i As Integer
    Dim parts(1 To 4) As String
 
    i = 0
    'nous devons extraire chaque parties de la chaine
    '123.456.789.123 , delimitée par une période
    While InStr(tmp, ".") > 0
        i = i + 1
        parts(i) = Mid(tmp, 1, InStr(tmp, ".") - 1)
        tmp = Mid(tmp, InStr(tmp, ".") + 1)
    Wend
    i = i + 1
    parts(i) = tmp
    If i <> 4 Then
        AddressStringToLong = 0
        Exit Function
    End If
    'construit une valeur de type long à travers un
    'type hex des chaines de caractères extraites
    AddressStringToLong = Val("&H" & Right("00" & Hex(parts(4)), 2) & Right("00" & Hex(parts(3)), 2) & Right("00" & Hex(parts(2)), 2) & Right("00" & Hex(parts(1)), 2))
End Function
 
Public Function SocketsCleanup() As Boolean
    Dim X As Long
 
    X = WSACleanup()
    If X <> 0 Then
        MsgBox "Erreur Windows Sockets " & Trim$(Str$(X)) & " survenue dans le CleanUp.", vbExclamation
        SocketsCleanup = False
    Else
        SocketsCleanup = True
    End If
End Function
 
Public Function SocketsInitialize() As Boolean
    Dim WSAD As WSADATA
    Dim X As Integer
    Dim szLoByte As String, szHiByte As String, szBuf As String
 
    X = WSAStartup(WS_VERSION_REQD, WSAD)
    If X <> 0 Then
        MsgBox "Windows Sockets pour environnements Windows 32 bits" & "ne répond pas correctement."
        SocketsInitialize = False
        Exit Function
    End If
 
    If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then
        szHiByte = Trim$(Str$(HiByte(WSAD.wVersion)))
        szLoByte = Trim$(Str$(LoByte(WSAD.wVersion)))
        szBuf = "Windows Sockets Version " & szLoByte & "." & szHiByte
        szBuf = szBuf & " n'est pas supporté par Windows " & "Sockets pour les environnements Windows 32 bit."
        MsgBox szBuf, vbExclamation
        SocketsInitialize = False
        Exit Function
    End If
 
    If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
        szBuf = "Cette application requière un minimum de " & Trim$(Str$(MIN_SOCKETS_REQD)) & " sockets supportés."
        MsgBox szBuf, vbExclamation
        SocketsInitialize = False
        Exit Function
    End If
    SocketsInitialize = True
End Function

puis lorsque je veux l'utiliser ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
    Dim ECHO As ICMP_ECHO_REPLY
        ' test sur ping
        ' ping une adresse ip, passe une adresse et la structure ECHO
        Call Ping(addresse_ip, ECHO)
        If (GetStatusCode(ECHO.status) = "0   [ ip success ]") Then
            ' connection établi
        Else
            ' connection non établi
        End If

je crois que j'ai tout mis, a vérifier

**grafikm_fr** · 16/09/2003, 10h55

Oui, c'etait bien ce que j'ai indiqué juste au-dessus.
J'ai trouvé la source de ce module

**bhaal76** · 16/09/2003, 11h24

sauf que ce n'est pas sur ce site que j'ai trouvé ce module, d'ou la question ...

QUI EN EST L'AUTEUR ???

faudrai que je retrouve le site original ...

**grafikm_fr** · 16/09/2003, 11h30

Le code que j'ai est (c) VBNet-Randy Birch, Unknown Source...
Mais je pense que ce code est vieux comme le monde (ou plutot comme VB4

), et que tout le monde a oublié qui en est l'auteur...

[vb6] Ping [FAQ]

VB 6 et antérieur

Discussions similaires

Partager

Partager