[VB6] détection d'accès a internet via un réseau [Trucs & Astuces]

**maddog2032** · 07/11/2003, 15h36

Bonjour! Je souhaiterai savoir comment vérifier constament (ou presque) qu'un PC à accès à internet via un réseau.. Merci pour vos réponses!
(Tester une adresse internet à intervales réguliers fait lager l'application..)

**elifqaoui** · 07/11/2003, 15h46

Merci d'utiliser la Fonction Recherche avancée du forum !!! avec le mot PING

**maddog2032** · 07/11/2003, 15h56

c'est peut être parce que je ne trouve rien avec la recherche avancée que je pose ma question...

Le test ping est justement ce que je ne veux pas...

**elifqaoui** · 07/11/2003, 16h14

Envoyé par maddog2032

(Tester une adresse internet )

quel autre moyen existe que le ping

**grafikm_fr** · 08/11/2003, 18h17

Il y a un autre moyen:

Piqué sur http://perso.wanadoo.fr/alain.defraeye/pages/tlch/codes_en_vrac.htm (je conseille de mettre ce site dans les favoris

)

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
 
Détecter une connexion internet
 
Dans un module :
Declarations
 
Public Const ERROR_SUCCESS = 0&
Public Const APINULL = 0&
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public ReturnCode As Long
 
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal _
hKey As Long) As Long
 
Declare Function RegOpenKey Lib "advapi32.dll" Alias _
"RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As _
String, phkResult As Long) As Long
 
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName _
As String, ByVal lpReserved As Long, lpType As Long, _
lpData As Any, lpcbData As Long) As Long
 
Code
 
Public Function ActiveConnection() As Boolean
Dim hKey As Long
Dim lpSubKey As String
Dim phkResult As Long
Dim lpValueName As String
Dim lpReserved As Long
Dim lpType As Long
Dim lpData As Long
Dim lpcbData As Long
ActiveConnection = False
lpSubKey = "SystemCurrentControlSetServicesRemoteAccess"
ReturnCode = RegOpenKey(HKEY_LOCAL_MACHINE, lpSubKey, _
phkResult)
 
If ReturnCode = ERROR_SUCCESS Then
    hKey = phkResult
    lpValueName = "Remote Connection"
    lpReserved = APINULL
    lpType = APINULL
    lpData = APINULL
    lpcbData = APINULL
    ReturnCode = RegQueryValueEx(hKey, lpValueName, _
    lpReserved, lpType, ByVal lpData, lpcbData)
    lpcbData = Len(lpData)
    ReturnCode = RegQueryValueEx(hKey, lpValueName, _
    lpReserved, lpType, lpData, lpcbData)
 
    If ReturnCode = ERROR_SUCCESS Then
        If lpData = 0 Then
            ActiveConnection = False
        Else
            ActiveConnection = True
        End If
    End If
RegCloseKey (hKey)
End If
 
End Function
 
 
Dans une form :
If ActiveConnection = True then
    Call MsgBox("You have an active connection.",vbInformation)
Else
    Call MsgBox("You have no active connections.", vbInformation)
End If

**maddog2032** · 10/11/2003, 12h31

Je te remercie beaucoup !!!

**maddog2032** · 11/11/2003, 11h07

j'ai un petit problème en fait! ERROR_SUCCESS n'est jamais égal à ReturnCode ... même si la connection est active! (je suis sous XP)

**WOLO Laurent** · 11/11/2003, 13h15

Ping un site bien connu par exemple et observe la reponse :
Un exemple valant mieux qu'un long discours (Tiré de AllAPI )

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
Const SOCKET_ERROR = 0
Private Type WSAdata
    wVersion As Integer
    wHighVersion As Integer
    szDescription(0 To 255) As Byte
    szSystemStatus(0 To 128) As Byte
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpVendorInfo As Long
End Type
Private Type Hostent
    h_name As Long
    h_aliases As Long
    h_addrtype As Integer
    h_length As Integer
    h_addr_list As Long
End Type
Private Type IP_OPTION_INFORMATION
    TTL As Byte
    Tos As Byte
    Flags As Byte
    OptionsSize As Long
    OptionsData As String * 128
End Type
Private Type IP_ECHO_REPLY
    Address(0 To 3) As Byte
    Status As Long
    RoundTripTime As Long
    DataSize As Integer
    Reserved As Integer
    data As Long
    Options As IP_OPTION_INFORMATION
