unit DBrowserMonMain;

interface

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

const
  WEB_BROWSERS = 'iexplore.exe|msedge.exe|whale.exe|chrome.exe|firefox.exe|opera.exe|vivaldi.exe';

type
  TDlgBrowserMon = class(TForm)
    pnTop: TPanel;
    btnFind: TButton;
    Label1: TLabel;
    Label2: TLabel;
    lbPName: TLabel;
    lbWndCaption: TLabel;
    mmText: TMemo;
    procedure btnFindClick(Sender: TObject);
  private
    { Private declarations }
    WebList_: TStringList;

    procedure RefreshItems(hWebWnd: HWND);
  public
    { Public declarations }
    Constructor Create(aOwner: TComponent); override;
    Destructor Destroy; override;
  end;

var
  DlgBrowserMon: TDlgBrowserMon;

implementation

uses
  Tocsg.Strings, Tocsg.Exception, Tocsg.WndUtil, Tocsg.Process, Tocsg.MSAA,
  Winapi.oleacc, Winapi.ActiveX;

{$R *.dfm}

Constructor TDlgBrowserMon.Create(aOwner: TComponent);
begin
  Inherited Create(aOwner);
  WebList_ := TStringList.Create;
  WebList_.CaseSensitive := false;
  SplitString(WEB_BROWSERS, '|', WebList_);
  CoInitialize(nil);
end;

Destructor TDlgBrowserMon.Destroy;
begin
  CoUninitialize;
  FreeAndNil(WebList_);
  Inherited;
end;

procedure TDlgBrowserMon.btnFindClick(Sender: TObject);
var
  h, hc: HWND;
  sCap, sPName: String;
  llStyle: LONGLONG;
begin
  try
    h := FindWindow(nil, nil);
    while h <> 0 do
    begin
      llStyle := GetWindowStyle(h);
      if ((llStyle and WS_VISIBLE) <> 0) then
      begin
        sCap := GetWindowCaption(h);
        if sCap <> '' then
        begin
          sPName := GetProcessNameFromWndHandle(h);
          if (sPName <> '') and (WebList_.IndexOf(sPName) <> -1) then
          begin
            lbPName.Caption := sPName;
            lbWndCaption.Caption := sCap;

//            if (sPName = 'chrome.exe') or then
            begin
              hc := GetWndChildClass(h, 'Chrome_RenderWidgetHostHWND');
              if hc = 0 then
                hc := GetWndChildClass(h, 'Chrome_WidgetWin');
            end;
//            else
//              hc := 0;

            if hc <> 0 then
              RefreshItems(hc)
            else
              RefreshItems(h);

            Application.ProcessMessages;

            exit;
          end;
        end;
      end;
       h := GetWindow(h, GW_HWNDNEXT);
    end;
  except
    on E: Exception do
      ETgException.TraceException(Self, E, 'Fail .. btnFindClick()');
  end;
end;

procedure TDlgBrowserMon.RefreshItems(hWebWnd: HWND);
var
  ProcEnumAccessible: TProcessEnumAccessible;
  arrRoleStr: array [0..300] of Char;

begin
  try
    mmText.Clear;

    if hWebWnd = 0 then
      exit;

    ProcEnumAccessible :=
      procedure(aAccObj: IAccessible; varChild: OleVariant; h: HWND; nLevel: Integer; var bContinue: Boolean)
      var
        sName,
        sRole: String;
      begin
        bContinue := true;
        try
          if Assigned(aAccObj) then
          begin
            sName := Trim(LowerCase(GetObjectName(aAccObj, varChild)));
            sRole := '';
            ZeroMemory(@arrRoleStr, SizeOf(arrRoleStr));
            if GetObjectRoleString(aAccObj, varChild, @arrRoleStr) then
              sRole := DeleteNullTail(String(@arrRoleStr));

            if not VarIsNull(varChild) and
               (sName <> '') and
               (sRole = '텍스트') then
            begin
              mmText.Lines.Add(sName);
            end;
          end;
        except
        // ..
        end;
      end;

    EnumAccessible(hWebWnd, ProcEnumAccessible);
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. GetCurBrowserUrl()');
  end;
end;

end.