Averiguar que pagina se está Navegando

[razonasistemas]

Hola:

Este codigo vale solo para algunos navegadores :

Código Delphi [-]
uses ddeMan;

procedure TForm1.GetCurrentURL (var URL, Title : string);
 var
   DDEClient : TDDEClientConv;
   s : string;
 begin
   s := '';
   try
     DDEClient := TDDEClientConv.Create(self);
     with DDEClient do
     begin
       if SetLink('IExplore','WWW_GetWindowInfo') then
         s := RequestData('0xFFFFFFFF,sURL,sTitle')
       else
       if SetLink('Netscape','WWW_GetWindowInfo') then
         s := RequestData('0xFFFFFFFF,sURL,sTitle')
       else
       if SetLink('Mosaic','WWW_GetWindowInfo') then
         s := RequestData('0xFFFFFFFF,sURL,sTitle')
       else
       if SetLink('Netscp6','WWW_GetWindowInfo') then
         s := RequestData('0xFFFFFFFF,sURL,sTitle')
       else
       if SetLink('Mozilla','WWW_GetWindowInfo') then
         s := RequestData('0xFFFFFFFF,sURL,sTitle')
       else
       if SetLink('Firefox','WWW_GetWindowInfo') then
         s := RequestData('0xFFFFFFFF,sURL,sTitle');
     end;
     if s <> '' then
     begin
       delete(s,1,1);
       URL := copy(s,1,pos('","',s)-1);
       delete(s,1,pos('","',s)+2);
       Title := copy(s,1,pos('"',s) - 1);
     end;
     exit;
   except
     MessageDlg('URL attempt failed!',mtError,[mbOK],0);
   end;
 end;


procedure TForm1.Button1Click(Sender: TObject);
var
 URL : string;
   Title : string;
 begin
   GetCurrentURL (URL, Title);
   Edit1.Text := URL;
   Edit2.Text := Title;
 end;

Yo lo he intentado, pero no me funciona con el Chrome, pero si con el IE.

[FENIXadr]

SIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII....... razonasistemas sos un genioooooo... es justamente lo que necesitaba... muchísimas graciass...

Este hilo se puede dar por terminado...

Una vez más muchisisisisisimas gracias razonasistemas..

[rgstuamigo]

Empezado por razonasistemas

Hola:

Este codigo vale solo para algunos navegadores :

Código Delphi [-]
uses ddeMan;

procedure TForm1.GetCurrentURL (var URL, Title : string);
 var
   DDEClient : TDDEClientConv;
   s : string;
 begin
   s := '';
   try
     DDEClient := TDDEClientConv.Create(self);
     with DDEClient do
     begin
       if SetLink('IExplore','WWW_GetWindowInfo') then
         s := RequestData('0xFFFFFFFF,sURL,sTitle')
       else
       if SetLink('Netscape','WWW_GetWindowInfo') then
         s := RequestData('0xFFFFFFFF,sURL,sTitle')
       else
       if SetLink('Mosaic','WWW_GetWindowInfo') then
         s := RequestData('0xFFFFFFFF,sURL,sTitle')
       else
       if SetLink('Netscp6','WWW_GetWindowInfo') then
         s := RequestData('0xFFFFFFFF,sURL,sTitle')
       else
       if SetLink('Mozilla','WWW_GetWindowInfo') then
         s := RequestData('0xFFFFFFFF,sURL,sTitle')
       else
       if SetLink('Firefox','WWW_GetWindowInfo') then
         s := RequestData('0xFFFFFFFF,sURL,sTitle');
     end;
     if s <> '' then
     begin
       delete(s,1,1);
       URL := copy(s,1,pos('","',s)-1);
       delete(s,1,pos('","',s)+2);
       Title := copy(s,1,pos('"',s) - 1);
     end;
     exit;
   except
     MessageDlg('URL attempt failed!',mtError,[mbOK],0);
   end;
 end;


procedure TForm1.Button1Click(Sender: TObject);
var
 URL : string;
   Title : string;
 begin
   GetCurrentURL (URL, Title);
   Edit1.Text := URL;
   Edit2.Text := Title;
 end;

Yo lo he intentado, pero no me funciona con el Chrome, pero si con el IE.

Muy interresante código amigo razonasistemas... nada más que al ejecutar varias veces el procedimiento "GetCurrentURL" estamos haciendo mal uso de la memoria, ya que el objeto "DDEClient" no se está liberando por lo cual deberiamos agregar una linea más para que tal objeto se destruya y libere su memoria que ocupa...
Saludos...

[FENIXadr]

SI SI... muy buen aporte rgstuamigo... se puede hacer de muchas maneras.... en mi caso creo DDEClient en el evento "OnCreate" del Form y lo destruyo en el evento "OnClose".. solo por hacerlo una vez y no cada vez que se llama a "GetCurrentURL".