Delphi 获取IE中选项卡标题

网络 Delphi

本文整理自网络，侵删。

 
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):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.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;
  i:integer;
begin
  ListBox1.Clear;
  lsIETab := TList.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.
 
 
 
 
改进：同步获取IE中选项卡标题
unit Unit1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs,Generics.Collections, Vcl.StdCtrls;
 
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;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  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
 
 Form1.ListBox1.Items.Add(lsNewIETab[loopNewIETab].strIETabTitle);
    end;
  end;
  lsPrevIETab:=lsNewIETab;
end;
 
 
 
procedure TForm1.Button1Click(Sender: TObject);
 
begin
 
  TIEDetectThread.Create;
 
end;

相关阅读 >>

Delphi 农历源码

Delphi中的字符串比较(comparestr)

fmsoft_unigui个文件说明

Delphi unigi unidbtreegrid展开叠起 unidbgrid自动调节列宽

Delphi 实现代码重启android app

Delphi2009 使用 png 图片

shellexecute()和winexec()区别

判断url的有效性

Delphi关于dbgrid和webbrowser的焦点问题

Delphi getforegroundwindow 与 getactivewindow 的区别

更多相关阅读请进入《Delphi》频道 >>



标签：

打赏

取消

感谢您的支持，我会继续努力的!

扫码支持
扫码打赏，您说多少就多少

打开支付宝扫一扫，即可进行扫码打赏哦

分享从这里开始，精彩与您同在

相关推荐

评论

管理员已关闭评论功能...