Ver Mensaje Individual
  #7  
Antiguo 07-03-2011
razonasistemas razonasistemas is offline
Registrado
NULL
 
Registrado: feb 2011
Ubicación: Oviedo, España
Posts: 5
Reputación: 0
razonasistemas Va por buen camino
Esto vale solo para algunos navegadores

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.
Responder Con Cita