Club Delphi  
    Paypal   FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > API de Windows
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

 
 
Herramientas Buscar en Tema Desplegado
  #3  
Antiguo 26-06-2005
jorodgar jorodgar is offline
Miembro
 
Registrado: abr 2005
Posts: 76
Poder: 22
jorodgar Va por buen camino
Solucion

A continuación el código fuente:

Código Delphi [-]
unit Unit1;
 
 interface
 
 uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, DDEman, StdCtrls;
 
 type
   TForm1 = class(TForm)
   Button1: TButton;
   Edit1: TEdit;
   Edit2: TEdit;
   procedure Button1Click(Sender: TObject);
   private
     { Private declarations }
   public
     { Public declarations }
   procedure GetCurrentURL (var URL, Title : string);
 end;
 
 var
   Form1: TForm1;
 
 implementation
 
 {$R *.dfm}
 
 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;
 
 end.

Última edición por dec fecha: 10-09-2005 a las 07:05:55. Razón: Encerrar el código fuente en la etiqueta [DELPHI]
Responder Con Cita
 



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro


La franja horaria es GMT +2. Ahora son las 09:26:08.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi