Faire un Ping en DelphiRésolu

Question

Bonjour j'ai poster ce post dans le forum High-Tech (http://www.commentcamarche.net/forum/affich-30549445-faire-un-ping-en-delphi#p30550182) et je souhaiterai savoir comment faire. Merci

MiniApp · Answer

Personne?

cs_yanb · Answer

Salut,
sans Indy regarde du côté de ICMP
@+

fbalien · Answer

Bonjour

vous pouvez regarder non source qui utilise ICMP
 http://codes-sources.commentcamarche.net/source/43756-monitoring-reseau-par-ping
tout est dans icmp.pas
 
--

Cirec · Answer

Salut,

1°) les composants Indy9 ou Indy10 sont disponibles gratuitement pour toutes les versions de Delphi et même pour Delphi5

2°) utiliser la solution de fbalien

3°) par une commande Dos (le plus simple à mettre en oeuvre) 
  Ping Google.fr > Result.txt 

le résultat du Ping se trouve dans le fichier Result.txt !!!
Envoi d'une requête 'ping' sur google.fr [173.194.40.184] avec 32 octets de données :

Réponse de 173.194.40.184 : octets=32 temps=52 ms TTL=45
Réponse de 173.194.40.184 : octets=32 temps=51 ms TTL=45
Réponse de 173.194.40.184 : octets=32 temps=51 ms TTL=45
Réponse de 173.194.40.184 : octets=32 temps=51 ms TTL=45

Statistiques Ping pour 173.194.40.184:
    Paquets : envoyés = 4, reçus = 4, perdus = 0 (perte 0%),

Durée approximative des boucles en millisecondes :
    Minimum = 51ms, Maximum = 52ms, Moyenne = 51ms

Maintenant tu as le choix

MiniApp · Answer

Efectivement j'ai installer hier Indy 9 (je ne suis pas allé sur Codes sources hier) mais perso je trouve que indy est complexe je n'ai pas trouver comment recevoir des messages mais indy permet la mise en oeuvre de SSL et offre plus de possibilité c'est vrai.

J'ai regarder la solution de fbalien mais Delphi trouve des erreurs (dcu variants absent  et le mot "ifthen")

Je vais essayer ta solution "ping dos" (je vais rechercher comment en fait déjà shellexecute) puis je vais poster si ça marche. Merci.
 
Chercher et essayer : vous trouverez la solution!
Fouiner et regarder partout : vous trouverez la connaissance!!

MiniApp · Answer

Jai 2 bugs :

1- Le ping ne veut pas m'écrire le fichier
2- Le TStrings ne veut pas m'ouvrir le fichier d'un ping fontionnel

Voici le code : 
unit Unit1;

interface

uses
  Windows, Forms, Dialogs, ShellApi, Classes, Controls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
Var
Fileping:TStrings;
begin
Fileping := TStrings.Create;//Initialisation de Fileping
ShellExecute(Handle,'open',Pchar('Ping '+Edit1.Text+' > Result.txt'),nil,nil,SW_SHOW);//Ping
Fileping.LoadFromFile('Result.txt');//Chargement du ping
If Pos(Fileping.Text,'[') <> 0 Then//Ping OK?
ShowMessage(Edit1.Text + ' trouver')//Ping ok
Else ShowMessage(Edit1.Text + ' non trouver')//Ping pas ok
end;

end.

SVP trouver l'erreur merci.

Note : j'ai remarquer que le caractère "[" n'est présent que si l'hote existe, je l'utilise pour savoir si l'hote existe
 
Chercher et essayer : vous trouverez la solution!
Fouiner et regarder partout : vous trouverez la connaissance!!

fbalien · Answer

Bonjour

ifthen normalement est présent dans l'unité math peut être pas en delphi5

si non pour la version dos ping
1/ ne pas oublier de libérer les objet instanciés (Fileping.free en fin de procedure)
2/ pour avoir le resultat du ping via shellexecute il faut passer par un fichier batch

  Fileping := TStringList.Create;//Initialisation de Fileping  fileping.Add('Ping ' + edit1.Text + ' > c:\result.txt');  fileping.SaveToFile('cmdping.cmd');  err := ShellExecute(Handle,'open',Pchar('cmdping.cmd' ),nil ,nil,SW_SHOW);//Ping  ShowMessage(SysErrorMessage(err) );  Fileping.LoadFromFile('c:\Result.txt');//Chargement du ping  If Pos(Fileping.Text,'[') <> 0 Then//Ping OK?    ShowMessage(Edit1.Text + ' trouver')//Ping ok  Else ShowMessage(Edit1.Text + ' non trouver');//Ping pas ok  Fileping.free

/!\ il faudra adapter le parse du fichier resultat.txt
--

cs_yanb · Answer

Salut,
je ne pense pas qu'il soit nécessaire de passer par un fichier batch,il faudrait essayer ceci
 ShellExecute(0,'Open',PChar('CMD.exe'),PChar('/C Ping '+Edit1.Text+' > C:\Result.txt'), nil, SW_SHOW);
TStrings NON, mais TStringList...
Ensuite il me semble que la fonction Pos fonctionne plus comme ceci Pos('[', Fileping.Text) par contre il va falloir attendre la fin du ping...peut être ne faire qu'une demande déjà
ShellExecute(0,'Open',PChar('CMD.exe'),PChar('/C Ping '+Edit1.Text+' /n 1 > C:\Result.txt'), nil, SW_HIDE);
Et ensuite...un peu de recherche pour le traitement du fichier ;-)
@+

Cirec · Answer

re,

ShellExecute étant fortement déconseillé par Delphi qui préconise l'utilisation de CreateProcess à la place ...
voici un petit exemple qui va te plaire j'en suis certain ^^

