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

**Lung** · 14/04/2005, 17h42

Envoyé par Sub0

Alors ? Ça fonctionne ?

Non ...

Mon thread ne s'exécute pas en parallèle.

Envoyé par Sub0

Perso, je ne me sers pas souvent du composant Thread, j'utilise soit un Timer, soit une simple boucle du genre :

Code :

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

1
2
3
4
5
Repeat
  // <- Mon traitement ici -> //
  Application.ProcessMessages;
  Sleep(250);
Until (Condition);

Par contre, ton code, je ne le comprend pas du tout.
Je ne vois pas comment je peux faire (ou même simuler) 2 choses en parallèle.

**Lung** · 14/04/2005, 17h45

Mon thread :

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
unit UnitThreadTestReseau;
 
interface
 
uses
  Classes, SysUtils, Dialogs, Windows;
 
type
  TThreadTestReseau = class(TThread)
  private
    procedure TestReseau;
 
  protected
    procedure Execute;   override;
 
  public
    constructor Create(CreateSuspended: Boolean);
  end;
 
implementation
 
uses Main;
 
{ ThreadTestReseau }
 
constructor TThreadTestReseau.Create(CreateSuspended: Boolean);
begin
   FreeOnTerminate := True;
   inherited Create(CreateSuspended);
end;
 
procedure TThreadTestReseau.Execute;
begin
   try
      while not Terminated do
         Synchronize(TestReseau);
   except
      on E: Exception do
      begin
         MessageDlg('.Erreur :  ' + E.Message, mtError, [mbOK], 0);
      end;
   end;
end;
 
procedure TThreadTestReseau.TestReseau;
   procedure GetConsoleText(const szCommande: String; var szResult: String);
   const
      LENBUFF = 512;      //.Augmenter si problème.
   var
      hReadPipe, hWritePipe: THandle;
      sa: TSecurityAttributes;
      si: TStartupInfo;
      pi: TProcessInformation;
      lpBuffer: Array[0..LENBUFF] of char;
      nBytesRead: Cardinal;
      nBytesToRead: Integer;
   begin
      sa.nLength := Sizeof(sa);
      sa.lpSecurityDescriptor := nil;
      sa.bInheritHandle := True;
 
      if not CreatePipe(hReadPipe, hWritePipe, @sa, 0) then
      begin
         MessageDlg('.Erreur :  la création du pipe a échoué !', mtError, [mbOK], 0);
         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(szCommande), nil, nil, True, 0, nil, nil, si, pi) then
      begin
         MessageDlg('.Erreur :  l''exécution de la commande a échoué !', mtError, [mbOK], 0);
         CloseHandle(hReadPipe);
         CloseHandle(hWritePipe);
         Exit;
      end;
 
      CloseHandle(hWritePipe);
      nBytesToRead := LENBUFF;
      nBytesRead := 0;
 
      szResult := '';
      while(True) do
      begin
         lpBuffer := '';
         ReadFile(hReadPipe, lpBuffer, nBytesToRead, nBytesRead, nil);
         if nBytesRead = 0 then
            Break;
         szResult := szResult + StrPas(lpBuffer);
      end;
 
      WaitForSingleObject(pi.hProcess, INFINITE);
      CloseHandle(pi.hProcess);
      CloseHandle(hReadPipe);
   end;
var
   szResult: String;
begin
   //.Test du réseau.
   GetConsoleText('tnsping ' + MainForm.DatabaseOracle.Params.Values['SERVER NAME'], szResult);
 
   //.Si réseau.
   if Pos('OK ', szResult) > 0 then
   begin
      if not MainForm._Result.bTimeOut then
      begin
         MainForm._Result.bTimeOut := True;
         MainForm._Result.bReseau := True;
      end;
   end
   else      //.Pas de réseau.
   begin
      if not MainForm._Result.bTimeOut then
      begin
         MainForm._Result.bTimeOut := True;
         MainForm._Result.bReseau := False;
      end;
   end;
 
   Terminate;
end;
 
end.

**/dev/null** · 14/04/2005, 18h05

Avec ce thread, un Timer sur la form principal initialise sur 1000ms met 30s a s'éxécuter ?

