[Delphi 6] Comment détecter si un poste est connecté ?

**Lung** · 25/03/2005, 17h28

Comment détecter (de manière simple, si possible) si un poste est connecté à un réseau ?

J'ai testé les différentes solutions que j'ai trouvé sur le forum, mais toutes continuent de me dire que je suis connecté quand je débranche le cable réseau ...

Quelqu'un aurait-il une solution ?

**/dev/null** · 25/03/2005, 17h49

Tu devrait pouvoir essayer un ping ver la passerelle par defaut... si il ne repond pas... c'est sans doute que tu n'es pas connecter au réseau...
C'est vraie que windows peut te prévenir quand il y a le cable qui est débranché... mais je ne sais pas comment il fait... a tu regarder sur le MSDN ?

**Sub0** · 25/03/2005, 23h08

Je sais détecter si un on est connecté à internet ou non, cela te convient-il ?
Sinon, je pense tout simplement en utilisant un TClientSocket...
Le composant dispose d'évènements spécialement étudiés pour :
OnConnect, OnConnecting, OnDisconnect, OnError, etc...

à+

**Sub0** · 25/03/2005, 23h56

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
Uses registry;
 
 
Function IfConnected: Boolean;
Var
  reg: TRegistry;
  buff: dword;
Begin
  Try
    reg := tregistry.Create;
    Reg.RootKey := HKey_local_machine;
    If reg.OpenKey('\System\CurrentControlSet\Services\RemoteAccess', false) Then
    Begin
      reg.ReadBinaryData('Remote Connection', buff, sizeof(buff));
      result := buff = 1;
      reg.CloseKey;
    End
  Finally
    reg.Free;
  End;
End;

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Uses WinInet;
 
 
Function TestConnect: Boolean;
Var
  dwFlags: DWord;
Begin
  dwFlags := INTERNET_CONNECTION_MODEM Or
    INTERNET_CONNECTION_LAN Or
    INTERNET_CONNECTION_PROXY;
  Result := InternetGetConnectedState(@dwFlags, 0);
End;

**lil_jam63** · 26/03/2005, 02h15

Regarde du côté de l'API icmpSendEcho()

**lil_jam63** · 26/03/2005, 02h35

J'ai trouvé une procedure sur le net et que j'ai légèrement modifié pour qu'elle puisse renvoyer un résultat, j'ai testé sur mon pc et une adresse différente, ça fonctionne, ça devrait l'être également pour toi.

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
 
uses
  winsock;
 
type
  PIPOptionInfo = ^TIPOptionInfo;
  TIPOptionInfo = packed record
    TTL: Byte;
    TOS: Byte;
    Flags: Byte;
    OptionsSize: Byte;
    OptionsData: PChar;
  end;
 
  PIcmpEchoReply = ^TIcmpEchoReply;
  TIcmpEchoReply = packed record
    Address: DWORD;
    Status: DWORD;
    RTT: DWORD;
    DataSize: Word;
    Reserved: Word;
    Data: Pointer;
    Options: TIPOptionInfo;
  end;
 
  TIcmpCreateFile = function: THandle; stdcall;
  TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean; stdcall;
  TIcmpSendEcho = function(IcmpHandle:THandle; DestinationAddress:DWORD;
       RequestData:Pointer; RequestSize:Word; RequestOptions:PIPOptionInfo;
       ReplyBuffer:Pointer; ReplySize:DWord; Timeout:DWord):DWord; stdcall;
var
    hICMPDll,hICMP:THandle;
  wsaData:TWSADATA;
  ICMPCreateFile:TICMPCreateFile;
  IcmpCloseHandle:TIcmpCloseHandle;
  IcmpSendEcho:TIcmpSendEcho;
 
/******************************************************/
function CheckOnline(destip:string): boolean;
var
  IPOpt:TIPOptionInfo;
  IPAddr:DWORD;
  pReqData,pRevData:PChar;
  pIPE:PIcmpEchoReply;
  FSize: DWORD;
  MyString:string;
  FTimeOut:DWORD;
  BufferSize:DWORD;
  i:integer;
begin
  hICMPdll := LoadLibrary('icmp.dll');
  if hICMPDll<>NULL then
  begin
    WSAStartup($101,wsaData);
    @ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile');
    @IcmpCloseHandle := GetProcAddress(hICMPdll, 'IcmpCloseHandle');
    @IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho');
    hICMP := IcmpCreateFile;
    IPAddr:= inet_addr(PChar(destip));
 
    FSize := 40;
    BufferSize := SizeOf(TICMPEchoReply) + FSize;
    GetMem(pRevData,FSize);
    GetMem(pIPE,BufferSize);
    FillChar(pIPE^, SizeOf(pIPE^), 0);
    pIPE^.Data := pRevData;
    MyString := 'Hi, OnLine?';
    pReqData := PChar(MyString);
    FillChar(IPOpt, Sizeof(IPOpt), 0);
    IPOpt.TTL := 64;
    FTimeOut := 500;
    i:=IcmpSendEcho(hICMP, IPAddr, pReqData, Length(MyString), @IPOpt, pIPE, BufferSize, FTimeOut);
    Result := (i <> 0);
    FreeMem(pRevData);
    FreeMem(pIPE);
    IcmpCloseHandle(hicmp);
    FreeLibrary(hICMPdll);
    WSAcleanup();
  end;
