Optimierung von, IP-Addresse auf Gültigkeit überprüfen

[Astat]

Hallo liebe Delphi-Praxis Mitglieder.

Ich suche nach Optimierungsmöglichkeiten für unten stehenden Code.

Die Funktion soll schnellstmöglich überprüfen, ob die eingegebene IP Addresse gültig ist.

Die untenstehende Routiene arbeitet derzeit am schnellsten.

Habe diverse Socket-API's und Regular-Expressions versucht, sind aber allesammt nicht schnell genug.

Hat dazu jemand eine Idee, wie man das Teil beschleunigen kann, bin auch für Vorschläge andere Konzepte dankbar.

Danke im Voraus, lg. Astat

Delphi-Quellcode:

function IsIP(s: string): Boolean;
var
  s1, s2, s3, s4: String;
  e, v, i, j: Integer;
  bcLen: integer;
  ix: array[1..3] of integer;
begin
  result := false;

  bcLen := Length(s);

  if (bcLen > 15) or (bcLen < 7) then EXIT;

  if s = '0.0.0.0' then EXIT;

  j := 0;
  for i:= 1 to bcLen do begin
    if s[i] = '.' then begin
      inc(j);
      ix[j] := i;
    end;
  end;
  if j <> 3 then EXIT;

  s1 := copy(s, 1, ix[1] - 1);
  s2 := copy(s, ix[1] + 1, ix[2] - ix[1] - 1);
  s3 := copy(s, ix[2] + 1, ix[3] - ix[2] - 1);
  s4 := copy(s, ix[3] + 1, bcLen);

  
  Val(s1, v, e);
  if (e <> 0) or (v > 255) then EXIT;

  Val(s2, v, e);
  if (e <> 0) or (v > 255) then EXIT;

  Val(s3, v, e);
  if (e <> 0) or (v > 255) then EXIT;

  Val(s4, v, e);
  if (e <> 0) or (v > 255) then EXIT;

  result := true;
end;

var
  Start: DWORD;
  i: integer;
  b: boolean;
begin
  Start := GetTickCount;
  for i := 0 to 1000000 do begin
    b := IsIP('0.1.2.3');
    b := IsIP('255.255.255.255');
    b := IsIP('1.1.1.255');
    b := IsIP('0.0.0.0');
    b := IsIP('555.3.2.1');
    b := IsIP('555.3.xyz');
    b := IsIP('1.b.1.1');
    b := IsIP('a');
    b := IsIP('');
    b := IsIP('1.0.0.0');
    b := IsIP('10.73.10.108');
    b := IsIP('0.0.1.0');
    b := IsIP('0.1.1.0');
    b := IsIP('1.0.0.0');
  end;
  writeln(IntToStr(GetTickCount - Start));
end.

[himitsu]

Die untenstehende Routiene arbeitet derzeit am schnellsten. Stringoperationen sind niemals schnnell, vorallem, wenn dabei Strings reseviert, umkopiert und freigegeben werden.

PS: mit mehr als 4 Punkten im String erzeugt deine Funktion einen Pufferüberlauf bei ix[j] := i; .

Delphi-Quellcode:

function isIP(const s: String): Boolean;
var P: PChar;
  c, L, n: Integer;
