Windows comes with Tracert to send ICMP packets to the remote host, but now many hosts turn off ICMP replies, this tool is not very good to make ~~~~~ Principle know, regular TRACE is not to send TTL sequentially increment UDP package? What gateway and routing dare to discard our UDP bag free to notify us? You can ignore the ICMP package, but udp packs ~~~~~ Not afraid of black you? ? ?
Unit ytribords;
Interface
Uses windows;
Const packet_size = 32; max_packet_size = 512; trace_port = 34567; local_port = 5555;
TYPE S32 = INTEGER; U32 = DWORD; u8 = byte; u16 = word; pu16 = ^ U16;
////// ipp packet header // pipheader = ^ yipheader; yipheader = record u8verlen: u8; // 4bits Ver, 4bits len, len * 4 = true length u8tos: u8; // type of service, 3bits priority (now Already neglected), 4bits TOS, only 1 bit is 1 U16Totallen: U16; // The length of the entire IP datagram, in bytes. U16ID: U16; / / Identify each datagon sent by the host. U16OFFSET: U16; // 3bits logo, 13BITS Split U8TTL: U8; // The Survival Time field sets the maximum number of routers that the datagram can pass. U8PROTOL: U8; // Protocol type, 6 indicates that the transport layer is a TCP protocol. U16Checksum: U16; // First inspection and. U32SRCADDR: U32; // source IP address, not 'xxx.xxx.xxx.xxx' situation Oh U32DestAddr: U32; // destination IP address, the same end;
//////////Picmpheader = ^ yicmpheader; yicmpheader = Record U8Type: U8; U8Code: U8; U16CHKSUM: U16; U16ID: U16; U16SEQ: U16; END;
Unit unit1;
Interface
Uses Windows, Messages, Sysutils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Stdctrls, Yystems, Winsock2;
type TForm1 = class (TForm) ListBox1: TListBox; Edit1: TEdit; Button1: TButton; procedure FormCreate (Sender: TObject); procedure FormClose (Sender: TObject; var Action: TCloseAction); procedure Button1Click (Sender: TObject); private { Private Declarations}}}} End; var form1: tform1;
IMPLEMENTATION
{$ R * .dfm}
function DecodeIcmpReply (pbuf: PChar; var seq: s32): string; var pIpHdr: PChar; pIcmphdr: PICMPHeader; sip: string; ttl: integer; begin pIpHdr: = pbuf; sip: = inet_ntoa (TInAddr (PIPHeader (pIpHdr) ^ .u32srcaddr); TTL: = pipheader (piphdr) ^. U8TTL;
INC (PipHDR) * 4) * 4); PICMphdr: = PICMpheader (PipHDR);
Result: = '; if picmphdr ^ .u8type = 3 THEN // The purpose is not accessible information, Trace completes SEQ: = 0; if picmphdr ^ .U8type = 11 THEN // Timeout information, is trace result: = format ('% 4D% 32S% 8D ', [SEQ, SIP, TTL]); END;
Procedure errmsg (MSG: String); Begin MessageBox (0, Pchar (MSG), 'Ping Program Error', MB_ICONERROR); END;
Procedure TForm1.Formcreate (Sender: TOBJECT); VAR WSA: TWSADATA; Begin IF WsaStartup ($ 0202, WSA) <> 0 Then Errmsg ('Windows Socket IS Not Responed.'); listbox1.font.name: = 'Courier New' ListBox1.font.size: = 9;
Procedure TForm1.FormClose (Sender: TpoBject; VAR Action: Tclosection); Begin IF WSACLEANUP <> 0 Then Errmsg ('Windows Socket CAN NOT BE CLOSED.'); END;
procedure TForm1.Button1Click (Sender: TObject); const SIO_RCVALL = IOC_IN or IOC_VENDOR or 1; var rawsock: TSocket; pRecvBuf: PChar; FromAdr: TSockAddr; FromLen: s32; fd_read: TFDSet; timev: TTimeVal; sReply: string; udpsock: TSocket; ret: s32; DestAdr: TSockAddr; pSendBuf: PChar; ttl, opt: s32; pHost: PHostEnt; begin // create a RAWSOCK received replies from ICMP packet rawsock: = socket (AF_INET, SOCK_RAW, IPPROTO_ICMP); FromAdr.sin_family: = AF_INET; FromAdr.sin_Port: = htons (0); fromAdr.sin_addr.s_addr: = inet_addr ('192.168.1.12'); // Change to your IP
// If you don't bind, you can't receive a package ~~~ Because you have to create a udpsock bind (Rawsock, @fromadr, sizeof (fromadr));
Opt: = 1; WSAIOCTL (Rawsock, SiO_RCVALL, @opt, sizeof (opt), nil, 0, @ret, nil, nil);
/ / Receive the buffer precvbuf: = allocmem (max_packet_size);
// Create a UDPSOCK Send Probe Pack UDPSOCK: = Socket (AF_INET, SOCK_DGRAM, IPPROTO_UDP);
// The UDP data to be sent psendbuf: = allocmem (packet_size); Fillchar (psendbuf ^, packet_size, 'c');
Fillchar (Destadr, Sizeof (Destadr), 0); Destadr.sin_Family: = AF_INET; DESTADR.SIN_PORT: = HTONS (TRACE_PORT); DESTADR.SIN_ADDR.S_ADDR: = INET_ADDR (Pchar (Edit1.Text));
// If edit1.text is not an IP address, try parsing the domain name if destadr.sin_addr.s_addr = inaddr_none dam phost: = gethostbyname (pchar (edit1.text)); if Phost <> nil dam move (phost ^ .h_addr ^^, destadr.sin_addr, phost ^ .h_length; destr.sin_family: = phost ^ .h_addrtype; destadr.sin_port: = htons (trace_port); listbox1.items.add (Edit1.Text 'IP address -> INT_NTOA (DESTADR.SIN_ADDR); ELSE BEGIN ListBox1.Items.Add ('parsing domain name:' edit1.text 'error.'); CloseSocket (Rawsock); CloseSocket (UDPSOCK); FreeMem (psendbuf); FreeMem ( PRECVBUF; exit; end; end; listbox1.items.add ('trace route' edit1.text '); listbox1.update;
// Start TRACE !!! TTL: = 1; While True Do Begin // Set TTL, make the TTL of the UDP package we sent sequentially accumulate setsockopt (udpsock, ipproto_ip, ip_ttl, @ttl, sizeof (ttl)); /// Send UDP to Host Sendto (udpsock, psendbuf ^, packet_size, 0, destadr, sizeof (destadr));
FD_ZERO (fd_read); fd_set (rawsock, fd_read); timev.tv_sec: = 5; timev.tv_usec: = 0;
IF SELECT (0, @fd_read, nil, nil, @timev) <1 the Break;
if FD_ISSET (rawsock, fd_read) then begin FillChar (pRecvBuf ^, MAX_PACKET_SIZE, 0); FillChar (FromAdr, sizeof (FromAdr), 0); FromAdr.sin_family: = AF_INET; FromLen: = sizeof (FromAdr); recvfrom (rawsock, PRECVBUF ^, Max_packet_size, 0, fromAdr, fromlen;
Sreply: = decodeicmpreply (precvbuf, ttl); if Sreply <> '' Then Begin ListBox1.ItemIndex: = listbox1.Items.add (Sreply); ListBox1.Update; end; if ttl = 0 Then // If you receive a target host The corresponding bag, decodeicmpreply will put TTL == 0 Break; End; Inc (TTL); SLEEP (110); End; // While Not Bstop DO
Listbox1.items.add ('tracking route is completed.'); Listbox1.Items.add ('');
CloseSocket; CloseSocket (UDPSOCK); FreeMem (Psendbuf); FreeMem (PRECVBUF); END;
End.
