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.
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionEnvoi 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
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.
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
procedure TForm1.Button1Click(Sender: TObject);
Var
Fileping:TStringList;
begin
Fileping := TStringList.Create;//Initialisation de Fileping
fileping.Add('Ping /n 1 /W 1000 ' + edit1.Text + ' > result.txt');
fileping.SaveToFile('cmdping.cmd');
ShellExecute(Handle,'open',Pchar('cmdping.cmd' ),nil ,nil,SW_SHOW);//Ping
Sleep(1000);
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
Fileping.free;
end;
ShellExecute(0,'Open',PChar('CMD.exe'),PChar('/C Ping '+Edit1.Text+' > C:\Result.txt'), nil, SW_SHOW);TStrings NON, mais TStringList...
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 ;-)
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;
29 juil. 2014 à 11:52
Modifié par MiniApp le 29/07/2014 à 14:37
Le code de la fiche est : Celui de l'unité :
Merci