Sofort weiter pingen

[glkgereon]

hi

wenn ich mittels IdIcmpClient pinge, und einen qt wie den hier hab:

Delphi-Quellcode:

for i:=1 to IPs.Count do
  Ping(Ips[i]);

so wartet er ja immer erst bis was zurückgekommen ist (OnReply) und pingt dann weiter.

kann ich ihm sagen, das er erst alles pingen soll, und dann alle OnReplys bearbeiten soll?

[supermuckl]

nein, ausser du benutzt für jeden host eine instanz der icmp componente

am besten ist es, wenn du es mit mehreren threads machst, die deine liste "ab pingen"

ist allerdings kein 4 zeiler ;)

[glkgereon]

also mehrere ping-threads praktisch, die jeweils eine ip "übernehmen"?

[Ultimator]

Naja, angenommen, du willst insgesamt 2000 Hosts pingen:

2000 + 1 Threads für ein Programm sind nicht gut ;)

[glkgereon]

wie dann?

ich hab auch schon überlegt höchstens 100 zu machen, und dann zu warten bis die ersten wieder fertig sind...

aber wie mache ich das?

[shmia]

Ich würde für den Ping-Job von Indy ganz weggehen und auf WinSock umsteigen.

IMHO ist ein Ping eine ICMP Echo message (Internet Control Message Protocol).
Man sollte nun einfach 2000 Messages in einem Rutsch abschicken.
Nun wartet man einfach bis zu 3 Sekunden und protokolliert so lange die eintreffenden Antworten.
Damit dauert so ein "Multi-Ping" nicht länger als ein normaler Ping.

[glkgereon]

ich hab maln bisserl drauf los gecoded.
kann das so hinhauen?

(ein hoch aufs CodeFolding :mrgreen: )

Delphi-Quellcode:

unit UThread;

interface

uses
  Classes, Windows, IdIcmpClient;

type
  TPingOnceThread = class(TThread)
  private
    Ping: TIdIcmpClient;
    FIP: String;
    FOnReply: TOnReplyEvent;
    procedure SetName;
  protected
    constructor Create;
    destructor Destroy;
    property OnReply: TOnReplyEvent read FOnReply write FOnReply;
    property IP: String read FIP write FIP;
    procedure Execute; override;
  end;

  TPingThread = class(TThread)
  private
    FCount: Integer;
    FPings: array [1..100] of TPingOnceThread;
    FResult: array of TReplyStatus;
    FHosts: TStringList;
    procedure SetName;
    procedure NewReply(Status: TReplyStatus);
    procedure Reply(Sender: TComponent; const ReplyStatus: TReplyStatus);
  protected
    constructor Create;
    destructor Destroy;
    function GetNextReply: TReplyStatus;
    procedure Execute; override;
  end;

implementation

type
  TThreadNameInfo = record
    FType: LongWord;     // muss 0x1000 sein
    FName: PChar;        // Zeiger auf Name (in Anwender-Adress-Bereich)
    FThreadID: LongWord; // Thread-ID (-1 ist Caller-Thread)
    FFlags: LongWord;    // reserviert für zukünftige Verwendung, muss 0 sein
  end;

procedure TPingOnceThread.SetName;
var
  ThreadNameInfo: TThreadNameInfo;
begin
  ThreadNameInfo.FType := $1000;
  ThreadNameInfo.FName := 'TPingOnceThread';
  ThreadNameInfo.FThreadID := $FFFFFFFF;
  ThreadNameInfo.FFlags := 0;
  try
    RaiseException( $406D1388, 0, sizeof(ThreadNameInfo) div sizeof(LongWord), @ThreadNameInfo );
  except
  end;
end;

constructor TPingOnceThread.Create;
begin
  inherited Create(True);
  Ping:=TIdIcmpClient.Create(Ping);
end;

destructor TPingOnceThread.Destroy;
begin
  Ping.Free;
  inherited Destroy;
end;

procedure TPingOnceThread.Execute;
begin
  try
    //Init
    SetName;
    Priority:=tpLower;
    Ping.OnReply:=FOnReply;
    Ping.Host:=FIP;
    //Main
    try
      Ping.Ping;
    except
    end;
  finally
    //UnInit
  end;
end;

procedure TPingThread.SetName;
var
  ThreadNameInfo: TThreadNameInfo;
begin
  ThreadNameInfo.FType := $1000;
  ThreadNameInfo.FName := 'TPingThread';
  ThreadNameInfo.FThreadID := $FFFFFFFF;
  ThreadNameInfo.FFlags := 0;
  try
    RaiseException( $406D1388, 0, sizeof(ThreadNameInfo) div sizeof(LongWord), @ThreadNameInfo );
  except
  end;
end;

procedure TPingThread.NewReply(Status: TReplyStatus);
begin
  SetLength(FResult,FCount+1);
  FResult[FCount]:=Status;
  Inc(FCount);
end;

procedure TPingThread.Reply(Sender: TComponent; const ReplyStatus: TReplyStatus);
begin
  NewReply(ReplyStatus);
end;

constructor TPingThread.Create;
begin
  inherited Create(True);
  FHosts:=TStringList.Create;
  FCount:=0;
end;

destructor TPingThread.Destroy;
begin
  SetLength(FResult,0);
  FHosts.Free;
  inherited Destroy;
end;

function TPingThread.GetNextReply: TReplyStatus;
var i:Integer;
begin
  Result:=FResult[0];
  for i:=0 to FCount-2 do
    FResult[i]:=FResult[i+1];
  Dec(FCount);
  SetLength(FResult,FCount);
end;

procedure TPingThread.Execute;
var Hosts: TStringList;
    i, Temp: Integer;
begin
  try
    //Init
    Hosts:=TStringList.Create;
    Hosts.AddStrings(FHosts);

    //Main
    Temp:=Hosts.Count;
    for i:=1 to Temp do
      if i>100 then Break
      else
        begin
        FPings[i]:=TPingOnceThread.Create;
        FPings[i].FOnReply:=Reply;
        FPings[i].IP:=Hosts[0];
        Hosts.Delete(0);
        FPings[i].Execute;
        end;

  finally
    //UnInit
    for i:=1 to 100 do
      try
        FPings[i].Free;
      except
      end;
  end;
end;

end.

Edit:
Das mit den WinSockets probier ich grad aus, weiss aber (noch) nich so richtig wo ich das was abschicken muss...krieg ich schon noch raus...