procedure TForm1.Button1Click(Sender: TObject); var client: TclIcmpConnection; response: TclIcmpResponse; i: Integer; begin StartupSocket(); client := TclIcmpConnection.Create(); try client.NetworkStream := TclNetworkStream.Create(); client.TimeOut := 1000; client.Open(TclHostResolver.GetIPAddress(edtHost.Text)); Memo1.Lines.Clear(); response := nil; for i := 1 to 4 do begin try client.SendEchoRequest(); response := client.ReceiveResponse(); if not (response.IcmpPacket is TclIcmpEchoPacket) then raise Exception.Create('Invalid ICMP reply'); Memo1.Lines.Add(Format('Reply from %s: seq=%d received bytes=%d time=%dms TTL=%d', [edtHost.Text, (response.IcmpPacket as TclIcmpEchoPacket).SequenceNumber, Length((response.IcmpPacket as TclIcmpEchoPacket).Data), response.RoundTripTime, response.IPHeader.TTL])); Sleep(1000); except on E: Exception do begin Memo1.Lines.Add(edtHost.Text + ' Error: ' + E.Message); end; end; FreeAndNil(response); end; finally client.Free(); CleanupSocket(); end; end;
TclIcmpConnection = class(TclUdpConnection) private FIdentifier: Word; FSequenceNumber: Word; FTTL: Integer; FStartTicks: Integer; procedure NextSequenceNumber; procedure SetTTL; function CalculateChecksum(const AData: TclByteArray; const AIndex, ASize: Integer): Word; public constructor Create; procedure Open(const AIP: string); procedure SendRequest(ARequest: TclIcmpPacket); function ReceiveResponse: TclIcmpResponse; procedure SendEchoRequest; property TTL: Integer read FTTL write FTTL; property Identifier: Word read FIdentifier write FIdentifier; property SequenceNumber: Word read FSequenceNumber write FSequenceNumber; end;
procedure TclIcmpConnection.SendEchoRequest; var echo: TclIcmpEchoPacket; begin echo := TclIcmpEchoPacket.Create(); try echo.Identifier := Identifier; echo.SequenceNumber := SequenceNumber; echo.Data := 'abcdefghijklmnopqrstuvwabcdefghi'; SendRequest(echo); finally NextSequenceNumber(); echo.Free(); end; end; procedure TclIcmpConnection.SendRequest(ARequest: TclIcmpPacket); var stream: TMemoryStream; buf: TclByteArray; ind, checksumInd: Integer; checksum: Word; begin SetTTL(); stream := TMemoryStream.Create(); try SetLength(buf, 1024); ind := 0; ARequest.Build(buf, ind); if (ARequest.Checksum = 0) then begin checksum := CalculateChecksum(buf, 0, ind); checksumInd := 2; ByteArrayWriteWord(checksum, buf, checksumInd); end; stream.Write(buf[0], ind); stream.Position := 0; FStartTicks := Integer(GetTickCount()); WriteData(stream); finally stream.Free(); end; end;
procedure TclIcmpConnection.SendRequest(ARequest: TclIcmpPacket); var stream: TMemoryStream; buf: TclByteArray; ind, checksumInd: Integer; checksum: Word; begin SetTTL(); stream := TMemoryStream.Create(); try SetLength(buf, 1024); ind := 0; ARequest.Build(buf, ind); if (ARequest.Checksum = 0) then begin checksum := CalculateChecksum(buf, 0, ind); checksumInd := 2; ByteArrayWriteWord(checksum, buf, checksumInd); end; stream.Write(buf[0], ind); stream.Position := 0; FStartTicks := Integer(GetTickCount()); WriteData(stream); finally stream.Free(); end; end;
function TclIcmpConnection.ReceiveResponse: TclIcmpResponse; var stream: TMemoryStream; buf: TclByteArray; ind: Integer; ticks: Integer; begin stream := TMemoryStream.Create(); try ReadData(stream); stream.Position := 0; ticks := Integer(GetTickCount()) - FStartTicks; ind := Integer(stream.Size); SetLength(buf, ind); stream.Read(buf[0], ind); ind := 0; Result := TclIcmpResponse.Create(); try Result.Parse(buf, ind); Result.RoundTripTime := ticks; except Result.Free(); raise; end; finally stream.Free(); end; end;
Trouble logging in? Simply enter your email address OR username in order to reset your password.
For faster and more reliable delivery, add admin@clevercomponents.com to your trusted senders list in your email software.