...die IP Adresse hinter einem router/proxy ermitteln (2)?

{
This code requires a server running a script that generates a web
page that has your IP address in it.
This example uses http://www.whatismyip.com/
The script then searches for the first time
that 'Your ip is ' shows up and then looks for a
correctly formatted IP address from that point.

This works using Delphi 6 Enterprise but should work with previous
versions with little or no modification, I think.
}

unit Main;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    NMHTTP1: TNMHTTP;
    Memo1: TMemo;
    Edit1: TEdit;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    Bevel1: TBevel;
    Bevel2: TBevel;
    procedure Button1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses ClipBrd;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  InetIP: string;
  WebAddress, SearchString: string;
  Buff, P, FT: PChar;
  BuffLen: Word;
  StartPos, StringLength, TempInt: Integer;
begin
  WebAddress   := 'http://www.whatismyip.com/';
  SearchString := 'Your ip is ';
  Memo1.Clear;
  try
    NMHTTP1.Get(WebAddress);
  except
    on E: Exception do
    begin
      MessageDlg('Could not get IP Address! ' +
        'Please ensure you are connected to ' +
        'the Internet.', mtError, [mbOK], 0);
    end;
  end;
  Memo1.Text     := NMHTTP1.Body;
  Memo1.SelStart := 0;
  GetMem(FT, Length(SearchString) + 1);
  StrPCopy(FT, SearchString);
  BuffLen := Memo1.GetTextLen + 1;
  GetMem(Buff, BuffLen);
  Memo1.GetTextBuf(Buff, BuffLen);
  P := Buff + Memo1.SelStart + Memo1.SelLength;
  P := StrPos(P, FT);
  if P = nil then MessageBeep(0)
  else
  begin
    Memo1.SelStart  := P - Buff;
    Memo1.SelLength := Length(SearchString);
  end;
  StringLength := Memo1.SelLength;
  StartPos     := Memo1.SelStart + StringLength;
  tempint      := StartPos;
  InetIP       := '';
  while ((Buff[TempInt] in ['0'..'9']) or
    (Buff[TempInt] = '.')) do
  begin
    InetIP  := InetIP + Buff[TempInt];
    tempint := tempint + 1;
  end;
  FreeMem(FT, Length(SearchString) + 1);
  FreeMem(Buff, BuffLen);
  Edit1.Text := InetIP;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  Close;
end;

end.

printed from
www.swissdelphicenter.ch
developers knowledge base