end;
/******************************************************/
procedure TForm1.Button1Click(Sender: TObject);
begin
  if CheckOnline(edit1.Text) then showmessage('ordinateur connecté !')
    else showmessage('Ordinateur absent !');
end;

**Lung** · 29/03/2005, 08h50

Sub0 >> IfConnected me renvoit toujours faux, et TestConnect me renvoit toujours vrai ...
Y a t'il quelque chose de particulier à faire ?

**Lung** · 29/03/2005, 08h54

Envoyé par lil_jam63

Regarde du côté de l'API icmpSendEcho()

J'ai regardé :

Envoyé par msdn

IcmpCreateFile
Requirements
Client Requires Windows XP or Windows 2000 Professional.

Ca me gène car ma détection de réseau était aussi destinée aux vieux postes en NT qui mettent mille ans à se rendre compte qu'il n'y a pas de réseau.

Sinon, merci pour ton code, mais je n'arrive pas à le faire fonctionner. J'ai toutes les déclarations qui ne sont pas connues :

Code :

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

1
2
3
4
5
6
7
8
9
  ICMPCreateFile:TICMPCreateFile;
  IcmpCloseHandle:TIcmpCloseHandle;
  IcmpSendEcho:TIcmpSendEcho;
 
TIcmpCreateFile = function: THandle; stdcall;
  TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean; stdcall;
  TIcmpSendEcho = function(IcmpHandle:THandle; DestinationAddress:DWORD;
       RequestData:Pointer; RequestSize:Word; RequestOptions:PIPOptionInfo;
       ReplyBuffer:Pointer; ReplySize:DWord; Timeout:DWord):DWord; stdcall;

Il faut des bibliothèques particulières ?
La MSDN parle de la bibliothèque Iphlpapi, mais je ne l'ai pas.

**Lung** · 29/03/2005, 09h12

Bon, j'ai trouvé ca :
http://www.codenet.ru/progr/delphi/stat/ping.php

Et ca s'exécute.
Mais, ca me donne toujours le même résultat.
J'ai du mal à comprendre, ce que font toutes ces API.
Un peu d'explication ne serait pas de refus.

Sinon, pour fonctionner, il faut forcément fournir une adresse IP.
Mais pour quelqu'un à l'étranger ou à l'autre bout de la France, pinger un serveur va mettre très longtemps (avant d'échouer) !?

:

**/dev/null** · 29/03/2005, 09h34

Envoyé par Lung

J'ai du mal à comprendre, ce que font toutes ces API.
Un peu d'explication ne serait pas de refus.

Je n'ai pas encore regarder... donc je ne peut pas t'en dire grand chose

, a aprt que le russe, grec, langage pas latin... j'ai du mal

Envoyé par Lung

Mais pour quelqu'un à l'étranger ou à l'autre bout de la France, pinger un serveur va mettre très longtemps (avant d'échouer) !?

Le ping sera abandonné quand le timeout de la requête sera atteind... Si tu le met sur 30s... ce qui est largement suffisant

, au boud de 30s on sais s'il y'a un echec

**Lung** · 29/03/2005, 10h08

Envoyé par /dev/null

Le ping sera abandonné quand le timeout de la requête sera atteind... Si tu le met sur 30s... ce qui est largement suffisant

, au boud de 30s on sais s'il y'a un echec

Ca ne me convient pas du tout.
Mon but est de détecter quasi-immédiatement, si on est relié à un réseau.
Je m'explique :
Actuellement, j'ai un TDatabase qui cherche à se connecter à une base Oracle au démarrage. S'il n'y a pas de réseau, pas de connexion.
Le problème, c'est que ca mets longtemps (voire très longtemps) à voir comprendre qu'il n'y a pas de réseau. Pendant ce temp-là, l'utilisateur attend et ne peut pas travailler.
C'est pour cette raison que je cherche un moyen de détecter la présence d'un réseau, quasi-instantannément.

**Lung** · 29/03/2005, 10h14

Envoyé par /dev/null

Tu devrait pouvoir essayer un ping ver la passerelle par defaut... si il ne repond pas... c'est sans doute que tu n'es pas connecter au réseau...
C'est vraie que windows peut te prévenir quand il y a le cable qui est débranché... mais je ne sais pas comment il fait... a tu regarder sur le MSDN ?

Je n'avais pas vu ce post.

Je teste ...

**Lung** · 29/03/2005, 10h31

Bon, avec l'IP de la passerelle, ca ne fonctionne pas.

J'ai bien ca sous la main, mais c'est barbare :

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
procedure GetConsoleText(Command:String; var Result:String);
const
     LENBUFF = 512; // Augmente le si tu as des problèmes
