| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Програмный PING [D7, WinXP]
SiONYX © (2003-09-04 23:57:00)
Идея следующая: прежде чем пытаться соединиться с удаленной машиной - пропинговать ее. Если отзовется => включена и можно соединиться. (А то если машина выключена - попытка коннекта "затягивается").
Есть хорошая утилитка PING, но как бы зделать что-то подобное програмно.
Может кто посоветует что-то другое реализующее эту идею.
Заранее спасибо.
Vladimir (2003-09-05 11:13:00) [21]
Можно воспользоваться компонентой IDICMPClient, на вкладке Indy Clients.
Вася Пупкин (2003-09-05 01:15:00) [22]
begin
TimeOut:=1000;
if (WSAStartup($202,wsaData) <> 0)then
begin
writeln("WSAStartup failed: ",GetLastError());
ExitProcess(STATUS_FAILED);
end;
SockRaw := WSASocket(AF_INET, SOCK_RAW,IPPROTO_ICMP, NIL, 0,WSA_FLAG_OVERLAPPED);
if (sockRaw = INVALID_SOCKET) then
begin
writeln("WSASocket() failed: ",WSAGetLastError());
ExitProcess(STATUS_FAILED);
end;
Bread := setsockopt(SockRaw,SOL_SOCKET,SO_RCVTIMEO,pchar(@Timeout),sizeof(Timeo ut));
if(Bread <> 0) then
begin
writeln("failed to set recv timeout: ",WSAGetLastError());
ExitProcess(STATUS_FAILED);
end;
Bread := setsockopt(SockRaw,SOL_SOCKET,SO_SNDTIMEO,pchar(@Timeout),sizeof(Timeo ut));
if(Bread <> 0) then
begin
writeln("failed to set send timeout: ",WSAGetLastError());
ExitProcess(STATUS_FAILED);
end;
ZeroMemory(@Dest,sizeof(Dest));
hp := gethostbyname(PChar(ParamStr(1)));
Error := GetLastError();
if (Error <> 0) then
begin
writeln("Error in call to gethostbyname().Error code: ",Error);
end;
if (hp = nil ) then Addr := inet_addr(PChar(ParamStr(1)));
if ((hp = nil) and (Addr = INADDR_NONE) ) then
begin
writeln("Unable to resolve ",ParamStr(1));
ExitProcess(STATUS_FAILED);
end;
if (hp <> NIL) then Dest.sin_addr := PInAddr(hp^.h_addr_list^)^
else Dest.sin_addr.s_addr := Addr;
if (hp <> NIL) then Dest.sin_family := hp^.h_addrtype
else Dest.sin_family := AF_INET;
Dest_ip := inet_ntoa(dest.sin_addr);
writeln("Pinging " + hp^.h_name+" ["+ inet_ntoa(dest.sin_addr)+"] ");
datasize := DEF_PACKET_SIZE;
datasize := datasize+sizeof(TIcmpHeader);
GetMem( Icmp_Data, MAX_PACKET);
GetMem(RecvBuf,MAX_PACKET);
if (Icmp_Data = nil) or (RecvBuf = nil) then
begin
writeln("GetMem failed");
ExitProcess(STATUS_FAILED);
end;
ZeroMemory(icmp_data,MAX_PACKET);
ZeroMemory(recvbuf,MAX_PACKET);
fill_icmp_data(Icmp_Data,DataSize);
while(True) do
begin
PIcmpHeader(Icmp_Data)^.i_cksum := 0;
PIcmpHeader(Icmp_Data)^.timestamp := GetTickCount();
PIcmpHeader(Icmp_Data)^.i_seq := Seq_no;
inc(Seq_no);
PIcmpHeader(Icmp_Data)^.i_cksum := checksum(Icmp_Data,DataSize);
Bwrote := sendto(SockRaw,Icmp_Data^,DataSize,0,Dest, sizeof(Dest));
if (Bwrote = SOCKET_ERROR)then
begin
if (WSAGetLastError() = WSAETIMEDOUT) then
begin
writeln("timed out");
continue;
end;
writeln("sendto failed: ",WSAGetLastError());
ExitProcess(STATUS_FAILED);
end;
if (Bwrote < DataSize ) then
begin
writeln("Wrote ",Bwrote, " bytes");
end;
Bread := recvfrom(SockRaw,RecvBuf^,MAX_PACKET,0,TSOCKADDRIN(From),FromLen);
if (Bread = SOCKET_ERROR)then
begin
if (WSAGetLastError() = WSAETIMEDOUT) then
begin
writeln("timed out");
continue;
end;
writeln("recvfrom failed: ",WSAGetLastError());
ExitProcess(STATUS_FAILED);
end;
decode_resp(RecvBuf,Bread,From);
sleep(3000);
end;
WSACleanUp;
FreeMem(RecvBuf);
FreeMem(ICMP_Data);
end.
Вася Пупкин (2003-09-05 01:14:00) [23]
procedure fill_icmp_data(icmp_data:pchar; datasize:integer);
var
IcmpHeader:PIcmpHeader;
datapart:pointer;
begin
IcmpHeader := PIcmpHeader(icmp_data);
IcmpHeader^.i_type := ICMP_ECHO;
IcmpHeader^.i_code := 0;
IcmpHeader^.i_id := word(GetCurrentProcessId());
IcmpHeader^.i_cksum := 0;
IcmpHeader^.i_seq := 0;
datapart := icmp_data + sizeof(TIcmpHeader);
FillMemory(datapart, datasize - sizeof(TIcmpHeader),ord("W"));
end;
function checksum( buffer:pword; size: integer):word;
var
cksum : DWORD;
begin
cksum:=0;
while( size > 1 ) do
begin
cksum:=cksum + buffer^;
buffer:=pword(integer(buffer) + sizeof(word));
size :=size-sizeof(word);
end;
if(size<>0 ) then
cksum := cksum + buffer^;
cksum := (cksum shr 16) + (cksum and $ffff);
result:= word(not(cksum + (cksum shr 16)));
end;
procedure decode_resp(buf:pchar;bytes:integer ;var from:TSockAddrIn);
var
IpHeader:PIpHeader;
IcmpHeader:PIcmpHeader;
iphdrlen:word;
begin
IpHeader := PIpHeader(buf);
iphdrlen := (IpHeader^.VerLen and $0F ) * 4 ; // number of 32-bit words *4 = bytes
if (bytes < iphdrlen + ICMP_MIN) then
begin
writeln("Too few bytes from ",inet_ntoa(from.sin_addr));
end;
IcmpHeader := PIcmpHeader(integer(buf) + iphdrlen);
if (IcmpHeader^.i_type <> ICMP_ECHOREPLY) then
begin
writeln("non-echo type %d recvd",IcmpHeader^.i_type);
exit;
end;
if IcmpHeader^.i_id <> word(GetCurrentProcessId()) then
begin
writeln("someone else""s packet!");
exit;
end;
write(Bytes," bytes from ", inet_ntoa(From.sin_addr));
write(" icmp_seq = ",IcmpHeader^.i_seq);
writeln(" time: ",GetTickCount()-IcmpHeader^.timestamp," ms ");
end;
Вася Пупкин (2003-09-05 01:13:00) [24]
Вот "сырой" пример... разбирайся если есть такое желание
//******************************************************************** **********\
// Simple ping utility using SOCK_RAW
//******************************************************************** **********/
program Ping;
{$APPTYPE CONSOLE}
uses
windows, winsock2;
const
ICMP_ECHO = 8;
ICMP_ECHOREPLY = 0;
ICMP_MIN = 8; // minimum 8 byte icmp packet (just header)
STATUS_FAILED = $FFFF;
DEF_PACKET_SIZE = 32;
MAX_PACKET = 1024;
type
// IP header
PIpHeader=^TIpHeader;
TIpHeader = packed record
VerLen : byte;
tos : byte; // Type of service
total_len : word; // total length of the packet
ident : word; // unique identifier
frag_and_flags : word; // flags
ttl : byte;
proto : byte; // protocol (TCP, UDP etc)
checksum : word; // IP checksum
sourceIP : DWORD;
destIP : DWORD;
end;
// ICMP header
PIcmpHeader=^TIcmpHeader;
TIcmpHeader = packed record
i_type : byte;
i_code : byte; // 0 * type sub code */
i_cksum : word; //0
i_id : word;
i_seq : word;
// This is not the std header, but we reserve space for time
timestamp : DWORD;
end;
var
wsaData : TWSADATA;
Dest, From : TSockAddrIn;
Timeout : integer;
FromLen : integer = SizeOf(From);
Dest_Ip : pointer = nil;
ICMP_Data : pointer = nil;
RecvBuf : pointer = nil;
hp : PHostEnt = nil;
Addr : DWORD = 0;
Seq_No : Word = 0;
sockRaw : TSOCKET;
BRead, Bwrote ,DataSize : integer;
error:integer;
Вася Пупкин (2003-09-05 01:04:00) [25]
А что мешает написать ping ? программно ? -)
| |
Страницы: 