如何使用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。
感谢。
答案 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支持,如果将来的版本提供它,请留意:
答案 2 :(得分:0)
错误:
try
EnumWindows(GetActivePageUrlFromChrome, LParam(slChromeUrl));
Memo1.Lines.AddStrings(slChromeUrl);
使用:
try
EnumWindows(@GetActivePageUrlFromChrome, LParam(slChromeUrl));
Memo1.Lines.AddStrings(slChromeUrl);