End Type
Private Declare Function GetHostByName Lib "wsock32.dll" Alias "gethostbyname" (ByVal HostName As String) As Long
Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired&, lpWSAdata As WSAdata) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal HANDLE As Long) As Boolean
Private 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
Private Sub Form_Load()
    'KPD-Team 2000
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Const HostName = "www.allapi.net"
    Dim hFile As Long, lpWSAdata As WSAdata
    Dim hHostent As Hostent, AddrList As Long
    Dim Address As Long, rIP As String
    Dim OptInfo As IP_OPTION_INFORMATION
    Dim EchoReply As IP_ECHO_REPLY
    Call WSAStartup(&H101, lpWSAdata)
    If GetHostByName(HostName + String(64 - Len(HostName), 0)) <> SOCKET_ERROR Then
        CopyMemory hHostent.h_name, ByVal GetHostByName(HostName + String(64 - Len(HostName), 0)), Len(hHostent)
        CopyMemory AddrList, ByVal hHostent.h_addr_list, 4
        CopyMemory Address, ByVal AddrList, 4
    End If
    hFile = IcmpCreateFile()
    If hFile = 0 Then
        MsgBox "Unable to Create File Handle"
        Exit Sub
    End If
    OptInfo.TTL = 255
    If IcmpSendEcho(hFile, Address, String(32, "A"), 32, OptInfo, EchoReply, Len(EchoReply) + 8, 2000) Then
        rIP = CStr(EchoReply.Address(0)) + "." + CStr(EchoReply.Address(1)) + "." + CStr(EchoReply.Address(2)) + "." + CStr(EchoReply.Address(3))
    Else
        MsgBox "Timeout"
    End If
    If EchoReply.Status = 0 Then
        MsgBox "Reply from " + HostName + " (" + rIP + ") recieved after " + Trim$(CStr(EchoReply.RoundTripTime)) + "ms"
    Else
        MsgBox "Failure ..."
    End If
    Call IcmpCloseHandle(hFile)
    Call WSACleanup
End Sub

Vous allez l'amander un peu.

**grafikm_fr** · 11/11/2003, 15h29

WOLO Laurent >> , c'est top cool, mais y a un pb...

Le ping tout seul ne suffit pas pour detecter une connection vers Internet via un réseau. Si t'es derriere un FW, tu pourra pas pinger un site aussi connu soit-il (ca m'est arrivé), alors que tu peux acceder au Web. C'est pour ca que la solution que j'ai proposé ci-dessus est en un sens plus efficace (elle detecte une eventuelle connection internet reconnue par Windows), à condition bien sur de faire marcher le code en question

maddog2032 >> Je vais fouiller ce code pour voir. Effectivement, il n'est peut-etre pas compatible XP...

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

Bon, voila le topo:

Je sais pas ou le gars en question a peché son code, mais il a effectivement pas l'air de marcher sur tout ce qui depasse Win98 (et encore, pas sur)

Je pense donc que la bonne idée, plutot que de faire un ping, est de tester une connection Internet à un site Web exterieur via le port 80 (ce qu'a priori le FW accepte, il est fait pour...).

Il faut faire ca avec un petit controle Winsock.
J'ai un bon bout de code qui fait ca, mais je l'ai pas actuellement, si ca interesse toujours quelqu'un, je peux le deterrer...

Grafikm

**WOLO Laurent** · 11/11/2003, 16h52

Envoyé par grafikm_fr

WOLO Laurent >> , c'est top cool, mais y a un pb...
Le ping tout seul ne suffit pas pour detecter une connection vers Internet via un réseau. Si t'es derriere un FW, tu pourra pas pinger un site aussi connu soit-il (ca m'est arrivé), alors que tu peux acceder au Web.

Si tu ton firewall ne laisse pas passer un ping, il est fort à parier que ton acces web ne marchera pas puisses que ping fait le teste de connectivité.

**grafikm_fr** · 11/11/2003, 16h55

Et non...
J'etais recemment pendant 3 mois dans une boite ou j'etais incapable de pinger le moindre serveur exterieur et pourtant je pouvais aller partout sur Internet.

Ping teste la connectivité, oui, mais avec ICMP.
La connection HTTP Web passe par TCP/IP, ce n'est donc pas la meme chose...

Sans oublier que beaucoup de grands sites Web désacivent le port echo pour eviter de se prendre un flood ou un massteardrop sur la tronche...

**maddog2032** · 12/11/2003, 02h44

Je me disais bien que kkchose ne marchait pas !! Je serai assez interressé par ce controle Winsock !

**maddog2032** · 14/11/2003, 16h24

Le code que tu m'avais donné Laurent, fonctionne très bien mais derrière un routeur(wanadoo) il semble ne pas marcher ! Est ce que tu saurais pourquoi ?

**WOLO Laurent** · 14/11/2003, 18h14

C'est évident surtout quand il s'agit d'un routeur NAT (Network Adresses Translation) ou PAT (Port Adress Translation) puis que le routeur change automatiquement soit le port soit l'adresse du site en agissant comme un Firewall !

**grafikm_fr** · 14/11/2003, 18h53

Meme tout betement, si l'ICMP est desactivé, ca marchera pas...

Bref, je pense qu'il faudrait passer par une lecture d'une page Web d'un serveur connu... Faut que je pense a deterrer le code

**maddog2032** · 18/11/2003, 20h18

Ah ok! C'est donc tout a fait normal que ça ne marche pas!! Oui je serais assez interessé par ce code

**maddog2032** · 19/11/2003, 02h04

Je voudrai savoir aussi s'il y a un moyen d'empecher de produire un lag a chaque vérification du net ?

**grafikm_fr** · 19/11/2003, 14h11

Il faut passer par les threads ou alors mettre plein de DoEvents au milieu... Mais bon, c'est normal que ca lag, le temps qu'il teste la connexion... Tu peux faire ca au demarrage de l'appli avec le splashscreen, 2 secondes au lancement c'est qd meme pas des masses....