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

  • Форум работает в тестовом режиме (обновление функционала)

Zmey26rus

Новорег
Регистрация
11.10.17
Сообщения
15
В этой статье речь пойдет об определении пинга (ping) в Delphi. (исходник в конце статьи)


Думаю, вы все знакомы со стандартной командой windows. Если нет, то нажимаем горячую клавишу Win+R и в появившемся окне вводим cmd

Откроется командная строка, и в ней набираем ping + адрес сервера, к примеру адрес своего компьютера и нажимаем enter



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



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

Исходник:
 

Вложения

DMyrzich

Новорег
Регистрация
17.09.18
Сообщения
17
на шарпе это в одну строчку можно сделать
В этой статье речь пойдет об определении пинга (ping) в Delphi. (исходник в конце статьи)


Думаю, вы все знакомы со стандартной командой windows. Если нет, то нажимаем горячую клавишу Win+R и в появившемся окне вводим cmd

Откроется командная строка, и в ней набираем ping + адрес сервера, к примеру адрес своего компьютера и нажимаем enter



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



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

Исходник: