Servus,

habe ca. 100 Geräte die ich auf Pings testen muss.
Da die ICMP-Kommunikation nicht verbindungsorientiert abläuft, kann ich nicht mehrer Threads verwenden sondern immer per CriticalSection den Ping sperren. Nur das dauert wenn die anderen Threads warten müssen bis ein Ping beendet wurde.

Wie könnte man das ganze optimieren?

Mfg

Hallo ackie1983, ICMP requests sind normalerweise verbindungsorientiert = Blockierend.
Wie dies bei den Indys implementiert ist, kann ich nicht sagen, kenn ich nicht.
Allerdings hab ich da noch im Hinterkopf, dass es da auch einen Port, normalerwiese 7 = Pingport
bei der Komponente einzutragen ist. Dies deutet auf eien AF_INET socket hin. Bei dem muss der
Port 7 dann offen sein, ist aber seit XP mit FW nicht mehr der Fall. Hier helfen nur ICMP Packete
auf RAW Socket Basis.

Anbei modifiziertes Sample von Narses.

zusammenfalten · markieren

Delphi-Quellcode:

unit uPingThread;

interface

uses
  windows,
  winsock,
  Sysutils,
  Classes;

const
  PACKET_SIZE = 32;
  ICMP_ECHO_REQUEST = 8;

type
  PICMP = ^TICMP;
  TICMP = packed record
    Typ : Byte;
    Code : Byte;
    CheckSum : Word;
    ID : Word;
    Seq_Num : Word;
    Data : array[1..PACKET_SIZE] of Byte;
  end;

  TPingCallBack = function(ErrorCode: integer; nMsec: integer;
    const AMsg: string; AICMP: TICMP): Boolean of object;

  TPingThread = class(TThread)
  private
    FPingCallBack: TPingCallBack;
    FIPAddr: string;
    FICMP: TICMP;
    procedure Ping;
  public
    procedure Execute; override;
    constructor Create(const AIPAddr: string; APingCallBack: TPingCallBack);
    destructor Destroy; override;
  end;

implementation

var
  _WsadData : TWsaData;
  _SeqNum : Word = 0;
  _SeqID : Word = Word(-1);
  _SocketLock : TRTLCriticalSection;

procedure TPingThread.Ping;
var
  Addr: TSockAddr;
  Sock: TSocket;
  ICMP: TICMP;
  ICMPret: PICMP;
  i: Integer;
  Start, Ende: Integer;
  Read: TFDSet;
  TimeOut: TTimeVal;
  buf: array [0..1023] of Byte;
  IPHeaderLen, IPLen: Integer;
  Checksum: Word;
  CheckSumTemp: Integer;
  pw: PWord;
  nMsec: integer;
begin
  nMsec := Integer(-1);
  try
    nMsec := Integer(-1);
    ZeroMemory(@FICMP, SizeOf(TICMP));

    EnterCriticalSection(_SocketLock);
    try
      if _SeqNum = word(-1) then _SeqNum := 0;
      Inc(_SeqNum);

      if _SeqID = 0 then _SeqNum := word(-1);
      Dec(_SeqID);
    finally
      LeaveCriticalSection(_SocketLock);
    end;

    Sock := Socket(AF_INET, SOCK_RAW, IPPROTO_ICMP);
    if Sock = invalid_Socket then begin
      FPingCallBack(WSAGetLastError, -1, SysErrorMessage(WSAGetLastError),
        FICMP);
      Exit;
    end;
    try
      EnterCriticalSection(_SocketLock);
      try
        ICMP.Typ := ICMP_ECHO_REQUEST;
        ICMP.Code := 0;
        ICMP.CheckSum := 0;
        ICMP.ID := _SeqID;
        ICMP.Seq_Num := swap(_SeqNum);

        FillChar(ICMP.Data, Length(ICMP.Data), 9);

        pw := @ICMP;
        CheckSum := 0;
        for i := 1 to sizeof(ICMP) div 2 do begin
          CheckSumTemp := CheckSum + not(swap(pw^));
          CheckSum := CheckSumtemp and $FFFF;
          inc(CheckSum,(CheckSumTemp and $10000) shr 16);
          inc(pw);
        end;
        if sizeof(ICMP) mod 2 = 1 then begin
          CheckSumTemp := CheckSum + not(swap(word(ICMP.data[high(ICMP.data)])));
          CheckSum := CheckSumtemp and $FFFF;
          inc(CheckSum, (CheckSumTemp and $10000) shr 16);
        end;
        ICMP.CheckSum:=swap(CheckSum);

        addr.sin_family := AF_INET;
        addr.sin_port := 0;
        addr.sin_addr.S_addr := Inet_Addr(PAnsiChar(FIPAddr));
      finally
        LeaveCriticalSection(_SocketLock);
      end;

      if sendto(sock, ICMP, sizeof(ICMP), 0, addr, sizeof(Addr)) =
        Socket_Error then
      begin
        FPingCallBack(WSAGetLastError, -1, SysErrorMessage(WSAGetLastError),
          FICMP);
        Exit;
      end;
      start := gettickcount;
      FD_ZERO(Read);
      FD_Set(sock,Read);
      TimeOut.tv_sec := 2;
      TimeOut.tv_usec := 0;
      if Select(0, @Read, nil, nil, @TimeOut) > 0 then begin
        IPLen := recv(sock, buf, length(buf), 0);
        Ende := gettickcount;

        if IPLen = Socket_Error then
          raise Exception.Create(
            'Fehler bei recv' + #13#10 +
              SysErrorMessage(WSAGetLastError));

        if ((buf[0] and $F0) shr 4 = 4) then begin
          IPHeaderlen := (buf[0] and $0F) * 4;

          if IPHEaderlen + sizeof(ICMP) < IPLen then
            raise Exception.Create('Antwortpaket zu kurz');

          ICMPret := @buf[IPHeaderlen];

          move(ICMPret^, FICMP, SizeOf(TICMP));
          case ICMPret^.Typ of
            0 : begin
                  nMsec := Ende - Start;
                  FPingCallBack(WSAGetLastError, nMsec,
                    format(FIPAddr + ' Antwort in %d ms erhalten', [nMsec]),
                      FICMP);
            end;
            3 : FPingCallBack(WSAGetLastError, nMsec,
                  FIPAddr + ' Ziel nicht erreichbar Error ' +
                    IntToStr(ICMPret^.Code), FICMP);

            11: FPingCallBack(WSAGetLastError, nMsec,
                  FIPAddr + ' Zeitlimit (TTL) überschritten' +
                    IntToStr(ICMPret^.Code), FICMP);

            else
              FPingCallBack(WSAGetLastError, nMsec,
                  format(FIPAddr + ' Unbekannte Antwort: Typ %d',
                    [ICMPret^.Code]), FICMP);
          end;
        end else
          FPingCallBack(WSAGetLastError, nMsec,FIPAddr +
            ' Kann IPv6 nicht lesen.', FICMP);
      end else
        FPingCallBack(WSAGetLastError, nMsec, FIPAddr + ' TimeOut',FICMP);
    finally
      closesocket(sock);
    end;
  except
    on e: exception do begin
      FPingCallBack(WSAGetLastError, nMsec, e.Message, FICMP);
    end;
  end;
end;

{ TPingThread }

constructor TPingThread.Create(const AIPAddr: string;
  APingCallBack: TPingCallBack);
begin
  inherited create(true);
  FreeOnTerminate := true;
  FPingCallBack := APingCallBack;
  if @FPingCallBack = nil then
    Raise Exception.Create('TPingCallBack not assigned!');
  FIPAddr := AIPAddr;
  ZeroMemory(@FICMP, SizeOf(TICMP));
  Resume;
end;

destructor TPingThread.Destroy;
begin
  inherited;
end;

procedure TPingThread.Execute;
begin
  Ping;
  Sleep(30);
  Ping;
  Sleep(30);
  Ping;
  Sleep(30);
end;

initialization
  if (WSAStartup($0020, _WsadData) <> S_OK) then
    raise Exception.Create('WSAStartup: ' + IntToStr(WSAGetLastError));
  InitializeCriticalSection(_SocketLock);
finalization
  DeleteCriticalSection(_SocketLock);
  if (WSACleanup <> S_OK) then
    raise Exception.Create('WSACleanup: ' + IntToStr(WSAGetLastError));
end.

Verwendung:

zusammenfalten · markieren

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, uPingThread, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;


type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    function PingCallBack(ErrorCode: integer; nMsec: integer;
      const AMsg: string; AICMP: TICMP): boolean;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


function TForm1.PingCallBack(ErrorCode: integer; nMsec: integer;
    const AMsg: string; AICMP: TICMP): boolean;
begin
  memo1.Lines.Add(AMsg);
  result := true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  TPingThread.Create('10.1.10.8', PingCallBack);
  TPingThread.Create('10.7.1.11', PingCallBack);
  TPingThread.Create('10.3.1.9', PingCallBack);
  TPingThread.Create('10.5.10.91', PingCallBack);
end;

end.

lg. Astat

Danke Astat. Werde ich mir anschauen.

Unter Windows 7 funktioniert dieser Code leider nur noch mit Adminrechten. Muss ich jetzt wirklich ICMPCreatefile etc nutzen, oder gibt es noch andere Möglichkeiten?

Zitat von sirius:

Unter Windows 7 funktioniert dieser Code leider nur noch mit Adminrechten.

Funktioniert seit NT nur mit lokalen Admin-Rechten.

Schau dir die ICS-Komponenten mal an. Diese setzen zwar auf einen abgekündigt API auf, aber diese Funktioniert immer noch.