Ver Mensaje Individual
  #1  
Antiguo 22-04-2006
RJF RJF is offline
Miembro
 
Registrado: abr 2005
Posts: 24
Reputación: 0
RJF Va por buen camino
Thumbs up Saber el IP de internet LA SOLUCION !!!

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.

Última edición por vtdeleon fecha: 02-05-2006 a las 13:59:38.
Responder Con Cita