var
   hReadPipe, hWritePipe: THandle;
   sa : TSecurityAttributes;
   si : TStartupInfo;
   pi : TProcessInformation;
   lpBuffer    : array[0..LENBUFF] of char;
   BytesRead   : Cardinal;
   BytesToRead : integer;
begin
     sa.nLength              := sizeof( sa );
     sa.lpSecurityDescriptor := nil;
     sa.bInheritHandle       := True;
 
     if not CreatePipe( hReadPipe, hWritePipe, @sa, 0 ) then begin
        Application.MessageBox( pChar('Error creation Pipe' ), 'Error',IDOK );
        exit;
     end;
 
     FillChar( si, sizeof(si), 0 );
     si.cb          := sizeof( si );
     si.dwFlags     := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
     si.wShowWindow := SW_HIDE;
     si.hStdInput   := 0;
     si.hStdOutput  := hWritePipe;
     si.hStdError   := hWritePipe;
 
     if not CreateProcess( nil, pChar( Command ), nil, nil, true, 0, nil, nil, si, pi ) then begin
        Application.MessageBox( pChar('Error executing command' ), 'Error', IDOK );
        CloseHandle( hReadPipe );
        CloseHandle( hWritePipe );
        exit;
     end;
 
     CloseHandle( hWritePipe );
     BytesToRead := LENBUFF;
     BytesRead := 0;
 
    Result := '';
     While (True) do begin
           lpBuffer := '';
           ReadFile( hReadPipe, lpBuffer, BytesToRead, BytesRead, nil );
           if BytesRead=0 then Break;
           Result := Result + StrPas(lpBuffer);
     end;
 
     WaitForSingleObject( pi.hProcess, INFINITE );
     CloseHandle( pi.hProcess );
     CloseHandle( hReadPipe );
end;

Une autre idée ... ?

**/dev/null** · 29/03/2005, 10h46

Tu lance un 'ping -t' sur le serveur qui contient ta base de donné. De cette façon, tu peut savoir, lors de l'arret de la commande, quel est le temp moyen, et le temp maximum de ce ping.
Tu indique la valeur maximal du ping comme time out... avec un ligne ADSL (donc en sortant vers le Weird) j'obtien, par ex, 1200 ms max pour pinger google... en réseau local ça devrait être de lordre d'un millième de seconde... donc... tu peut, en cas de doute, lancer 3 ping d'affiler suite au time out... ça fait trois milliseconde sur un reseau local... ça devrais être onorable

**Lung** · 29/03/2005, 12h00

Avec cette fonction http://www.codenet.ru/progr/delphi/stat/ping.php, ca ne veux pas fonctionner avec d'autre IP que la mienne.

Je reviens au point de départ.

**lil_jam63** · 29/03/2005, 12h58

Pour revenir au code que je t'ai proposé, il faut que tu déclares les fonctions dans la partie interface ( à la suite de type ), sinon elle ne seront pas connu par la suite. Il ne faut pas d'unité particulière car ce sont des fonctions qu'exporte 'icmp.dll', c'est juste une déclaration.

**Lung** · 29/03/2005, 14h43

Envoyé par lil_jam63

Pour revenir au code que je t'ai proposé, il faut que tu déclares les fonctions dans la partie interface ( à la suite de type ), sinon elle ne seront pas connu par la suite. Il ne faut pas d'unité particulière car ce sont des fonctions qu'exporte 'icmp.dll', c'est juste une déclaration.

D'accord. Là ca fonctionne.

Mais, ca me dit ordinateur connecté même avec le cable réseau débranché.

**qi130** · 29/03/2005, 15h16

J'ai trouvé ceci :

Envoyé par Scalabium

If you want to know if the PC is connected to a network under MS Windows then you can call a GetSystemMetrics() function (Windows API) with SM_NETWORK parameter:

Code :

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

1
2
3
4
5
 
if (GetSystemMetrics(SM_NETWORK) AND $01 = $01) then
    <PC is attached to network>
else
    <PC is not attached to network>

http://www.scalabium.com/faq/dct0041.htm

**Lung** · 29/03/2005, 15h22

Envoyé par qi130

J'ai trouvé ceci :

Envoyé par Scalabium

If you want to know if the PC is connected to a network under MS Windows then you can call a GetSystemMetrics() function (Windows API) with SM_NETWORK parameter:

Code :

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

1
2
3
4
5
 
if (GetSystemMetrics(SM_NETWORK) AND $01 = $01) then
    <PC is attached to network>
else
    <PC is not attached to network>

Je la connaissais déjà.

Et à partir du moment où il y a une carte réseau dans le PC, elle renvoit vrai.

**Sub0** · 29/03/2005, 21h31

Je reviens à la charge... ^^

http://www.developpez.net/forums/viewtopic.php?t=221640

...

[Delphi 6] Comment détecter si un poste est connecté ?

Web & réseau Delphi

Discussions similaires

Partager

Partager