如何使用delphi从Chrome获取网址

如何使用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',sTitle')
       else
       if SetLink('Mosaic',sTitle')
       else
       if SetLink('Netscp6',sTitle')
       else
       if SetLink('Mozilla',sTitle')
       else
       if SetLink('Firefox',sTitle');
     end;
     if s <> '' then
     begin
       delete(s,1,1);
       URL := copy(s,pos('","',s)-1);
       delete(s,s)+2);
       Title := copy(s,pos('"',s) - 1);
     end;
     exit;
   except
     MessageDlg('URL attempt Failed!',mtError,[mbOK],0);
   end;
 end;

但此代码不适用于Chrome.

谢谢.

解决方法

以下是我从活动选项卡中检索URL之前的操作方法.您可以将其扩展为包含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,'Chrome_AutocompleteEditView',nil);
    if hWndChromeChild <> 0 then
    begin
      SendMessage(hWndChromeChild,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.