Aplikasi Ping dengan Delphi #208

andrypein.net : Meskipun tidak mirip amat dengan cmd nya windows namun aing jagoan bikin ini walau 50% kopas 50% improve dan 100% bug fix.

Ini bahan yang diperlukan untuk membuat ping dengan delphi gan :

Untuk komponen Indy ICMP nya bisa dicari di palette indy client.

1. Persiapan pertama adalah menyiapkan variabel privat, fungsi dan prosedur privat.

  private
    { Private declarations }
    line,hasil : string;
    procedure cetak;
    function pangkatBulat(a : real; b : integer) : real;
  public
    { Public declarations }
  end;

2. Kode untuk fungsi pangkat.

function TForm1.pangkatBulat(a: Real; b: Integer) : real;
var
  i : integer;
  temp : real;
begin
  temp:=1;
  for I := 1 to b do
    begin
      temp:=temp*a;
    end;
  pangkatbulat:=temp;
end;

3. Lalu prosedur cetak nya cukup kaya gini :

procedure TForm1.cetak;
begin
 memo1.Lines.Add(line);
end;

4. Untuk form, beri event OnCreate.

procedure TForm1.FormCreate(Sender: TObject);
var
  i,k:smallint;
begin
  timer1.Enabled:=false;
  btnstop.Enabled:=false;
  memo1.Clear;
  edit1.Clear;
  memo1.ReadOnly:=true;

  k:=2;
  for I := 1 to 8 do
    begin
      combobox1.Items.Add(floattostr(pangkatbulat(k,i)));
    end;
end;

5. Yang gampang dulu untuk tombol exit :v

procedure TForm1.btnexitClick(Sender: TObject);
begin
  application.Terminate;
end;

6. untuk tombol clear

procedure TForm1.btnclearClick(Sender: TObject);
begin
  memo1.Clear;
end;

7. Next untuk tombol stop.

procedure TForm1.btnstopClick(Sender: TObject);
begin
  memo1.Lines.Add(timetostr(time)+' - Stopped');
  timer1.Enabled:=false;
  btnstop.Enabled:=false;
  btnstar.Enabled:=true;
end;

8. Dan untuk tombol start nya

procedure TForm1.btnstarClick(Sender: TObject);
begin
  if (edit1.Text = '') or (combobox1.Text = '') then
    begin
      showmessage('jangan kosong');
    end
  else
    begin
      memo1.Lines.Add('Pinging at '+ edit1.Text);
      timer1.Enabled:=true;
      btnstar.Enabled:=false;
      btnstop.Enabled:=true;
    end;
end;

9. Kode-kode untuk pertombolan selesai, lalu tambahkan uses berikut ini di bagian uses nya antara lain IDException dan idstack.

10. Pada IDICMClient1 nya beri event OnReply.

note : IDICMPClient1 nya ane ubah properti name jadi ICMP aja

procedure TForm1.ICMPReply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
var
  reply,status : string;
begin
  case ICMP.ReplyStatus.ReplyStatusType of
    rsEcho:
      begin
        status:='';
        reply:=format('Reply from [%s] with %d byte received, time= %d ms TTL= %d',
            [ICMP.ReplyStatus.FromIpAddress,
            ICMP.ReplyStatus.BytesReceived,
            ICMP.ReplyStatus.MsRoundTripTime,
            ICMP.ReplyStatus.TimeToLive]);
      end;
    rsError:
      begin
        reply:='reply from '+edit1.Text;
        Status := ' - Error Ocurred.';
      end;
    rsTimeOut:
      begin
        reply:='reply from '+edit1.Text;
        Status := ' - timed out.';
      end;
    rsErrorUnreachable:
      begin
        reply:='reply from '+edit1.Text;
        Status := ' error unreachable.';
      end;
    rsErrorTTLExceeded:
      begin
        reply:='reply from '+edit1.Text;
        Status := ' - TTL exceeded.';
      end;
    rsErrorPacketTooBig: ;
    rsErrorParameter: ;
    rsErrorDatagramConversion: ;
    rsErrorSecurityFailure: ;
    rsSourceQuench: ;
    rsRedirect: ;
    rsTimeStamp: ;
    rsInfoRequest: ;
    rsAddressMaskRequest: ;
    rsTraceRoute: ;
    rsMobileHostReg: ;
    rsMobileHostRedir: ;
    rsIPv6WhereAreYou: ;
    rsIPv6IAmHere: ;
    rsSKIP: ;
  end;
  Line := TimeToStr(Time) + ' - ' + Reply + Status;
  cetak;
end;

11. Terakhir pada timer OnTimer,

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  ICMP.OnReply:=ICMPReply;
  ICMP.ReceiveTimeout:=5000;
  if combobox1.Text = '' then
    ICMP.PacketSize:=1024
  else
    ICMP.PacketSize:=strtoint(combobox1.Text);
  try
    ICMP.Host:=edit1.Text;
    begin
      ICMP.Ping();
      application.ProcessMessages;
    end;
  except
    on A: EIdException do
      begin
        Line := Timetostr(Time) + ' - ' + A.Message;
        cetak;
        if A is EIdConnClosedGracefully then
          raise;
      end;
  end;

end;

Done, bisa dirunning lah gan coba ping gogel atau apa saja bebas, jangan lupa donlod ping dengan delphi nya hanya di aing.

Download

*AFK