[Mitiay]

Все перерыл,перекачал не нашел рабочего кода.Ребят помогите может кто сталкивался с данной проблемой

[Kailon]

Какой проблемой?

[Mitiay]

Есть ктонибудь?

[poli-smen]

Сообщение от Mitiay

Есть ктонибудь?

А самом низу этой страницы есть ссылка "Кто на форуме?"

[Alegun]

Из хрома по идее никак - уж очень в нём дерево оконных хендлов накрученно, хуже чем в оффисе, не добраться, можно конечно попробовать через DDE (пример был в предыдущей теме), но гарантий стопроцентных нет

Повторюсь на всякий случай

Код:

unit GetUrlBrowser;

interface

function GetURL(Browser: string): string;

implementation

uses DdeMan,SysUtils;

function GetURL(Browser: string): string;
var
 Client_DDE: TDDEClientConv;
 temp: PAnsiChar;
begin
 Result := '';
 Client_DDE:= TDDEClientConv.Create( nil );
 with Client_DDE do
  begin
   SetLink(Browser, 'WWW_GetWindowInfo');
   temp := RequestData('0xFFFFFFFF');
   Result := StrPas(temp);
  // Return only the URL part
   Delete(Result, Pos(',', Result), Length(Result)-Pos(',', Result)+1);
   // Remove quotes
   Delete(Result, 1, 1);
   Delete(Result, Length(Result), 1);

   // ************

   StrDispose(temp);
   CloseLink;
  end;
 Client_DDE.Free;
end;

end.

поиграйтесь с названием браузера, может помочь

[Mitiay]

Сообщение от Alegun

Из хрома по идее никак - уж очень в нём дерево оконных хендлов накрученно, хуже чем в оффисе, не добраться, можно конечно попробовать через DDE (пример был в предыдущей теме), но гарантий стопроцентных нет

Повторюсь на всякий случай

Код:

unit GetUrlBrowser;

interface

function GetURL(Browser: string): string;

implementation

uses DdeMan,SysUtils;

function GetURL(Browser: string): string;
var
 Client_DDE: TDDEClientConv;
 temp: PAnsiChar;
begin
 Result := '';
 Client_DDE:= TDDEClientConv.Create( nil );
 with Client_DDE do
  begin
   SetLink(Browser, 'WWW_GetWindowInfo');
   temp := RequestData('0xFFFFFFFF');
   Result := StrPas(temp);
  // Return only the URL part
   Delete(Result, Pos(',', Result), Length(Result)-Pos(',', Result)+1);
   // Remove quotes
   Delete(Result, 1, 1);
   Delete(Result, Length(Result), 1);

   // ************

   StrDispose(temp);
   CloseLink;
  end;
 Client_DDE.Free;
end;

end.

поиграйтесь с названием браузера, может помочь

как вызвать эту функцию?

[Alegun]

Код:

uses GetUrlBrowser;
procedure TForm1.Button1Click(Sender: TObject);
begin
 Label1.Caption:= GetURL( 'IExplore' {'Opera' etc.} );
end;

Проверил, - с ИЕ, оперой и ФФ работает, а вот хрома просто нет в наличии

[Mitiay]

В ие работает в опере нет!что я делаю не так? Opera 21.0

[Alegun]

Со старой прокатывает - вероятно, всё дело в названии, смотрите под каким именем этот браузер у вас в системе прописан