ассинхронные ICMP

varvar — Fri, 05 Dec 2003 12:16:52 +0000

varvar: 1) winsock2 file not found
2) SOCK_RAW я так понимаю, под гостём в 2000 работать не будет

ассинхронные ICMP

Борис — Thu, 04 Dec 2003 21:29:14 +0000

Борис: Лови.
program S_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;

HDR=packed record
IP:TIPHeader;
Icmp:PICMPHEADER;
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;
Head:HDR;

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;

begin

TimeOut:=1000;
if (WSAStartup($0002,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(Timeout));
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(Timeout));
if(Bread <> 0) then
begin
writeln('failed to set send timeout: ',WSAGetLastError());
ExitProcess(STATUS_FAILED);
end;

ZeroMemory(@Dest,sizeof(Dest));
hp := gethostbyname(PChar('127.0.0.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);

{head.Icmp:=PIcmpHeader(ICMP_DATA);
head.IP.VerLen:=4;
head.IP.tos:=0;
head.IP.frag_and_flags:=0;
head.IP.ttl:=255;
head.IP.proto:=IPPROTO_ICMP;
head.IP.destIP:=Inet_addr('127.0.0.1');
head.IP.sourceIP:=Inet_Addr('137.0.0.1');
DataSize:=DataSize+sizeof(head.IP);
}

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(500);
end;

WSACleanUp;
FreeMem(RecvBuf);
FreeMem(ICMP_Data);
end.

ассинхронные ICMP

varvar — Wed, 05 Nov 2003 11:35:16 +0000

varvar: Пасибо конечно, но нельзя ли это на АПИ сделать, а то я меня из-за этих компанентов и так проект разбух дальше некуда. ???

ассинхронные ICMP

Mischka — Wed, 05 Nov 2003 08:47:07 +0000

Mischka: Пользуй IdICMPClient. У него есть Timeout, который можно в мс задавать.

ассинхронные ICMP

varvar — Tue, 04 Nov 2003 11:44:08 +0000

varvar: В примере приведенном здесь http://www.sources.ru/delphi/delphi_ping.shtml один не работающий хост секунд 15 пингуется.

ассинхронные ICMP

Mischka — Tue, 04 Nov 2003 03:03:34 +0000

Mischka: а нафига асинхронно?
150 компов пингуется за несколько секунд...

ассинхронные ICMP

varvar — Mon, 03 Nov 2003 13:18:57 +0000

varvar: Подскажите плс. как можно посылать ассинхроонные ICMP-пакеты. Мне надо пропинговать несколько адресов(около 150-ти).

ассинхронные ICMP

varvar — Wed, 05 Nov 2003 11:35:16 +0000

ассинхронные ICMP

Mischka — Wed, 05 Nov 2003 08:47:07 +0000

Mischka: Пользуй IdICMPClient. У него есть Timeout, который можно в мс задавать.

ассинхронные ICMP

varvar — Tue, 04 Nov 2003 11:44:08 +0000

varvar: В примере приведенном здесь http://www.sources.ru/delphi/delphi_ping.shtml один не работающий хост секунд 15 пингуется.

ассинхронные ICMP

Mischka — Tue, 04 Nov 2003 03:03:34 +0000

Mischka: а нафига асинхронно?
150 компов пингуется за несколько секунд...

ассинхронные ICMP

varvar — Mon, 03 Nov 2003 13:18:57 +0000

Форум на Исходниках.RU

ассинхронные ICMP

ассинхронные ICMP

ассинхронные ICMP

ассинхронные ICMP

ассинхронные ICMP

ассинхронные ICMP

ассинхронные ICMP

ассинхронные ICMP

ассинхронные ICMP

ассинхронные ICMP

ассинхронные ICMP

ассинхронные ICMP