Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Работа с сетью в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 29.01.2017, 20:47   #1
Halogen
Пользователь
 
Аватар для Halogen
 
Регистрация: 23.11.2013
Сообщений: 46
По умолчанию Delphi Ping

Добрый час
Есть код
Код:
procedure Ping(IP: String; OutMemo:TMemo); 
const BUFSIZE = 2000; 
var SecAttr    : TSecurityAttributes; 
   hReadPipe, 
   hWritePipe : THandle; 
   StartupInfo: TStartUpInfo; 
   ProcessInfo: TProcessInformation; 
   Buffer     : Pchar; 
   WaitReason, 
   BytesRead  : DWord; 
begin 
with SecAttr do 
begin 
  nlength              := SizeOf(TSecurityAttributes); 
  binherithandle       := true; 
  lpsecuritydescriptor := nil; 
end; 
if Createpipe (hReadPipe, hWritePipe, @SecAttr, 0) then 
begin 
  Buffer  := AllocMem(BUFSIZE + 1); 
  FillChar(StartupInfo, Sizeof(StartupInfo), #0); 
  StartupInfo.cb          := SizeOf(StartupInfo); 
  StartupInfo.hStdOutput  := hWritePipe; 
  StartupInfo.hStdInput   := hReadPipe; 
  StartupInfo.dwFlags     := STARTF_USESTDHANDLES + 
                             STARTF_USESHOWWINDOW; 
  StartupInfo.wShowWindow := SW_HIDE; 
  if CreateProcess(nil, 
     PChar('ping.exe '+IP), 
     @SecAttr, 
     @SecAttr, 
     true, 
     NORMAL_PRIORITY_CLASS, 
     nil, 
     nil, 
     StartupInfo, 
     ProcessInfo) then 
    begin 
      repeat 
        WaitReason := WaitForSingleObject( ProcessInfo.hProcess,100); 
        Application.ProcessMessages; 
      until (WaitReason <> WAIT_TIMEOUT); 
      Repeat 
        BytesRead := 0; 
        ReadFile(hReadPipe, Buffer[0], BUFSIZE, BytesRead, nil); 
        Buffer[BytesRead]:= #0; 
        OemToAnsi(Buffer,Buffer); 
        OutMemo.Text := OutMemo.text + String(Buffer); 
      until (BytesRead < BUFSIZE); 
    end; 
  FreeMem(Buffer); 
  CloseHandle(ProcessInfo.hProcess); 
  CloseHandle(ProcessInfo.hThread); 
  CloseHandle(hReadPipe); 
  CloseHandle(hWritePipe); 
end; 
end;
Результат кода
Цитата:
Обмен пакетами с 127.0.0.1 по 32 байт:
Ответ от 127.0.0.1: число байт=32 время<1мс TTL=128
Ответ от 127.0.0.1: число байт=32 время<1мс TTL=128
Ответ от 127.0.0.1: число байт=32 время<1мс TTL=128
Ответ от 127.0.0.1: число байт=32 время<1мс TTL=128
Статистика Ping для 127.0.0.1:
Пакетов: отправлено = 4, получено = 4, потеряно = 0 (0% потерь),
Приблизительное время приема-передачи в мс:
Минимальное = 0мсек, Максимальное = 0 мсек, Среднее = 0 мсек
А как сделать чтобы запрос обрабатывался с командой -t то есть постоянно, просто когда я посылаю -t прога как бы повисает может как то Memo обновлять нужно ?
Halogen вне форума Ответить с цитированием
Старый 29.01.2017, 21:55   #2
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

Цитата:
А как сделать чтобы запрос обрабатывался с командой -t то есть постоянно, просто когда я посылаю -t прога как бы повисает
Все правильно что подвисает, у вас там ожидание завершения работы программы ping.exe и после этого только результат получаете, нужно ваш код в потоке сделать и в обратном вызове результаты в работающей программе получать.
Вот накидал ваш код в потоке в отдельном модуле, так проще к другим проектам подключать да и удобней.
Можно кстати не только c ping работать.
Код:
unit UCmdLine;

interface
uses
Windows, WinSock, SysUtils, Classes, dialogs;

type
  TCmdThread = class(TThread)
  private
    FOnCmdLine: TNotifyEvent;
    FCmdLine: string;
    FOutCmdLine: String;
    FStoped: Boolean;
  public
  protected
   procedure DoCmdLine; virtual;
  public
  procedure Execute; Override;
  constructor Create(cmdLine: string); virtual;
  procedure Stop; virtual;
  destructor Destroy; override;
  property OnCmdLine: TNotifyEvent read FOnCmdLine write FOnCmdLine;
  property OutCmdLine: String read FOutCmdLine;
  property Stoped: Boolean read FStoped;
end;

implementation

constructor TCmdThread.Create(CmdLine: string);
begin
  inherited Create(True);
  FreeOnTerminate:= True;
  FCmdLine:= CmdLine;
  Resume;
end;

destructor TCmdThread.Destroy;
begin
 FStoped:= true;
  inherited;
end;

procedure TCmdThread.DoCmdLine;
 begin
if Assigned(FOnCmdLine) then
    FOnCmdLine(Self);
end;

procedure TCmdThread.Stop;
 begin
 FStoped:= true;
  Terminate;
end;

procedure TCmdThread.Execute;
const BUFSIZE = 2000;
var SecAttr    : TSecurityAttributes; 
   hReadPipe,
   hWritePipe : THandle;
   StartupInfo: TStartUpInfo; 
   ProcessInfo: TProcessInformation;
   Buffer     : Pchar; 
   WaitReason,
   BytesRead  : DWord;
begin
with SecAttr do
begin
  nlength              := SizeOf(TSecurityAttributes); 
  binherithandle       := true; 
  lpsecuritydescriptor := nil;
end;
if Createpipe (hReadPipe, hWritePipe, @SecAttr, 0) then 
begin
  Buffer  := AllocMem(BUFSIZE + 1); 
  FillChar(StartupInfo, Sizeof(StartupInfo), #0);
  StartupInfo.cb          := SizeOf(StartupInfo);
  StartupInfo.hStdOutput  := hWritePipe; 
  StartupInfo.hStdInput   := hReadPipe;
  StartupInfo.dwFlags     := STARTF_USESTDHANDLES +
                             STARTF_USESHOWWINDOW; 
  StartupInfo.wShowWindow := SW_HIDE;
  if CreateProcess(nil,
     PChar(FCmdLine),
     @SecAttr,
     @SecAttr, 
     true,
     NORMAL_PRIORITY_CLASS,
     nil,
     nil, 
     StartupInfo,
     ProcessInfo) then
  while not Terminated do
      begin
      WaitReason := WaitForSingleObject(ProcessInfo.hProcess, 1);
       if (WaitReason <> WAIT_TIMEOUT) or (FStoped) then
       Terminate;
        BytesRead := 0;
        ReadFile(hReadPipe, Buffer[0], BUFSIZE, BytesRead, nil);
        Buffer[BytesRead]:= #0;
        OemToAnsi(Buffer,Buffer);
        FOutCmdLine:= PAnsiChar(Buffer);
        Synchronize(DoCmdLine);
    end;
  FreeMem(Buffer);
  CloseHandle(ProcessInfo.hProcess);
  CloseHandle(ProcessInfo.hThread);
  CloseHandle(hReadPipe);
  CloseHandle(hWritePipe);
end;
end;

end.
Использовать в программе так
Код:
 type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
private
    { Private declarations }
  public
    procedure OnCmdLine(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

uses UCmdLine; //Подключаем модуль

{$R *.dfm}

var
CmdThread: TCmdThread;

//Получение данных в Memo
procedure TForm1.OnCmdLine(Sender: TObject);
begin
Memo1.Lines.add(TCmdThread(Sender).OutCmdLine);
end;

//Запустить
procedure TForm1.Button1Click(Sender: TObject);
begin
CmdThread:= TCmdThread.Create('ping mail.ru -t');
CmdThread.OnCmdLine:= OnCmdLine;
end;

//Остановить
procedure TForm1.Button2Click(Sender: TObject);
begin
if (CmdThread <> nil)and(not CmdThread.Stoped) then
CmdThread.Stop;
end;

Последний раз редактировалось Aliens_wolfs; 29.01.2017 в 23:46.
Aliens_wolfs вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
ping ramm_89 Работа с сетью в Delphi 2 31.07.2016 22:46
Ping Шамиль8284 Софт 1 27.05.2013 13:28
Ping в Delphi folkk Работа с сетью в Delphi 8 24.10.2010 17:02
процедура ping в Delphi xTANATOSx Общие вопросы Delphi 3 11.10.2007 10:32
Ping Баламут Работа с сетью в Delphi 5 23.08.2007 15:17