ВАШИ ПРАВА ОГРАНИЧЕНЫ!
  Зарегистрируйтесь на форуме,что бы

  стать полноценным участником сообщества!

ОПРЕДЕЛЕНИИ ПИНГА (PING) В DELPHI.

Тема в разделе "Delphi", создана пользователем Zmey26rus, 27 июл 2018.

  1. Zmey26rus

    Zmey26rus Новорег

        
    15
    13
    3
    В этой статье речь пойдет об определении пинга (ping) в Delphi. (исходник в конце статьи)

    [​IMG]
    Думаю, вы все знакомы со стандартной командой windows. Если нет, то нажимаем горячую клавишу Win+R и в появившемся окне вводим cmd
    [​IMG]
    Откроется командная строка, и в ней набираем ping + адрес сервера, к примеру адрес своего компьютера и нажимаем enter

    [​IMG]

    Теперь тоже самое мы попробуем реализовать в Delphi. Создаем новый проект File->New->VCL Form Application и кидаем на форму следующие компоненты: TButton,TLabel, TEdit и TMemo. Для более красивого отображения, можно в настройках Memo изменить цвет шрифта (Font->Color).

    [​IMG]

    Для проведения пинга воспользуемся следующей процедурой:
    Код:
    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;

    Процедура отправляет IP адрес и возвращает в TMemo результат работы.
    Вот пример использования:
    Код:
    Ping('127.0.0.1', Memo1);

    Исходник:
     

    Вложения:

    Lom _ 777, turbolexx и cake2000 нравится это.
  2. DMyrzich

    DMyrzich Новорег

        
    13
    0
    1
    на шарпе это в одну строчку можно сделать
     

Здравствуйте! Кажется, вы используете AdBlock - могут быть недоступны скачки файлов с нашего форума. Добавьте, пожалуйста, нас в исключения. Спасибо за понимание!