Как получить URL из Chrome с помощью Delphi

Question

Как я могу получить URL из запущенного экземпляра Chrome с помощью Delphi?

Я пытаюсь сделать приложение Delphi, которое получает URL активной вкладки браузера (IE, Mozilla и т. Д.). Я использую этот код, который работает для IE:

 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;

Но этот код не работает с Chrome.

Благодарю.

Answer 1

Вот как я это делал раньше для получения URL с активной вкладки. Возможно, вы могли бы расширить это, чтобы включить все вкладки Chrome.

Еще одно замечание, как вы можете видеть, это захватывает первый дескриптор chrome.exe, который он находит. Чтобы это работало с несколькими экземплярами Chrome, вам нужно настроить его, чтобы получить дескриптор для каждого экземпляра Chrome.

Я собрал все это довольно быстро, так что не считайте это качество производства. Просто создайте новое приложение vcl, поместите TMemo и TButton в форму и назначьте Button1Click событию OnClick TButton.

unit main;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  Controls,
  Forms,
  StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

function GetActivePageUrlFromChrome(Handle: HWnd; Param: LParam): Bool; stdcall;

var
  Form1             : TForm1;

implementation

{$R *.dfm}

function GetActivePageUrlFromChrome(Handle: HWnd; Param: LParam): Bool; stdcall;
var
  List: TStrings;
  hWndChrome, hWndChromeChild: HWND;
  Buffer            : array[0..255] of Char;
begin
  List := TStrings(Param);
  //get the window caption
  SendMessage(Handle, WM_GETTEXT, Length(Buffer), integer(@Buffer[0]));
  //look for the chrome window with "Buffer" caption
  hWndChrome := FindWindow('Chrome_WidgetWin_0', Buffer);
  if hWndChrome <> 0 then
  begin
    hWndChromeChild := FindWindowEx(hWndChrome, 0, 'Chrome_AutocompleteEditView', nil);
    if hWndChromeChild <> 0 then
    begin
      SendMessage(hWndChromeChild, WM_GETTEXT, Length(Buffer), integer(@Buffer));
      List.Add(Buffer);
    end;
  end;
  Result := True;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  slChromeUrl      : TStringList;
begin
  slChromeUrl := TStringList.Create;
  try
    EnumWindows(GetActivePageUrlFromChrome, LParam(slChromeUrl));
    Memo1.Lines.AddStrings(slChromeUrl);
  finally
    FreeAndNil(slChromeUrl);
  end;
end;

end.

Answer 2

Ошибка:

try
    EnumWindows(GetActivePageUrlFromChrome, LParam(slChromeUrl));
    Memo1.Lines.AddStrings(slChromeUrl);

Работает:

try
    EnumWindows(@GetActivePageUrlFromChrome, LParam(slChromeUrl));
    Memo1.Lines.AddStrings(slChromeUrl);

Answer 3

Очевидно, существует проблема, связанная с запросом поддержки DDE от chrome/chromium, следите за тем, чтобы в будущей версии это было:

http://code.google.com/p/chromium/issues/detail?id=70184