**Lung** · 14/04/2005, 18h16

Envoyé par /dev/null

Avec ce thread, un Timer sur la form principal initialise sur 1000ms met 30s a s'éxécuter ?

Oui.

**Sub0** · 14/04/2005, 23h06

Lung : Pour qu'un thread ne monopolise pas les ressources, utilise Application.ProcessMessages

http://delphi.developpez.com/faq/?pa...rocessmessages

http://lberne.developpez.com/delphi/...us_threads.pdf

**/dev/null** · 15/04/2005, 10h20

Quite a me faire jarté... expliquer vous dans un nouveau thread ou via mp svp... il faudrait essayer de trouver une solution pour lung

.

Encore une idée bète... si tu fait un multiprocess avec un pipe de communication ou une DDE entre les deux ?

[MODERATION]
Sujet divisé par Sub0

**Lung** · 20/04/2005, 09h28

Envoyé par Sub0

Lung : Pour qu'un thread ne monopolise pas les ressources, utilise Application.ProcessMessages

http://delphi.developpez.com/faq/?pa...rocessmessages

C'est ce que j'utilise bien sûr :

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
 
   MainForm._Result.bReseau := False;      MainForm._Result.bTimeOut := False;
   Timer.Enabled := True;
   //.Test du réseau dans un thread.
   with TThreadTestReseau.Create(False) do
      OnTerminate := ThreadDone;
 
   //.Attente de réponse.
   while not MainForm._Result.bTimeOut do
      Application.ProcessMessages;         // <--------
 
   //.Si réseau.
   if MainForm._Result.bReseau then
   begin
      //.Connexion Oracle.
...

Envoyé par Sub0

http://lberne.developpez.com/delphi/...us_threads.pdf

Intéressant.

Je vais essayer avec 2 threads ...

**Lung** · 20/04/2005, 10h19

Envoyé par /dev/null

Encore une idée bète... si tu fait un multiprocess avec un pipe de communication ou une DDE entre les deux ?

Pas compris ...

**Lung** · 20/04/2005, 10h34

Avec http://phidels.com/php/index.php3?pa...ip.php3&id=336, ca ne marche pas non plus.

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
procedure TMainForm.Button1Click(Sender: TObject);
var
   Tc: Cardinal;
begin
   Tc :=  GetTickCount;
   Label1.Caption := '-';   Label2.Caption := '0';
   Application.ProcessMessages;
   _Result.bReseau := False;      _Result.bTimeOut := False;
 
   FTimer:=TWaitableTime.Create;
   FTimer.OnTimer:=OnTimer;
   FTimer.Intervalle := 1000;
   FTimer.Start(False);
 
   //.Test du réseau dans un thread.
   with TThreadTestReseau.Create(False) do
      OnTerminate := ThreadDone;
 
   //.Attente de réponse.
   while not MainForm._Result.bTimeOut do
      Application.ProcessMessages;
 
   //.Si réseau.
   if MainForm._Result.bReseau then
      Label1.Caption := 'RESEAU'
   else
      Label1.Caption := 'PAS RESEAU';
   Label2.Caption := IntToStr(GetTickCount - Tc);
 
   FTimer.Kill;
   FTimer.WaitFor;
   FTimer.Free;
end;
 
procedure TMainForm.ThreadDone(Sender: TObject);
begin
   FTimer.Stop;
end;
 
procedure TMainForm.OnTimer(Sender: TObject);
begin
   FTimer.Stop;
 
   //.TimeOut.
   if not MainForm._Result.bTimeOut then
   begin
      MainForm._Result.bTimeOut := True;
      MainForm._Result.bReseau := False;
   end;
end;

**Lung** · 20/04/2005, 10h36

Envoyé par Lung

Je vais essayer avec 2 threads ...

Ils ne s'exécutent pas simultanément, mais l'un après l'autre ...

Je crois que pour résoudre mon problème, il me faudrait un processeur dual-core ...

**/dev/null** · 20/04/2005, 14h10

Envoyé par Lung

Envoyé par /dev/null

