Jak przechwycić adres WWW wpisany w przeglądarce

Pierwszy sposób

Rozwiązanie działające wyłącznie z IE.

Odpowiedź pochodzi z grupy dyskusyjnej: pl.comp.lang.delphi:

Function GetText(WindowHandle: hwnd):string;
var
  txtLength : integer;
  buffer: string;
begin
 TxtLength := SendMessage(WindowHandle, WM_GETTEXTLENGTH, 0, 0);
 txtlength := txtlength + 1;
 setlength (buffer, txtlength);
 sendmessage (WindowHandle,wm_gettext, txtlength, longint(@buffer[1]));
 result := buffer;
end;

function GetURL:string;
var
  ie,toolbar,combo,
  comboboxex,edit,
  worker,toolbarwindow:hwnd;
begin
  ie := FindWindow(pchar('IEFrame'),nil);
  worker := FindWindowEx(ie,0,'WorkerA',nil);
  toolbar := FindWindowEx(worker,0,'rebarwindow32',nil);
  comboboxex := FindWindowEx(toolbar, 0, 'comboboxex32', nil);
  combo := FindWindowEx(comboboxex,0,'ComboBox',nil);
  edit := FindWindowEx(combo,0,'Edit',nil);
  toolbarwindow := FindWindowEx(comboboxex, 0, 'toolbarwindow32', nil);

  result := GetText(edit);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(GetURL);
end;

Drugi sposób

Rozwiązanie kombytabilne również z innymi przeglądarkami.

UWAGA
W uses dodajemy: DdeMan

const
  BSRV_FIREFOX = 'Firefox';
  BSRV_OPERA = 'Opera';
  BSRV_NETSCAPE = 'Netscape';
  BSRV_IEXPLORE = 'IExplore';

Pora na funkcję realizującą zadanie:

function GetURL(const BrowserService: String): String;
var
  S: String;
begin
  with TDdeClientConv.Create(nil) do
  try
    SetLink(BrowserService, 'WWW_GetWindowInfo');
    S := String(RequestData('0xFFFFFFFF'));
    Result := Copy(S, 2, PosEx('"', S, 2) - 2);
    CloseLink;
  finally
    Free;
  end;
end;

A oto kolejna funkcja uwzględniająca fakt że user może korzystać z wielu przeglądarek na raz.

function  GetURLS: TStringList;
var
  Temp : String;
begin
  result:=TStringList.Create;
  with result do
  begin
    Temp:=GetURL(BSRV_FIREFOX);
    if Temp<>'' then
    begin Add(Temp);Temp:=''; end;
    Temp:=GetURL(BSRV_OPERA);
    if Temp<>'' then
    begin Add(Temp);Temp:=''; end;
    Temp:=GetURL(BSRV_NETSCAPE);
    if Temp<>'' then
    begin Add(Temp);Temp:=''; end;
    Temp:=GetURL(BSRV_IEXPLORE);
    if Temp<>'' then
    begin Add(Temp);Temp:=''; end;
  end;
end;