begin
  Result := False;
  P := PChar(s);
  n := 0;
  while P^ <> #0 do
  begin
    Inc(n);
    c := 0;
    L := 0;
    while P^ in ['0'..'9'] do
    begin
      c := c * 10 + (Ord(P^) - Ord('0'));
      Inc(L);
      Inc(P);
    end;
    if (L = 0) or (L > 3) or (c > 255) then Exit;
    if n = 4 then Break;
    if P^ <> '.' then Exit;
    Inc(P);
  end;
  Result := (n = 4) and (P^ = #0);
end;

[Astat]

Zitat von himitsu:

Stringoperationen sind niemals schnnell, vorallem, wenn dabei Strings reseviert, umkopiert und freigegeben werden.
PS: mit mehr als 4 Punkten im String erzeugt deine Funktion einen Pufferüberlauf bei..

Hallo himitsu, Danke für den Code, das teil ist ja gleich um den Faktor 4.5 schneller!!!!

Dass hier noch soviel zu holen war, hätte ich nicht für möglich gehalten.

Absolut TOP, werd das so verwenden, danke nochmal für Code und Coderreview.

Viele liebe Grüße

Astat

[alzaimar]

Hi Astat, Hi Himitsu,

Leider funktioniert der Code von Himitsu nicht korrekt bei S='0.0.0.0'.

Außerdem hab ich noch ein paar Kleinigkeiten optimiert. Die Abfrage nach in ['0'..'9'] kann man mit einer Lookuptabelle optimieren.

Hier eine minimal gepimpte und korrigierte Version.

Delphi-Quellcode:

Var
  IsDigit : Array [Char] Of Boolean;

Procedure InitIsDigit; // Einmal aufrufen, um Isdigit-Lookup zu initialisieren.
Var 
  C : Char;

Begin
  For C:= #0 to #255 do IsDigit[C] := C in ['0'..'9'];
End;

function GepimpteHimitsuVersionVonIsIp(const aIpString: string): Boolean;
var
  pIpString: PChar;
  OctetSum, Octet, OctetLength, OctetCount: Integer;

begin
  Result := False;
  pIpString := PChar(aIpString);
  OctetCount := 0;
  OctetSum := 0;
  while pIpString^ <> #0 do
  begin
    Inc(OctetCount);
    Octet := 0;
    OctetLength := 0;
    while IsDigit[pIpString^] do
    begin
      Octet := Octet * 10 + (Ord(pIpString^) - Ord('0'));
      Inc(OctetLength);
      Inc(pIpString);
    end;
    inc(OctetSum, Octet); // Summe aller Einzelwerte erstellen. Muss zum Schluss > 0 werden
    if (OctetLength = 0) or (Octet > 255) then
      Exit;
    if OctetCount = 4 then
      Break;
    if pIpString^ <> '.' then
      Exit;
    Inc(pIpString);
  end;
  Result := (OctetSum > 0) and (OctetCount = 4) and (pIpString^ = #0); // Zusätzliche Prüfung auf OctetSum
end;

[himitsu]

ja, die '0.0.0.0' hab ich glatt übersehn

Delphi-Quellcode:

function isIP(const ipString: String; ip: PCardinal = nil): Boolean;
var
  pIpString: PChar;
  octetCount, octetSum, octetLen, octet: Integer;
begin
  Result     := False;
  pIpString  := PChar(ipString);
  octetCount := 0;
  octetSum   := 0;
  while pIpString^ <> #0 do
  begin
    Inc(octetCount);
    octetLen := 0;
    octet    := 0;
    while pIpString^ in ['0'..'9'] do
    //while IsDigit[pIpString^] do
    begin
      octet := octet * 10 + (Ord(pIpString^) - Ord('0'));
      Inc(octetLen);
      Inc(pIpString);
    end;
    octetSum := octetSum shl 8 or octet;
    if (octetLen = 0) or (octetLen > 3) or (octet > 255) then Exit;
    if octetCount = 4 then Break;
    if pIpString^ <> '.' then Exit;
    Inc(pIpString);
  end;
  Result := (octetCount = 4) and (octetSum <> 0) and (pIpString^ = #0);
  if Result and Assigned(ip) then ip^ := octetSum;
end;

(Wie rum werden eigentlich die Werte ausgelesen? Nicht, daß hier die "ip" in der falschen Bytefolge vorliegt)

Aber das mit der Lookuptabelle:
Bei Astats "Versuchsaufbau" brachte diese auch nur 0,2% Geschwindigkeitszuwachs,
dagegen werden ab D2009 64 KB mehr Speicher in den gloablen Variablen belegt.

Und da in einem Programm, wo man diese Funktion nutzt, bestimmt mehr anderer "langsamerer" Code ausgeführt wird, als durch diese Optimierung gewonnen wurde, fällt dieses fast garnicht auf.
> Man kann also diese Optimierung einbauen, aber merklich verbessern wird sich dadurch wohl nichts

Code:

Unit2.pas.50: while pIpString^ in ['0'..'9'] do
00461B5D 0FB730           movzx esi,[eax]
00461B60 8BCE             mov ecx,esi
00461B62 83C1D0           add ecx,-$30
00461B65 6683E90A         sub cx,$0a
00461B69 72E1             jb $00461b4c


Unit2.pas.51: while IsDigit[pIpString^] do
00461B59 0FB708           movzx ecx,[eax]
00461B5C 80B9A8B1460000   cmp byte ptr [ecx+$0046b1a8],$00
00461B63 75E6             jnz $00461b4b

PS:
[DCC Warnung] Unit2.pas(33): W1050 WideChar in Set-Ausdrücken auf ByteChar verkürzt. Ziehen Sie die Verwendung der Funktion 'CharInSet' aus der Unit 'SysUtils' in Betracht. dieses kann man hier glatt ignorieren


PSS:

Delphi-Quellcode:

procedure InitIsDigit;
var
  C : char;
begin
  For C := '0' to '9' do IsDigit[C] := True;
end;

(die ganzen False werden ja durch die Initialisierung der Globalen gesetzt)

[Astat]

Zitat von alzaimar:

Hi Astat, Hi Himitsu,
Leider funktioniert der Code bei S='0.0.0.0'.
Außerdem hab ich noch ein paar Kleinigkeiten optimiert.

Hallo alzaimar, Danke für Code und Info, Super!!
Werde ich gleich updaten.

lg. Astat

[Reinhard Kern]

Hallo,

als Embedded-Programmierer sieht so etwas ganz abders aus als von den Höhen der VCL, daher folgt die Funktion unten einem ganz naderen Ansatz, nämlich einer Mealy-Maschine - allerdings ist die sehr einfach mit nur einer Bearbeitungsroutine, weil ja alle Bytes bei IP gleichbehandelt werden. Ist aber ohne OO und ohne VCL, nur einfach und schnell, also VCL-Fanatiker ab hier nicht mehr weiterlesen. Dafür funktioniert das auch mit Embedded Pascal auf irgendeinem µC.

Delphi-Quellcode:

program isip2test;

{$APPTYPE CONSOLE}

uses
  SysUtils,windows;
type ShortString = string[255];

function IsIP (s: ShortString): Boolean;  { Mealy Machine }
type TIPV4status = (ip_byte1,ip_byte2,ip_byte3,ip_byte4,ip_done);
var MMStatus : TIPV4status;
    nch : char;
    ByteVal : integer;
    ByteSum : integer;
    index : integer;
    IPError : boolean;

  function getnextchar : char;
  begin
  Result := chr(0);
  if index <= length (s) then Result := s[index];
  index := index + 1;
  end;

  procedure OnBytex;
  begin
  if (nch >= '0') and (nch <= '9') then
      ByteVal := ByteVal * 10 + ord (nch) - 48
    else if nch = '.' then
         begin
         if ByteVal > 255 then
           IPError := true else ByteSum := ByteSum + ByteVal;
         ByteVal := 0;
         Inc (MMStatus);
         end
      else
        begin
        if MMStatus < ip_byte4 then IPError := true
          else if ByteVal > 255 then IPError := true
            else ByteSum := ByteSum + ByteVal;
        MMStatus := ip_done;
        end;
  end;

begin { isip... }
IPError := false;
MMStatus := ip_byte1;
index := 1;
ByteVal := 0;
ByteSum := 0;
repeat
  nch := getnextchar;
  if MMStatus < ip_done then OnBytex;
until MMStatus = ip_done;
if ByteSum = 0 then IPError := true;  { 0.0.0.0 }
if index <= length (s) then IPError := true;  { garbage follows }
Result := not IPError;
  {write (s);
  if Result then writeln (' ok') else writeln (' not ok');
  readln;  }
end;

var
  Start: DWORD;
  i: integer;
  b: boolean;
begin
  Start := GetTickCount;
  for i := 0 to 1000000 do begin
    b := IsIP('0.1.2.3');
    b := IsIP('255.255.255.255');
    b := IsIP('1.1.1.255'); 
    b := IsIP('0.0.0.0');
    b := IsIP('555.3.2.1');
    b := IsIP('555.3.xyz'); 
    b := IsIP('1.b.1.1'); 
    b := IsIP('a'); 
    b := IsIP(''); 
    b := IsIP('1.0.0.0'); 
    b := IsIP('10.73.10.108'); 
    b := IsIP('0.0.1.0'); 
    b := IsIP('0.1.1.0 xyz'); 
    b := IsIP('1.0.0.0'); 
  end; 
  writeln(IntToStr(GetTickCount - Start));
  readln;
end.

Gruss Reinhard

[alzaimar]

Hallo Reinhard,

Was ist an Himitsu's Code OOP- und was VCL-lastig?
Was hat Dein Code mit Embedded zu tun?
Wo ist der fundamentale Unterschied zu Himitu's Code?

Wieso ist das eine Mealy-Maschine?

[Reinhard Kern]

Zitat von alzaimar:

Was ist an Himitsu's Code OOP- und was VCL-lastig?
Was hat Dein Code mit Embedded zu tun?
Wo ist der fundamentale Unterschied zu Himitu's Code?
Wieso ist das eine Mealy-Maschine?

Hallo,

vergiss es einfach oder lass den Post löschen - es lohnt sich weder über embedded noch über mealy zu streiten.

Gruss Reinhard