Encore une idée bète... si tu fait un multiprocess avec un pipe de communication ou une DDE entre les deux ?

Pas compris ...

Quand tu veux espionner la sortie ecrant d'une aplication console, ou lui envoyer des information a la place du clavier, tu peut utilise des pipe dit annonime, mais tu peut aussi faire un pipe nomé. Ton application principal créer un Pipe nomé du genre 'MonSuperPipe' puis créer un second processus. Pas un thread, on est bien d'accord, un processus. Il auras sa zone d'adresse et tout, et tout. Ce nouveau process peut, s'il connait le nom, ce connecter a notre 'MonSuperPipe'

. De là ton application principal peut emettre ou recevoir sur le pipe, comme le processus enfant d'ailleur. Tu peut donc monté un petit protocol de communication qui fairas les action que tu veux que le processus enfant fasse.
Si c'est tout le system qui gèle... ça ne changeras rien. Par contre, si ce n'est que l'application et ses threads enfant qui bloque ça devrais changer la donne

**Lung** · 20/04/2005, 14h41

Ca m'a l'air intéressant !

Un petit exemple ...

**/dev/null** · 20/04/2005, 14h44

Ok... je t'enmaine ça pour demain

c'est à la maison

**Sub0** · 20/04/2005, 14h54

J'ai réalisé un exe qui teste l'url en paramètre.
Je lance ce programme avec une autre appli, mais celle-ci reste gelée tant que le test d'url n'est pas terminé !

Par contre, si je lance ce test d'url dans une fenêtre Dos, je garde la main...

**portu** · 20/04/2005, 15h32

Je ne sais pas si je m'égares, mais il suffit juste de tester l'adresse ip local dans un timer. Si l'adresse est égale à 127.0.0.1 ou si elle commence par 169.x.x.x (adresse automatique Windows lorsqu'il y a une erreur dans les requete DHCP) , l'ordinateur n'est pas sur un réseau.Sinon, il l'est...

Le composant TIdIPWatch sera à cela (enfin peut servir du moins à cela)
exemple

Code :

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

1
2
3
4
5
6
7
8
 
procedure TForm1.IdIpWatchStatusChanged(Sender: TObject);
begin
If  (IdIpWatch.CurrentIP = '127.0.0.1')OR(Copy(IdIpWatch.CurrentIP,1,3) = '169') then
Caption := 'L''ordinateur n''est pas sur le réseau'
else
Caption := 'L''ordinateur est présent sur le réseau';
end;

Ce composant agit plus ou moins comme un timer

**Sub0** · 20/04/2005, 15h40

Lung, as-tu déjà essayé cette solution ?

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

**Lung** · 20/04/2005, 18h33

>> portu

J'ai testé, mais ca ne répond que si je suis sur le réseau.
Sinon, pas de réaction ...

**Lung** · 20/04/2005, 19h08

Envoyé par Sub0

Lung, as-tu déjà essayé cette solution ?

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

Avec un fichier bat qui génère un fichier résultat que j'analyse ?
Bin, ca fait usine à gaz, mais pourquoi pas ... Par contre je ne sais pas quoi mettre dans ce .bat

Code :

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

1
2
@echo off
tnsping Inst>"C:\Documents and Settings\Moi\Bureau\ResTnsping.log"

Ca ne fait rien ...

**portu** · 20/04/2005, 19h11

Envoyé par Lung

>> portu

J'ai testé, mais ca ne répond que si je suis sur le réseau.
Sinon, pas de réaction ...

En effet, suffirait de forcer le déclenchement de cette évenement.
Ensuite ça devrait aller.
Ou alors mettre ce code là dans un Timer

[Edit]
Voilà, tu peux essayer cela.
Il te faut un TIDWatchIp et un Timer.
Laisse le TIDWatchIp.Active à False;
Dans le OnTimer tu peux mettres ceci.

Code :

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

1
2
3
4
5
6
7
8
9
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Ip.ForceCheck;
If (Ip.CurrentIP = '127.0.0.1')OR(Copy(Ip.CurrentIP,1,3) = '169') then
Caption := 'Déconnecté du réseau'
else
Caption := 'Connecté';
 
end;