Saber el IP de internet LA SOLUCION !!!

[RJF]

No importa si estan detras de un proxy, un router, nada, porque si la PC tiene conexion a internet sabran el IP real de conexion, dado que es obtenido de una o varias paginas HTTP por medio de una consulta y un parceo, pruebenlo y comenten, esta medio crudo, pero funciona, mejorenlo. Saludos

DESCARGAR PROYECTO
http://rapidshare.de/files/18660143/SABER_IP.RAR.html

CODIGO COMPLETO

Código Delphi [-]
unit Unit1;
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IDStack, StdCtrls, Buttons, OleCtrls, SHDocVw, ActiveX, WinInet, Winsock;

type
  TForm1 = class(TForm)
    WebB: TWebBrowser;
    TxtDireccion: TEdit;
    Memo1: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    BitBtn2: TBitBtn;
    procedure WebBDocumentComplete(Sender: TObject; const pDisp: IDispatch;
      var URL: OleVariant);
    procedure BitBtn2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function WebBrowerDocumentSource(webBrowser: TWebBrowser) : string;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
function TForm1.WebBrowerDocumentSource(webBrowser: TWebBrowser) : string;
var
  ss: TStringStream;
  ips: IPersistStreamInit;
begin
  Result := EmptyStr;
  ss := TStringStream.Create(Result);
  try
    if Assigned(webBrowser) and Assigned(webBrowser.Document) then
    begin
      ips := webBrowser.Document as IPersistStreamInit;
      if Assigned(ips) and Succeeded(ips.Save(TStreamAdapter.Create(ss), true)) then
        Result := ss.DataString;
    end;
  finally
    ss.Free;
  end;
end;

//En el evento cuando se termina de cargar la pagina en el TWebBrowser
procedure TForm1.WebBDocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var lineas :string;
    i,numptos, posprimpto :integer;
begin
  memo1.Text := WebBrowerDocumentSource(WebB);
  lineas := memo1.Text;
  numptos := 0;
  posprimpto := 0;
  //Para poder identificar el ip en el codigo fuente de la pagina debo hacer una busqueda dado que
  //un ip puede tener varias formas como xxx.xxx.xxx.xxx o xx.xxx.xx.xx o xx.xx.xx.xx
  for i := 1 to length(lineas) do
  begin
    if copy (lineas,i,1) = '.' then //Busco un punto en la cadena
    begin
     if i - posprimpto >4 then //Si la separacion al proximo punto es >4 ya no es un IP
       numptos := 0;
     numptos:=numptos+1;
     posprimpto := i;
    end;
    if numptos = 3 then break  //Si encontre 3 puntos es un IP valido o casi 
  end;
  memo1.Text := copy(lineas,posprimpto-11,15); //Copio del 3 punto 11 caracteres atras y 15 adelante
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  //Le asigno la direccion al TWebBrowser
  WebB.Navigate(TxtDireccion.Text);
end;
end.