365 lines
11 KiB
Plaintext
365 lines
11 KiB
Plaintext
{*******************************************************}
|
||
{ }
|
||
{ ThdExtrUrl }
|
||
{ }
|
||
{ Copyright (C) 2022 kku }
|
||
{ }
|
||
{*******************************************************}
|
||
|
||
unit ThdExtrUrl;
|
||
|
||
interface
|
||
|
||
uses
|
||
Tocsg.Thread, System.SysUtils, System.Classes, Winapi.Windows,
|
||
Winapi.oleacc, Winapi.Messages, System.Generics.Collections, NetFwTypeLib_TLB;
|
||
|
||
const
|
||
WM_CATCH_URL = WM_USER + 8547;
|
||
|
||
type
|
||
PBwInfo = ^TBwInfo;
|
||
TBwInfo = record
|
||
sPName,
|
||
sTitle,
|
||
sUrl: String;
|
||
end;
|
||
TThdExtrUrl = class(TTgThread)
|
||
protected
|
||
hRcvWnd_: HWND;
|
||
qBwHwnd_: TQueue<HWND>;
|
||
|
||
AccObj_SubTitle_: IAccessible;
|
||
varSubTitle_: OleVariant;
|
||
sRecentSub_: String;
|
||
hSubTitleHWND_: HWND;
|
||
|
||
procedure Execute; override;
|
||
public
|
||
Constructor Create(hRcvWnd: HWND);
|
||
Destructor Destroy; override;
|
||
|
||
procedure PushBW(h: HWND);
|
||
end;
|
||
|
||
implementation
|
||
|
||
uses
|
||
Tocsg.Process, Tocsg.WndUtil, Tocsg.MSAA, System.Variants, Winapi.ActiveX,
|
||
Tocsg.Firewall, Tocsg.Path, Tocsg.Strings;
|
||
|
||
Constructor TThdExtrUrl.Create(hRcvWnd: HWND);
|
||
begin
|
||
Inherited Create;
|
||
hRcvWnd_ := hRcvWnd;
|
||
qBwHwnd_ := TQueue<HWND>.Create;
|
||
AccObj_SubTitle_ := nil;
|
||
VariantClear(varSubTitle_);
|
||
sRecentSub_ := '';
|
||
hSubTitleHWND_ := 0;
|
||
end;
|
||
|
||
Destructor TThdExtrUrl.Destroy;
|
||
begin
|
||
FreeAndNil(qBwHwnd_);
|
||
Inherited;
|
||
end;
|
||
|
||
procedure TThdExtrUrl.PushBW(h: HWND);
|
||
begin
|
||
qBwHwnd_.Enqueue(h);
|
||
end;
|
||
|
||
procedure TThdExtrUrl.Execute;
|
||
var
|
||
hBW: HWND;
|
||
sPName: String;
|
||
|
||
function GetWndChildClassCustom(h: HWND; const sClassName: String; hPreChild: HWND = 0): HWND;
|
||
var
|
||
hChild: HWND;
|
||
arrClassName: array [0..255] of Char;
|
||
begin
|
||
Result := 0;
|
||
if hPreChild <> 0 then
|
||
hChild := GetWindow(hPreChild, GW_HWNDNEXT)
|
||
else
|
||
hChild := GetWindow(h, GW_CHILD);
|
||
|
||
while hChild <> 0 do
|
||
begin
|
||
if GetClassName(hChild, arrClassName, SizeOf(arrClassName)) > 0 then
|
||
begin
|
||
if (arrClassName = sClassName) and (GetEditText(hChild) <> '') then
|
||
// if arrClassName = sClassName then
|
||
begin
|
||
Result := hChild;
|
||
exit;
|
||
end;
|
||
end;
|
||
|
||
if GetWindow(hChild, GW_CHILD) <> 0 then
|
||
begin
|
||
Result := GetWndChildClassCustom(hChild, sClassName);
|
||
if Result <> 0 then
|
||
exit;
|
||
end;
|
||
|
||
hChild := GetWindow(hChild, GW_HWNDNEXT);
|
||
end;
|
||
end;
|
||
|
||
function GetSubTitle: String; // <20>ͽ<EFBFBD><CDBD>÷η<C3B7><CEB7><EFBFBD> <20><><EFBFBD><EFBFBD> URL <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>ܶ<EFBFBD><DCB6><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.. 14_1111 09:54:30 sunk
|
||
var
|
||
h: HWND;
|
||
ProcEnumAccessible: TProcessEnumAccessible;
|
||
sAccResult,
|
||
sAddressBarName,
|
||
sAddressBarRole: String;
|
||
bRetry: Boolean;
|
||
WndList: TStringList;
|
||
nHandleIdx, nHandleCnt: Integer;
|
||
dwPid: DWORD;
|
||
arrRoleStr: array [0..300] of Char;
|
||
Label
|
||
LB_RETRY, LB_EnumAccessible;
|
||
begin
|
||
bRetry := false;
|
||
Result := '';
|
||
WndList := nil;
|
||
nHandleIdx := 0;
|
||
nHandleCnt := 0;
|
||
|
||
dwPid := GetProcessPIDFromWndHandle(hBW);
|
||
if dwPid = 0 then
|
||
exit;
|
||
|
||
sPName := LowerCase(GetProcessNameByPid(dwPid));
|
||
if sPName = '' then
|
||
exit;
|
||
|
||
if (AccObj_SubTitle_ <> nil) and not VarIsNull(varSubTitle_) then
|
||
begin
|
||
// IE 11 <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>س<EFBFBD><D8B3><EFBFBD> <20>ν<EFBFBD><CEBD>Ͻ<EFBFBD><CFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EEB3BB> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ʱ<EFBFBD>ȭ <20><><EFBFBD>ֵ<EFBFBD><D6B5><EFBFBD> <20><><EFBFBD><EFBFBD>... 18_0201 17:16:41 sunk
|
||
Result := GetObjectValue(AccObj_SubTitle_, varSubTitle_);
|
||
// _Trace('11 .. GetSubTitle .. "%s"', [Result]);
|
||
if sRecentSub_ <> Result then
|
||
begin
|
||
sRecentSub_ := Result;
|
||
exit;
|
||
end;
|
||
// _Trace('11 .. GetSubTitle .. old = new .. "%s"', [Result]);
|
||
AccObj_SubTitle_ := nil;
|
||
VariantClear(varSubTitle_);
|
||
end else
|
||
if hSubTitleHWND_ <> 0 then
|
||
begin
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 18_0201 17:16:50 sunk
|
||
Result := GetEditText(hSubTitleHWND_);
|
||
// _Trace('22 .. GetSubTitle .. "%s"', [Result]);
|
||
if sRecentSub_ <> Result then
|
||
begin
|
||
sRecentSub_ := Result;
|
||
exit;
|
||
end;
|
||
// _Trace('22 .. GetSubTitle .. old = new .. "%s"', [Result]);
|
||
hSubTitleHWND_ := 0;
|
||
end;
|
||
|
||
LB_RETRY :
|
||
sAccResult := '';
|
||
|
||
if (hBW <> 0) then
|
||
begin
|
||
ProcEnumAccessible :=
|
||
procedure(aAccObj: IAccessible; varChild: OleVariant; h: HWND; nLevel: Integer; var bContinue: Boolean)
|
||
var
|
||
sName,
|
||
sRole: String;
|
||
begin
|
||
// _Trace('Name = %s', [GetObjectName(aAccObj, varChild)]);
|
||
// _Trace('RoleString = %s', [GetObjectRoleString(aAccObj, varChild)]);
|
||
|
||
sName := Trim(LowerCase(GetObjectName(aAccObj, varChild)));
|
||
ZeroMemory(@arrRoleStr, SizeOf(arrRoleStr));
|
||
if GetObjectRoleString(aAccObj, varChild, @arrRoleStr) then
|
||
sRole := DeleteNullTail(String(@arrRoleStr));
|
||
|
||
// <20>Ʒ<EFBFBD>ó<EFBFBD><C3B3> <20≯<EFBFBD><CCB8><EFBFBD><EFBFBD><EFBFBD> Ȯ<><C8AE> <20>ؼ<EFBFBD> <20>ּ<EFBFBD> <20><>Ʈ<EFBFBD><C6AE><EFBFBD><EFBFBD> ã<>´<EFBFBD>.
|
||
// <20>ѱ<EFBFBD><D1B1><EFBFBD> ũ<><C5A9><EFBFBD><EFBFBD> <20≯<EFBFBD><CCB8><EFBFBD><EFBFBD><EFBFBD> "<22>ּ<EFBFBD>â <20><> <20>˻<EFBFBD>â"<22><> ã<><C3A3><EFBFBD><EFBFBD> <20>Ǵµ<C7B4> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><EFBFBD><EEB6B2> Ȯ<><C8AE><EFBFBD>غ<EFBFBD><D8BA><EFBFBD> <20><><EFBFBD>ߴ<EFBFBD>.
|
||
// <20>뷫<EFBFBD><EBB7AB><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><DEBE>ɷ<EFBFBD> <20>ϴ<EFBFBD> <20>ֱ<EFBFBD><D6B1><EFBFBD> 14_1112 10:41:12 sunk
|
||
if (Pos(sName, sAddressBarName) > 0) and (Pos(sRole, sAddressBarRole) > 0) then
|
||
begin
|
||
bContinue := false;
|
||
AccObj_SubTitle_ := aAccObj;
|
||
varSubTitle_ := varChild;
|
||
sAccResult := GetObjectValue(aAccObj, varChild);
|
||
end else
|
||
bContinue := true;
|
||
end;
|
||
|
||
sAddressBarRole := '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20>ִ<EFBFBD> <20>ؽ<EFBFBD>Ʈ:editable text'; // <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> 17_0207 10:20:06 sunk
|
||
if sPName = 'iexplore.exe' then
|
||
begin
|
||
// _Trace('AddWindowLog() >> GetSubTitle() .. ProcName = %s', [sProcName]);
|
||
h := GetWndChildClassCustom(hBW, 'Address Band Root');
|
||
|
||
if h <> 0 then
|
||
begin
|
||
// _Trace('AddWindowLog() >> GetSubTitle() .. ProcName = %s, "Address Band Root" .. ok', [sProcName]);
|
||
hSubTitleHWND_ := GetWndChildClassCustom(h, 'Edit');
|
||
if hSubTitleHWND_ = 0 then
|
||
begin
|
||
{$IFDEF TRACE_WM}
|
||
_Trace('AddWindowLog() >> GetSubTitle() .. ProcName = %s, "Address Band Root" .. ok .. class not found .. "Edit" .. TrayAcc', [sProcName]);
|
||
{$ENDIF}
|
||
sAddressBarName := 'bing<6E><67>(<28><>) <20><><EFBFBD><EFBFBD><EFBFBD>Ͽ<EFBFBD> <20>ּ<EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20>˻<EFBFBD>:bing <20>˻<EFBFBD><CBBB><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Ͽ<EFBFBD> <20>ּ<EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20>˻<EFBFBD>';
|
||
goto LB_EnumAccessible;
|
||
end else
|
||
Result := GetEditText(hSubTitleHWND_);
|
||
end else begin
|
||
{$IFDEF TRACE_WM}
|
||
_Trace('AddWindowLog() >> GetSubTitle() .. ProcName = %s, class not found .. "Address Band Root" .. TrayAcc', [sProcName]);
|
||
{$ENDIF}
|
||
|
||
// 11<31><31><EFBFBD><EFBFBD> <20><><EFBFBD>Ŀ<EFBFBD> <20><> <20>ڵ<EFBFBD><DAB5><EFBFBD> <20>ɷ<EFBFBD><C9B7><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20>ȵǴ<C8B5> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><EFBFBD><DFBB>ߴ<EFBFBD>...
|
||
// <20><EFBFBD><D7B7><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ֻ<EFBFBD><D6BB><EFBFBD> <20>ڵ<EFBFBD><DAB5><EFBFBD> <20><><EFBFBD>°ɷ<C2B0> <20><><EFBFBD><EFBFBD> 18_0201 15:54:50 sunk
|
||
// h := GetWndHandleFromPid(dwPid_);
|
||
// if (h <> 0) and (h <> hWindow) then
|
||
// begin
|
||
// hWindow := h;
|
||
// _Trace('AddWindowLog() >> GetSubTitle() .. ProcName = %s, class not found .. "Address Band Root" .. TrayAcc .. change .. handle', [sProcName]);
|
||
// end;
|
||
|
||
// <20><><EFBFBD><EFBFBD> <20><> ã<><C3A3> <20><><EFBFBD><EFBFBD> <20>ϳ<EFBFBD> <20><> <20>߰<EFBFBD> 18_0116 15:40:27 sunk
|
||
// sAddressBarName<6D><65> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>ؼ<EFBFBD> <20><> <20>߰<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ʿ<EFBFBD><CABF>ϰ<EFBFBD>
|
||
// <20≯<EFBFBD><CCB8><EFBFBD> OS <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20>⺻ <20>˻<EFBFBD><CBBB><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ٸ<EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD>Ƿ<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ʿ<EFBFBD><CABF>ϴ<EFBFBD>
|
||
sAddressBarName := 'bing<6E><67>(<28><>) <20><><EFBFBD><EFBFBD><EFBFBD>Ͽ<EFBFBD> <20>ּ<EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20>˻<EFBFBD>:bing <20>˻<EFBFBD><CBBB><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Ͽ<EFBFBD> <20>ּ<EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20>˻<EFBFBD>';
|
||
goto LB_EnumAccessible;
|
||
end;
|
||
end else
|
||
if sPName = 'msedge.exe' then
|
||
begin
|
||
// <20><><EFBFBD><EFBFBD> ũ<>ι̿<CEB9> <20>߰<EFBFBD> 20_0608 08:25:07 sunk
|
||
sAddressBarName := '<27>ּ<EFBFBD> ǥ<><C7A5><EFBFBD><EFBFBD> <20><> <20>˻<EFBFBD> â:address and search bar';
|
||
goto LB_EnumAccessible;
|
||
end else
|
||
if sPName = 'whale.exe' then
|
||
begin
|
||
// <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>߰<EFBFBD> 20_0713 08:45:00 sunk
|
||
sAddressBarName := '<27>ּ<EFBFBD>â <20><> <20>˻<EFBFBD>â:address and search bar';
|
||
goto LB_EnumAccessible;
|
||
end else
|
||
if sPName = 'chrome.exe' then
|
||
begin
|
||
hSubTitleHWND_ := GetWndChildClassCustom(hBW, 'Chrome_OmniboxView');
|
||
if hSubTitleHWND_ = 0 then
|
||
begin
|
||
// ũ<><C5A9> 28<32><38><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD>ʹ<EFBFBD> <20>ٸ<EFBFBD><D9B8><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>Ѵ<EFBFBD>.. 14_1111 10:29:37 sunk
|
||
sAddressBarName := '<27>ּ<EFBFBD>â <20><> <20>˻<EFBFBD>â:address and search bar';
|
||
goto LB_EnumAccessible;
|
||
end else
|
||
Result := GetEditText(hSubTitleHWND_);
|
||
end else
|
||
if sPName = 'firefox.exe' then
|
||
begin
|
||
sAddressBarName := 'google<6C><65> <20>˻<EFBFBD><CBBB>ϰų<CFB0> <20>ּ<EFBFBD> <20>Է<EFBFBD>:<3A>˻<EFBFBD><CBBB> <20>ּ<EFBFBD> <20>Է<EFBFBD>:search or enter address';
|
||
// EnumAccessible(hWindow, ProcEnumAccessible);
|
||
goto LB_EnumAccessible;
|
||
end else
|
||
if sPName = 'opera.exe' then
|
||
begin
|
||
sAddressBarName := '<27>ּ<EFBFBD> <20>ʵ<EFBFBD>:address field';
|
||
// EnumAccessible(hWindow, ProcEnumAccessible);
|
||
goto LB_EnumAccessible;
|
||
end;
|
||
|
||
exit; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> ------------------------------------------------
|
||
|
||
LB_EnumAccessible :
|
||
// <20><><EFBFBD><EFBFBD> ó<><C3B3><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> 18_0117 09:26:19 sunk
|
||
EnumAccessible(hBW, ProcEnumAccessible);
|
||
if (AccObj_SubTitle_ <> nil) and not VarIsNull(varSubTitle_) then
|
||
begin
|
||
Result := sAccResult;
|
||
end else begin
|
||
{$IFDEF TRACE_WM}
|
||
_Trace('AddWindowLog() >> GetSubTitle() .. ProcName = %s, EnumAccName not found ..', [sProcName]);
|
||
{$ENDIF}
|
||
|
||
if (dwPid <> 0) and not bRetry then
|
||
begin
|
||
bRetry := true;
|
||
h := GetWndHandleFromPid(dwPid);
|
||
if (h <> 0) and (h <> hBW) then
|
||
begin
|
||
hBW := h;
|
||
{$IFDEF TRACE_WM}
|
||
_Trace('AddWindowLog() >> GetSubTitle() .. ProcName = %s, init retry .. ok', [sProcName]);
|
||
{$ENDIF}
|
||
goto LB_RETRY;
|
||
end else begin
|
||
{$IFDEF TRACE_WM}
|
||
_Trace('AddWindowLog() >> GetSubTitle() .. ProcName = %s, init retry .. cancel ..', [sProcName]);
|
||
{$ENDIF}
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
if sRecentSub_ = Result then
|
||
begin
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>ٸ<EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><>ȯ<EFBFBD><C8AF><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20>ʱ<EFBFBD>ȭ<EFBFBD><C8AD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 18_0201 17:12:37 sunk
|
||
sRecentSub_ := '';
|
||
Result := '';
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
var
|
||
sSubTitle: String;
|
||
nTO: Integer;
|
||
BwInfo: TBwInfo;
|
||
begin
|
||
CoInitialize(nil);
|
||
try
|
||
while not Terminated and not GetWorkStop do
|
||
begin
|
||
if qBwHwnd_.Count = 0 then
|
||
begin
|
||
Sleep(500);
|
||
continue;
|
||
end;
|
||
|
||
hBW := qBwHwnd_.Dequeue;
|
||
if hBW = 0 then
|
||
begin
|
||
Sleep(500);
|
||
continue;
|
||
end;
|
||
|
||
nTO := 0;
|
||
sSubTitle := GetSubTitle;
|
||
while sSubTitle = '' do
|
||
begin
|
||
Sleep(500);
|
||
Inc(nTO);
|
||
if nTO >= 3 then
|
||
break;
|
||
end;
|
||
|
||
if sSubTitle <> '' then
|
||
begin
|
||
BwInfo.sTitle := GetWindowCaption(hBW);
|
||
BWInfo.sUrl := sSubTitle;
|
||
BwInfo.sPName := sPName;
|
||
SendMessage(hRcvWnd_, WM_CATCH_URL, 0, NativeInt(@BwInfo));
|
||
end;
|
||
end;
|
||
finally
|
||
CoUninitialize;
|
||
end;
|
||
end;
|
||
|
||
end.
|