Sofort weiter pingen

[glkgereon]

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

(ein hoch aufs CodeFolding )

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...