Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

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