Ping mit Delphi

[Johannes Bedenbender]

Kennt jemand eine Komponente für Delphi, mit der man einfach im Netzwerk andere Computer anpingen kann.
Super wäre auch, wenn mir jemand sagen könnte, wie ich das direkt über Winsock realisieren könnte!

Danke schon mal im Vorraus

[Andreas Kosch]

Hallo,

das folgende Beispiel greift auf die FreeWare-Komponente <b>TPing</b> aus der <b>Internet Component Suite</b> (ICS - siehe http://www.rtfm.be/fpiette/indexuk.htm) zu und scannt einen definerbaren IP-Adressenbereich nach verfügbaren Rechnern über Ping ab. Wird ein Rechner vorgefunden, prüft das Programm, ob dort ein Web-Server läuft:
<pre>
unit IPSonarMainForm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, Ping, WSocket, Buttons, ScktComp;

type
TFormMain = class(TForm)
StatBar: TStatusBar;
EditIP: TEdit;
ListBoxPC: TListBox;
Ping1: TPing;
EditStart: TEdit;
EditTimeOut: TEdit;
Label3: TLabel;
EditEnd: TEdit;
Label5: TLabel;
UpDown1: TUpDown;
UpDown2: TUpDown;
UpDown3: TUpDown;
SBtnSonar: TSpeedButton;
Progress: TProgressBar;
SBtnCancel: TSpeedButton;
ListBoxWeb: TListBox;
ClientSocket1: TClientSocket;
StaticText1: TStaticText;
StaticText2: TStaticText;
Animate1: TAnimate;
procedure Ping1EchoReply(Sender: TObject; Error: Integer);
procedure Ping1DnsLookupDone(Sender: TObject; Error: Word);
procedure SBtnSonarClick(Sender: TObject);
procedure SBtnCancelClick(Sender: TObject);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ListBoxWebClick(Sender: TObject);
private
{ Private-Deklarationen }
FSearchIP : String[16];
FFoundPC : Integer;
FCancelPing : Boolean;
procedure CheckWebServer(IPAdr : String);
public
{ Public-Deklarationen }
end;

var
FormMain: TFormMain;

implementation

{$R *.DFM}

uses ShellAPI;

procedure TFormMain.Ping1EchoReply(Sender: TObject; Error: Integer);
begin
if Error <> 0 then begin
ListBoxPC.Items.Add(Format('%s (Zeit: %d ms)',
[FSearchIP, Ping1.Reply.RTT]));
ListBoxPC.Refresh;
Inc(FFoundPC);
CheckWebServer(FSearchIP);
end;
end;

procedure TFormMain.Ping1DnsLookupDone(Sender: TObject; Error: Word);
begin
FSearchIP := Ping1.DnsResult;
Ping1.Address := FSearchIP;
Ping1.Ping;
end;

procedure TFormMain.SBtnSonarClick(Sender: TObject);
var
iPos,
iCnt,
iMin,
iMax : Integer;
sIP : String[16];
begin
FCancelPing := False;
ListBoxPC.Items.Clear;
FFoundPC := 0;
iPos := 0;
iMin := StrToInt(EditStart.Text);
iMax := StrToInt(EditEnd.Text);
Progress.Min := 0;
Progress.Max := iMax - iMin;
Ping1.Timeout := StrToInt(EditTimeOut.Text);
Animate1.Visible := True;
Animate1.Active := True;
for iCnt := iMin to iMax do
begin
Application.ProcessMessages;
if FCancelPing then
Break;
sIP := EditIP.Text + IntToStr(iCnt);
StatBar.Panels[1].Text := sIP;
Inc(iPos);
Progress.Position := iPos;
Ping1.DnsLookup(sIP);
Application.ProcessMessages;
end;
StatBar.Panels[1].Text := Format(' %d Rechner gefunden.', [FFoundPC]);
Progress.Position := 0;
Animate1.Visible := False;
Animate1.Active := False;
end;

procedure TFormMain.SBtnCancelClick(Sender: TObject);
begin
FCancelPing := True;
Animate1.Visible := False;
Animate1.Active := False;
end;

procedure TFormMain.CheckWebServer(IPAdr: String);
begin
with ClientSocket1 do
begin
try
Active := False;
Application.ProcessMessages;
Address := IPAdr;
Active := True;
except
end;
end;
end;

procedure TFormMain.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
ListBoxWeb.Items.Add(Format('%s',[ClientSocket1.Address]));
Application.ProcessMessages;
ClientSocket1.Active := False;
end;

procedure TFormMain.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocke

vielen dank!

diese komponente (TPing) hat mir sehr weitergeholfen.

root