sur une TForm tu places 1 TMemo et 1 TButton et tu complètes comme suit:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
{ code original de Zarko Gajic:
  http://delphi.about.com/cs/adptips2001/a/bltip0201_2.htm
  Modifié par Cirec}
procedure RunDosInMemo(const DosApp: string; const AMemo: TMemo);
const
  ReadBuffer = 2400;
var
  Security: TSecurityAttributes;
  ReadPipe, WritePipe: THandle;
  start: TStartUpInfo;
  ProcessInfo: TProcessInformation;
  Buffer: Pchar;
  BytesRead: DWord;
begin
  with Security do
  begin
    nlength := SizeOf(TSecurityAttributes);
    binherithandle := true;
    lpsecuritydescriptor := nil;
  end;
  if Createpipe(ReadPipe, WritePipe, @Security, 0) then
  try
    FillChar(Start, Sizeof(Start), #0);
    start.cb := SizeOf(start);
    start.hStdOutput := WritePipe;
    start.hStdInput := ReadPipe;
    start.dwFlags := STARTF_USESTDHANDLES +
      STARTF_USESHOWWINDOW;
    start.wShowWindow := SW_HIDE;

if CreateProcess(nil, PChar(DosApp), @Security, @Security, true,
         NORMAL_PRIORITY_CLASS, nil, nil, start, ProcessInfo) then
    try
      repeat
        Application.ProcessMessages;
      until (WaitForSingleObject(ProcessInfo.hProcess, 100) <> WAIT_TIMEOUT);
      Buffer := AllocMem(ReadBuffer + 1);
      try
        repeat
          BytesRead := 0;
          ReadFile(ReadPipe, Buffer[0], ReadBuffer, BytesRead, nil);
          Buffer[BytesRead] := #0;
          OemToAnsi(Buffer, Buffer);
          AMemo.Text := AMemo.text + string(Buffer);
        until (BytesRead < ReadBuffer);
      finally
        FreeMem(Buffer);
      end;
    finally
      CloseHandle(ProcessInfo.hProcess);
      CloseHandle(ProcessInfo.hThread);
    end;
  finally
    CloseHandle(ReadPipe);
    CloseHandle(WritePipe);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Caption := 'Requette en cour ...';
  Memo1.Clear;
  RunDosInMemo('cmd.exe /k Ping Google.fr', Memo1);
  Caption := 'Requette terminée';
end;

end.
 
 

Les avantages sont:
  le résultat est directement affiché dans un TMemo ... pas de traces sur le disque ... pas besoin de charger le fichier pour le lire.
 La procédure attend la fin de l'exécution de la commande avant d'aller plus loin (on s'en rend compte avec l'affichage du caption avant et après l'exécution)
 Bien sur l'application n'est pas figée durant l'exécution.

cs_yanb · Answer

Salut Cirec,
Raaa trop rapide comme d'hab :p ^^,
Bah au moins c'est de bonne augure de revoir des "anciens" plus souvent ;-)
bon ben je met quand même le morceau de code que j'avais trouvé ( il me semble de Paul Toth à l'époque ) et que j'avais adapté il y a quelques années...fallait juste que je le retrouve...
procedure RunCmd(ComCmd: string; S: TStrings);var    PipeIn              : THandle;    PiPeOut             : THandle;    SecurityAttributes  : TSecurityAttributes;    StartupInfo         : TStartupInfo;    ProcessInformation  : TProcessInformation;    Buffer              : array[0..4096] of AnsiChar;    LengthRead          : DWORD;begin    With SecurityAttributes do    begin        nlength := SizeOf(TSecurityAttributes) ;        binherithandle := true;        lpsecuritydescriptor := nil;    end;    CreatePipe(PipeIn, PiPeOut, @SecurityAttributes, 0);    FillChar(StartupInfo, SizeOf(TStartupInfo), 0);    StartupInfo.cb := SizeOf(TStartupInfo);    StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;    StartupInfo.wShowWindow := SW_HIDE;    StartupInfo.hStdInput := PipeIn;    StartupInfo.hStdOutput:= PiPeOut;    StartupInfo.hStdError := PiPeOut;    CreateProcess(nil, PChar(ComCmd), nil, nil, True, 0, nil, nil, StartupInfo, ProcessInformation);    WaitForSingleObject(ProcessInformation.hProcess, INFINITE);    CloseHandle(PiPeOut);    while ReadFile(PipeIn, Buffer, 4096, LengthRead, nil) do        OemToAnsi(Buffer, Buffer);    S.Add(Buffer);    CloseHandle(PipeIn);end;procedure TForm1.Button1Click(Sender: TObject);begin    RunCmd('ping '+Edit1.Text+' /n 1', Memo1.Lines);end;
@+

Cirec · Answer

Salut,

oui c'est le même principe à ceci près ... dans ton code tu oublies de fermer les Handles créés avec CreateProcess.

tu peux vérifier sur la MSDN 
    Handles in PROCESS_INFORMATION must be closed with CloseHandle when they are no longer needed.

du fait de l'utilisation de INFINITE dans:
WaitForSingleObject(ProcessInformation.hProcess, INFINITE);
l'application reste figée le temps de l'exécution (ok là c'est assez rapide)

et l'encadrement du code dans des blocs try finally ne me semble pas être du luxe ^^
ça nous garantie la libération des objets en toutes circonstances.

sinon c'est pareil ^^
et oui j'essaye d'être plus présent sur le site mais c'est pas toujours facile.

MiniApp · Answer

Bonjour à tous

Je vois que vous avez poster BEAUCOUP DE POST!! 8-0

Maintenant je vais tout tester et merci de votre participation.
;-)

Faire un Ping en Delphi

12 réponses

Votre réponse

sur les mêmes thèmes