【Delphi】IEのタブ変更を検知する

最終的には、マルチスレッドだな。

タブ変更を検知してShowMessageを出します！

(1) IETabの取得
まずは、getIETabをfunctionで作るぞ！

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,Generics.Collections;

type
  TIETabRec = record
    intIETabWindow : integer;
    strIETabTitle : string;
  end;


type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses SHDocVw, oleacc, MSHTML, ActiveX;

{$R *.dfm}

//////////
// IETabリストを取得する
//////////
function getIETabList(var lsIETabRec:TList<TIETabRec>):boolean;
  function GetWindowClassNameStr(hWindow: HWND): String;
  var
    Buffer : array[0..MAX_PATH - 1] of Char;
    Len    : Integer;
  begin
    FillChar(Buffer, SizeOf(Buffer), #0);
    Len := GetClassName(hWindow, Buffer, Length(Buffer));
    if Len > 0 then Result := Buffer else Result := '';
  end;
  function EnumWindowsProc(hwindow :HWnd; lParam :TList):Boolean; stdcall;
  begin
    Result :=false;
    if hWindow <> 0 then
    begin
      if GetWindowClassNameStr(hWindow) = 'IEFrame' then
      begin
        lParam.Add(Pointer(hWindow));
      end;
    Result :=true;
    end;
  end;
  function EnumChildWindowsProc(hWindow: hWnd; lParam :TList):Boolean; Stdcall;
  begin
    Result := False;
    if hWindow <> 0 then
    begin
      if GetWindowClassNameStr(hWindow) = 'Internet Explorer_Server' then
      begin
        lParam.Add(Pointer(hWindow));
      end;
    end;
    Result := True;
  end;
var
  IETabRec:TIETabRec;

  loopIE,loopIETab : integer;
  lsIEList,lsIETabList: TList;
  hIEWindow,hIETabWindow : hWnd;
  cdMsg,cdRes : Cardinal;
  pDoc2 : IHTMLDocument2;
  pDoc3 : IHTMLDocument3;
  iw2IETab    : IWebbrowser2;
  ispService : IServiceProvider;

begin
  lsIETabRec := TList<TIETabRec>.Create;
  lsIEList := TList.Create;
  EnumWindows(@EnumWindowsProc, LPARAM(lsIEList));
  for loopIE := 0 to lsIEList.Count - 1 do
  begin
    lsIETabList := TList.Create;
    hIEWindow := Integer(lsIEList.Items[loopIE]);
    EnumChildWindows(hIEWindow, @EnumChildWindowsProc, LPARAM(lsIETabList));
    for loopIETab := 0 to lsIETabList.Count - 1 do begin
      hIETabWindow := Integer(lsIETabList.Items[loopIETab]);
      cdMsg := RegisterWindowMessage('WM_HTML_GETOBJECT');
      SendMessageTimeOut(hIETabWindow,cdMsg, 0, 0, SMTO_ABORTIFHUNG, 1000, cdRes);
      if ObjectFromLresult(cdRes, IHTMLDocument2, 0, pDoc2) = S_OK then
      begin
        ispService := pDoc2.parentWindow as IServiceprovider;
        ispService.QueryService(IWebbrowserApp, IWebbrowser2, iw2IETab);
        IETabRec.intIETabWindow := hIETabWindow;
        IETabRec.strIETabTitle := iw2IETab.LocationName;
        lsIETabRec.Add(IETabRec);
      end;
    end;
    lsIETabList.Free;
  end;
  lsIEList.Free;
end;

procedure TForm1.Button1Click(Sender: tobject);
var
  lsIETab : TList<TIETabRec>;
  i:integer;
begin
  ListBox1.Clear;
  lsIETab := TList<TIETabRec>.Create;
  getIETabList(lsIETab);
  for i := 0 to lsIETab.count -1 do
  begin
    ListBox1.Items.Add(IntToStr(lsIETab[i].intIETabWindow)+
    ' '+lsIETab[i].strIETabTitle);
  end;
  lsIETab.Free;
end;

end.

(2) スレッド
次は、スレッドです！
慣れているだけあって、これを参考にスレッドはスグにできました。
support.embarcadero.com

ここは、割愛です。Synchronizeが、ちょっと難しかった。
whileループはSynchronize以外のところで1秒くらい待ってあげると、フォームが固まりません。

(3) IEタブ変更の検知

・・・ということで、完成です！
順調な気がします！

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Dialogs, Vcl.StdCtrls,Generics.Collections;

type
  TIETabRec = record
    intIETabWindow : integer;
    strIETabTitle : string;
  end;

type
  TIEDetectThread = class(TThread)
  private
    { Private 宣言 }
    lsNewIETab:TList<TIETabRec>;
    lsPrevIETab:TList<TIETabRec>;
    procedure DetectChangeIETab;
  protected
    procedure Execute; override;

end;

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

var
  Form1: TForm1;

implementation

uses SHDocVw, oleacc, MSHTML, ActiveX;

{$R *.dfm}

//////////
// IETabリストを取得する
//////////
function getIETabList(var lsIETabRec:TList<TIETabRec>):boolean;
  function GetWindowClassNameStr(hWindow: HWND): String;
  var
    Buffer : array[0..MAX_PATH - 1] of Char;
    Len    : Integer;
  begin
    FillChar(Buffer, SizeOf(Buffer), #0);
    Len := GetClassName(hWindow, Buffer, Length(Buffer));
    if Len > 0 then Result := Buffer else Result := '';
  end;
  function EnumWindowsProc(hwindow :HWnd; lParam :TList):Boolean; stdcall;
  begin
    Result :=false;
    if hWindow <> 0 then
    begin
      if GetWindowClassNameStr(hWindow) = 'IEFrame' then
      begin
        lParam.Add(Pointer(hWindow));
      end;
    Result :=true;
    end;
  end;
  function EnumChildWindowsProc(hWindow: hWnd; lParam :TList):Boolean; Stdcall;
  begin
    Result := False;
    if hWindow <> 0 then
    begin
      if GetWindowClassNameStr(hWindow) = 'Internet Explorer_Server' then
      begin
        lParam.Add(Pointer(hWindow));
      end;
    end;
    Result := True;
  end;
var
  IETabRec:TIETabRec;

  loopIE,loopIETab : integer;
  lsIEList,lsIETabList: TList;
  hIEWindow,hIETabWindow : hWnd;
  cdMsg,cdRes : Cardinal;
  pDoc2 : IHTMLDocument2;
  iw2IETab    : IWebbrowser2;
  ispService : IServiceProvider;

begin
  lsIETabRec := TList<TIETabRec>.Create;
  lsIEList := TList.Create;
  EnumWindows(@EnumWindowsProc, LPARAM(lsIEList));
  for loopIE := 0 to lsIEList.Count - 1 do
  begin
    lsIETabList := TList.Create;
    hIEWindow := Integer(lsIEList.Items[loopIE]);
    EnumChildWindows(hIEWindow, @EnumChildWindowsProc, LPARAM(lsIETabList));
    for loopIETab := 0 to lsIETabList.Count - 1 do begin
      hIETabWindow := Integer(lsIETabList.Items[loopIETab]);
      cdMsg := RegisterWindowMessage('WM_HTML_GETOBJECT');
      SendMessageTimeOut(hIETabWindow,cdMsg, 0, 0, SMTO_ABORTIFHUNG, 1000, cdRes);
      if ObjectFromLresult(cdRes, IHTMLDocument2, 0, pDoc2) = S_OK then
      begin
        ispService := pDoc2.parentWindow as IServiceprovider;
        ispService.QueryService(IWebbrowserApp, IWebbrowser2, iw2IETab);
        if iw2IETab <> nil then begin
          IETabRec.intIETabWindow := hIETabWindow;
          IETabRec.strIETabTitle := iw2IETab.LocationName;
          lsIETabRec.Add(IETabRec);
        end;
      end;
    end;
    lsIETabList.Free;
  end;
  lsIEList.Free;
end;

//////////
// スレッド処理
//////////

procedure TIEDetectThread.Execute;
begin
  lsNewIETab:=TList<TIETabRec>.Create;
  lsPrevIETab:=TList<TIETabRec>.Create;
  while not Terminated do
  begin
    Synchronize(DetectChangeIETab);
    Sleep(1000);
  end;
  lsNewIETab.Free;
  lsPrevIETab.Free;
end;

procedure TIEDetectThread.DetectChangeIETab;
var
  loopNewIETab,loopPrevIETab:integer;
  blChange:boolean;
begin
  getIETabList(lsNewIETab);
  for loopNewIETab := 0 to lsNewIETab.count - 1 do
  begin
    blChange:=true;
    for loopPrevIETab := 0 to lsPrevIETab.count - 1 do
    begin
      if (lsNewIETab[loopNewIETab].intIETabWindow = lsPrevIETab[loopPrevIETab].intIETabWindow)
        and (lsNewIETab[loopNewIETab].strIETabTitle = lsPrevIETab[loopPrevIETab].strIETabTitle) then
        begin
          blChange:=false;
        end;
    end;
    if blChange then
    begin
      Dialogs.ShowMessage('新しいIEタブを検知しました！ ⇒ '+
        lsNewIETab[loopNewIETab].strIETabTitle);
    end;
  end;
  lsPrevIETab:=lsNewIETab;
end;

//////////
// メインフォーム
//////////

procedure TForm1.Button1Click(Sender: tobject);
begin
  Dialogs.ShowMessage('マルチスレッド開始します！');
  TIEDetectThread.Create;
end;

end.