ブラウザ（特にタブブラウザ）からURLを取得するには？ (ID：14188)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

タブブラウザの種類によってタブ機能の実現方法がいろいろあるようで対応したいブラウザ毎に組む必要がありそうです。
とりあえずIEとSleipnirに対応してみました。(Delphi7です)

ちょっと長いけどいいかな？
EnumWindowsでIEかSleipnirを見つけたらそのハンドルをGetBrowserURLに渡してください。TStringListは前もって作成しておいてください。
----------------------------------------------------------
unit u_getURL;

interface

uses
   Classes, Windows;

function GetBrowserURL(Wnd:HWND; AList: TStringList): string;

implementation

uses
  ActiveX, Shdocvw, MSHTML;

type
  TObjectFromLResult = function(LRESULT: lResult; const IID: TIID;
    wParam: wParam; out pObject): HRESULT; stdcall;

function GetIEFromHWND(WHandle: HWND; var IE: IWebbrowser2): HRESULT;
var
  hInst: HWND;
  lRes: Cardinal;
  Msg: Integer;
  pDoc: IHTMLDocument2;
  ObjectFromLresult: TObjectFromLresult;
begin
  hInst := LoadLibrary('Oleacc.dll'); @ObjectFromLresult :=
    GetProcAddress(hInst, 'ObjectFromLresult');
  if @ObjectFromLresult <> nil then
  begin
    try
      Msg := RegisterWindowMessage('WM_HTML_GETOBJECT');
      SendMessageTimeOut(WHandle, Msg, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes);
      Result := ObjectFromLresult(lRes, IHTMLDocument2, 0, pDoc);
      if Result = S_OK then
        (pDoc.parentWindow as IServiceprovider).QueryService(IWebbrowserApp,
          IWebbrowser2, IE);
    finally
      FreeLibrary(hInst);
    end;
  end;
end;

function GetBrowserURL(Wnd:HWND; AList: TStringList): string;

procedure AddURL(w:HWND);
  var
    IE: IWebBrowser2;
    S: string;
  begin
    if w = 0 then Exit;
    w := FindWindowEX(w, 0, 'Shell DocObject View', nil);
    if w = 0 then Exit;
    w := FindWindowEX(w, 0, 'Internet Explorer_Server', nil);
    if w <> 0 then
    begin
      GetIEFromHWnd(w, IE);  // Get Iwebbrowser2 from Handle
      if IE <> nil then
      begin
        S := IE.LocationURL;
        if (Length(S) > 0) and (AList <> nil) then
          AList.Add(S);
      end;
    end;
  end;
  procedure GetTabUrl(w: HWND);
  begin
//    w := FindWindowEX(w, 0, nil, 'Sleipnir_IEView');
    w := FindWindowEX(w, 0, nil, nil);
    if w = 0 then Exit;
    w := FindWindowEX(w, 0, 'Shell Embedding', nil);
    AddUrl(w);
  end;

var
  WndChild: HWND;
begin
  Result := '';
  WndChild := FindWindowEX(Wnd, 0, 'MDIClient', nil);
  if WndChild <> 0 then // Sleipnir ?
    begin
      Wnd      := WndChild;
      WndChild := 0;
      repeat
        WndChild := FindWindowEX(Wnd, WndChild, nil, nil);
        if WndCHild <> 0 then
          GetTabUrl(WndChild);
      until WndChild = 0;
    end
  else	// IE?
    AddURL(Wnd);
end;

end.

←解決時は質問者本人がここをチェックしてください。

戻る