IP INTERNET VIA UNE CONNEXION RÉSEAU - RÉCUPÉRER UNE IP DANS UN STRING

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls, Psock, NMHttp;

type
  TForm1 = class(TForm)
    sbInfo: TStatusBar;
    NMHTTP1: TNMHTTP;
    edIP: TEdit;
    Label1: TLabel;
    Button1: TButton;
    cbURL: TComboBox;
    Animate1: TAnimate;
    procedure Button1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Déclarations privées }
    procedure Connection;
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function GetIPAdress(var IP: String; Txt: String): Boolean;
var   { Récupère la première IP valide trouvée }
  i: Integer;
  Chiffre, Point, Groupe: Integer;
  Tmp: String;

      procedure InitialiseTout;
      begin
        Tmp     := '';
        Chiffre := 0;
        Point   := 0;
        Groupe  := 0;
      end;
      
begin
  Result := False;
  if Txt = '' then Exit;
  InitialiseTout;
  for i := 1 to Length(Txt) do
  begin
    if Txt[i] in ['0'..'9'] then  // chiffre rencontré
    begin
      Inc(Chiffre);
      if Chiffre > 3 then
        InitialiseTout
      else
        Tmp := Tmp + Txt[i];
    end
    else if Txt[i] = '.' then     // point rencontré
    begin
      Inc(Point);
      if (Point > 3) or (Tmp = '') or ((Tmp <> '') and (Tmp[Length(Tmp)] = '.')) then
        InitialiseTout
      else
      begin
        Tmp := Tmp + Txt[i];
        Inc(Groupe);
        Chiffre := 0;
      end;
    end
    else
    begin                         // autre caractère rencontré
      if (Groupe = 3) and (Tmp[Length(Tmp)] in ['0'..'9']) then
        Break     // Résultat trouvé !  -> sortie
      else
      if Tmp <> '' then
      begin
        InitialiseTout;
      end;
    end;
  end;
  IP := Tmp;
  Result := Tmp <> '';
end;

procedure TForm1.Connection;
var
  Url1: String;
  Body: String;
  IP: String;
begin
  edIP.Clear;
  Url1 := cbURL.Text;
  Animate1.Active := True;
  sbInfo.SimpleText := 'Recherche en cours...';
  try
    if NMHTTP1.Connected then NMHTTP1.Disconnect;
    NMHTTP1.Get(Url1);
  except
    NMHTTP1.Disconnect;
    ShowMessage('problème de connexion avec ce serveur');
    Exit;
  end;
  Body := NMHTTP1.Body;
  if GetIPAdress(IP, Body) then
    edIP.Text := IP;
  Animate1.Active := False;
  sbInfo.SimpleText := 'Terminé';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Connection;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  cbURL.ItemIndex := 0;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if NMHTTP1.Connected then NMHTTP1.Disconnect;
end;

end.