Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Netzwerke (https://www.delphipraxis.net/14-netzwerke/)
-   -   Delphi Ping ausführen und bei Erfolg Farbe ändern (https://www.delphipraxis.net/42680-ping-ausfuehren-und-bei-erfolg-farbe-aendern.html)

StoRmtec 22. Mär 2005 13:35


Ping ausführen und bei Erfolg Farbe ändern
 
Hallo

Und zwar bin ich dabei ein kleines Programm zu schreiben für uns in der Firma.
Und zwar wenn ich einen Ping ausführe das er mir dann anzeigt ob er da ist oder nicht.
Also mit rot und grün anzeigen.

Denn Ping führe ich mit der Indy Compo aus.

Delphi-Quellcode:
procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
begin
  IdIcmpClient1.OnReply := IdIcmpClient1Reply;
  Button1.Enabled := False;
  try
    IdIcmpClient1.Host := Edit1.Text;
    for i := 1 to 4 do
    begin
      IdIcmpClient1.Ping;
      Application.ProcessMessages;
    end;
  finally
    Button1.Enabled := True;
  end;
end;




procedure TForm1.IdIcmpClient1Reply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
var
  sTime: string;
begin
  if (IdIcmpClient1.ReplyStatus.MsRoundTripTime = 0) then
    sTime := '<1'
  else
    sTime := '=';
    ListBox1.Items.Add(Format('%d Byte von %s: icmp_seq=%d ttl=%d Zeit%s%d
ms',
    [IdIcmpClient1.ReplyStatus.BytesReceived,
IdIcmpClient1.ReplyStatus.FromIpAddress,
    IdIcmpClient1.ReplyStatus.SequenceId,
IdIcmpClient1.ReplyStatus.TimeToLive,
    sTime, IdIcmpClient1.ReplyStatus.MsRoundTripTime]));
end;
Jetzt gibt er es mir in der ListBox aus.
So jetzt habe ich statt der ListBox die Label hinzugefügt aber er macht mir das immer grün.
Wie kann ich das jetzt machen das er wenn der Ping nicht erfolgreich war rot bleibt.

Um eine Antwort wäre ich sehr dankbar.

Gollum 22. Mär 2005 18:00

Re: Ping ausführen und bei Erfolg Farbe ändern
 
Hallo,

da ich das mit den Labels nicht verstehe, poste ich Dir eine Version, die die Einträge in der Listbox einfärbt.

Im Objektinspektor stellst Du die Eigenschaft [b]Style[b] der ListBox auf lbOwnerDrawFixed.
Delphi-Quellcode:
procedure TForm1.IdIcmpClient1Reply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
var sText, sTime: string;
begin
  if (IdIcmpClient1.ReplyStatus.MsRoundTripTime = 0) then sTime:='<1' else sTime:='=';
  sText:=Format('%d Byte von %s: icmp_seq=%d ttl=%d Zeit%s%dms',
                [IdIcmpClient1.ReplyStatus.BytesReceived, IdIcmpClient1.ReplyStatus.FromIpAddress,
                   IdIcmpClient1.ReplyStatus.SequenceId, IdIcmpClient1.ReplyStatus.TimeToLive,
                   sTime, IdIcmpClient1.ReplyStatus.MsRoundTripTime])+#9;
  // wenn mehr als 0 Byte empfangen wurden, dann gibt es eine Verbindung
  // diese Info wird durch Tab getrennt am Ende des Listboxeintrages
  // durch 1 und 0 repräsentiert.
  if (IdIcmpClient1.ReplyStatus.BytesReceived>0) then sText:=sText+'1'
    else sText:=sText+'0';
  Listbox1.Items.Add(sText);
end;


procedure TForm1.Button1Click(Sender: TObject);
var i:Integer;
begin
  //IdIcmpClient1.OnReply := IdIcmpClient1Reply;
  Button1.Enabled := False;
  try
    IdIcmpClient1.Host := Edit1.Text;
    for i := 1 to 4 do
    begin
      IdIcmpClient1.Ping;
      Application.ProcessMessages;
    end;
  finally
    Button1.Enabled := True;
  end;
end;


procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var s1, s2:String;
    x    :Integer;
begin
  with TListBox(Control) do
  begin
    // Position des Tab-Ziechens im aktuell anzuzeigenden Eintrag
    x:=System.Pos(#9, Items[Index]);
    // Listboxtext
    s1:=System.Copy(Items[Index], 1, x-1);
   
    // Status
    s2:=System.Copy(Items[Index], x+1, 1);
    if (s2='1') then Canvas.Font.Color:=clGreen
      else Canvas.Font.Color:=clRed;
    if (odSelected in State) then Canvas.Font.Color:=clWhite;
    Canvas.TextRect(Rect, Rect.Left+1, Rect.Top+1, s1);
  end; // wiht
end;

StoRmtec 22. Mär 2005 19:57

Re: Ping ausführen und bei Erfolg Farbe ändern
 
Hallo

Danke für die Hilfe.
Aber ich möchte gerne die ListBox ausbauen und statt dessen ein Label machen
wenn mehr als 0 Byte ankommen dann sollte das grün werden sonst sollte es rot
bleiben.

mfg
StoRmtec

Gollum 22. Mär 2005 20:11

Re: Ping ausführen und bei Erfolg Farbe ändern
 
Hallo,

etwa so?

Delphi-Quellcode:
procedure TForm1.IdIcmpClient1Reply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
var sTime: string;
begin
  if (IdIcmpClient1.ReplyStatus.MsRoundTripTime = 0) then sTime:='<1' else sTime:='=';
  Label1.Caption:=Format('%d Byte von %s: icmp_seq=%d ttl=%d Zeit%s%dms',
                [IdIcmpClient1.ReplyStatus.BytesReceived, IdIcmpClient1.ReplyStatus.FromIpAddress, IdIcmpClient1.ReplyStatus.SequenceId, IdIcmpClient1.ReplyStatus.TimeToLive, sTime, IdIcmpClient1.ReplyStatus.MsRoundTripTime])+#9;
  if (IdIcmpClient1.ReplyStatus.BytesReceived>0) then Label1.Font.Color:=clGreen
    else Label1.Font.Color:=clRed;
end;

StoRmtec 22. Mär 2005 20:20

Re: Ping ausführen und bei Erfolg Farbe ändern
 
Hallo

Ja danke und das ganze kann man dann auch ohne den
Label1.Caption:=Format('%d Byte von %s: icmp_seq=%d ttl=%d Zeit%s%dms',
auch machen oder das wirklich nur das label grün oder rot ist.

mfg
Stormtec

Gollum 23. Mär 2005 06:39

Re: Ping ausführen und bei Erfolg Farbe ändern
 
Hallo,

aber sicher doch:
Delphi-Quellcode:
procedure TForm1.IdIcmpClient1Reply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
begin
  if (IdIcmpClient1.ReplyStatus.BytesReceived>0) then Label1.Font.Color:=clGreen
    else Label1.Font.Color:=clRed;
end;


Alle Zeitangaben in WEZ +1. Es ist jetzt 01:51 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz