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

Version imprimable

Voir 40 message(s) de cette discussion en une page

14/04/2005, 17h42
Lung
Citation:

Envoyé par Sub0

Alors ? Ça fonctionne ?

Non ... :(
Mon thread ne s'exécute pas en parallèle.
Citation:
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:

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.

:koi:

Mon thread :

Code:

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.

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

Avec ce thread, un Timer sur la form principal initialise sur 1000ms met 30s a s'éxécuter ?
14/04/2005, 18h16
Lung

Citation:

Envoyé par /dev/null

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

Oui.

:cry: :cry:
14/04/2005, 23h06
Sub0

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
15/04/2005, 10h20
/dev/null

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

Citation:

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:

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. ...
Citation:

Envoyé par Sub0

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

Intéressant. :ccool:
Je vais essayer avec 2 threads ...

20/04/2005, 10h19
Lung

Citation:

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 ...

:koi:

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

Code:

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;

20/04/2005, 10h36
Lung

Citation:

Envoyé par Lung

Je vais essayer avec 2 threads ...

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

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

:?
20/04/2005, 14h10
/dev/null

Citation:

Envoyé par Lung

Citation:

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 ...

:koi:

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 ;)
20/04/2005, 14h41
Lung

Ca m'a l'air intéressant ! :wink:
Un petit exemple ...
20/04/2005, 14h44
/dev/null

Ok... je t'enmaine ça pour demain ;) c'est à la maison :D
20/04/2005, 14h54
Sub0

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...

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:

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

20/04/2005, 15h40
Sub0

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

http://www.developpez.net/forums/viewtopic.php?t=262070
20/04/2005, 18h33
Lung

>> portu

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

:roll:
20/04/2005, 19h08
Lung
Citation:

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

:arrow:
Code:

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

:koi:

Citation:

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 ...

:roll:

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:

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;
Ps : Ce composant m'a l'air d'être très bien et devrait fonctionner sans l'aide de timer puisqu'il en est un plus ou moins.
[/Edit]

21/04/2005, 09h27
Lung

Ca répond "Connecté", même avec le cable réseau débranché.

:roll:

Voir 40 message(s) de cette discussion en une page