The sample represents simple ICMP client for Delphi with Ping functionality.

The code utilizes the Clever Internet Suite library.

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;

Article ID: 75, Created: December 20, 2013 at 12:16 PM, Modified: December 12, 2019 at 8:11 PM

Ping client

Add Feedback

Was this article helpful?

Share this article