uses
WinSock;
type
ip_option_information = packed record // Информация заголовка IP (Наполнение
// этой структуры и формат полей описан в RFC791.
Ttl : byte; // Время жизни (используется traceroute-ом)
Tos : byte; // Тип обслуживания, обычно 0
Flags : byte; // Флаги заголовка IP, обычно 0
OptionsSize : byte; // Размер данных в заголовке, обычно 0, максимум 40
OptionsData : Pointer; // Указатель на данные
end;
icmp_echo_reply = packed record
Address : u_long; // Адрес отвечающего
Status : u_long; // IP_STATUS (см. ниже)
RTTime : u_long; // Время между эхо-запросом и эхо-ответом
// в миллисекундах
DataSize : u_short; // Размер возвращенных данных
Reserved : u_short; // Зарезервировано
Data : Pointer; // Указатель на возвращенные данные
Options : ip_option_information; // Информация из заголовка IP
end;
PIPINFO = ^ip_option_information;
PVOID = Pointer;
function IcmpCreateFile() : THandle; stdcall; external 'ICMP.DLL' name 'IcmpCreateFile';
function IcmpCloseHandle(IcmpHandle : THandle) : BOOL; stdcall; external 'ICMP.DLL' name 'IcmpCloseHandle';
function IcmpSendEcho(
IcmpHandle : THandle; // handle, возвращенный IcmpCreateFile()
DestAddress : u_long; // Адрес получателя (в сетевом порядке)
RequestData : PVOID; // Указатель на посылаемые данные
RequestSize : Word; // Размер посылаемых данных
RequestOptns : PIPINFO; // Указатель на посылаемую структуру
// ip_option_information (может быть nil)
ReplyBuffer : PVOID; // Указатель на буфер, содержащий ответы.
ReplySize : DWORD; // Размер буфера ответов
Timeout : DWORD // Время ожидания ответа в миллисекундах
) : DWORD; stdcall; external 'ICMP.DLL' name 'IcmpSendEcho';
procedure TForm1.Button1Click(Sender: TObject);
var
hIP : THandle;
pingBuffer : array [0..31] of Char;
pIpe : ^icmp_echo_reply;
pHostEn : PHostEnt;
wVersionRequested : WORD;
lwsaData : WSAData;
error : DWORD;
destAddress : In_Addr;
begin
// Создаем handle
hIP := IcmpCreateFile();
GetMem( pIpe, sizeof(icmp_echo_reply) + sizeof(pingBuffer));
pIpe.Data := @pingBuffer;
pIpe.DataSize := sizeof(pingBuffer);
wVersionRequested := MakeWord(1,1);
error := WSAStartup(wVersionRequested,lwsaData);
if (error <> 0) then
begin
Memo1.SetTextBuf('Error in call to '+
'WSAStartup().');
Memo1.Lines.Add('Error code: '+IntToStr(error));
AssignFile(f, PathFileName+'log\error.txt');
Append(f);
WriteLn(f, 'Ошибка в вызове имени хоста из '+(edit1.text)+' gethostbyname();');
WriteLn(f, 'Возможно отсутствует Интернет от провайдера или отключена сеть. '+DateToStr(date)+' '+TimeToStr(time) );
CloseFile(f);
Exit;
end;
hostaddress:=edit1.Text;
memo1.clear;
memo1.Lines.Add('попингуем -> '+hostaddress);
memo1.Lines.Add(DateToStr(date)+' '+TimeToStr(time));
pHostEn := gethostbyname(PAnsiChar(AnsiString(hostaddress)));
error := GetLastError();
if (error <> 0) then
begin
Memo1.SetTextBuf('Error in call to'+
'gethostbyname().');
Memo1.Lines.Add('Error code: '+IntToStr(error));
Exit;
end;
//pHostEn := gethostbyname(PAnsiChar(AnsiString(hostaddress)));
//pHostEn := gethostbyname('krasnovosti.ru');
destAddress := PInAddr(pHostEn^.h_addr_list^)^;
// Посылаем ping-пакет
Memo1.Lines.Add('пинговка ' +
pHostEn^.h_name+' ['+
inet_ntoa(destAddress)+'] '+
' with '+
IntToStr(sizeof(pingBuffer)) +
' байтами данных:');
IcmpSendEcho(hIP, destAddress.S_addr, @pingBuffer, sizeof(pingBuffer), Nil, pIpe, sizeof(icmp_echo_reply) + sizeof(pingBuffer), 5000);
error := GetLastError();
if (error <> 0) then
begin
Memo1.SetTextBuf('Ошибка при отправки пакета к хосту '+'IcmpSendEcho()');
Memo1.Lines.Add('Error code: '+IntToStr(error));
//ShowMessage('файл существует');
AssignFile(f, PathFileName);
Append(f);
WriteLn(f, 'Ошибка отправки пакета;');
WriteLn(f, 'Возможно кабель сети не подключен. '+DateToStr(date)+' '+TimeToStr(time) );
CloseFile(f);
Exit;
end;
// Смотрим некоторые из вернувшихся данных
Memo1.Lines.Add('Ответ от '+
IntToStr(LoByte(LoWord(pIpe^.Address)))+'.'+
IntToStr(HiByte(LoWord(pIpe^.Address)))+'.'+
IntToStr(LoByte(HiWord(pIpe^.Address)))+'.'+
IntToStr(HiByte(HiWord(pIpe^.Address))));
Memo1.Lines.Add('Время ответа: '+IntToStr(pIpe.RTTime)+' мс');
IcmpCloseHandle(hIP);
WSACleanup();
FreeMem(pIpe);
Простой
