158 lines
3.7 KiB
Plaintext
158 lines
3.7 KiB
Plaintext
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.
|