如何使用delphi从Chrome获取网址

时间:2011-03-07 16:36:50

标签: delphi

如何使用Delphi从正在运行的Chrome实例中获取网址?

我正在尝试使用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。

感谢。

3 个答案:

答案 0 :(得分:3)

以下是我从 活动 标签中检索网址之前的操作方法。您可以将其扩展为包含Chrome的所有标签。

另外一个注意事项,正如您所看到的,它抓住了它找到的chrome.exe的第一个句柄。要使此功能适应多个Chrome运行实例,您需要对其进行调整以获取每个Chrome实例的句柄。

我把它放在一起非常快,所以不要考虑这种“生产”质量。只需创建一个新的vcl应用程序并在表单上删除TMemo和TButton,并将Button1Click分配给TButton的 OnClick 事件。

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.

答案 1 :(得分:0)

显然有问题可以通过chrome / chromium请求DDE支持,如果将来的版本提供它,请留意:

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

答案 2 :(得分:0)

错误:

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

使用:

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