{*******************************************************}
{                                                       }
{       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; // ÀͽºÇ÷η¯ÀÇ °æ¿ì URL ³ª¸ÓÁö´Â Á¦¿Ü¶ó°í º¸¸éµÊ.. 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 ¿¡¼­ ±âÁ¸¿¡ ±¸ÇسõÀº ÀνºÅϽº·Î °è¼Ó °°Àº°ª¸¸ ¹ñ¾î³»´Â ¹®Á¦ ¶§¹®¿¡
    // ÀÌÀü°ª°ú °°À»¶§ ÃʱâÈ­ ÇØÁÖµµ·Ï º¸¿Ï... 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
    // À§¿¡¶û ±ò¸ÂÃã 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));

        // ¾Æ·¡Ã³·³ À̸§À¸·Î È®ÀÎ Çؼ­ ÁÖ¼Ò ÄÁÆ®·ÑÀ» ã´Â´Ù.
        // Çѱ¹¾î Å©·ÒÀº À̸§À¸·Î "ÁÖ¼Òâ ¹× °Ë»öâ"À» ãÀ¸¸é µÇ´Âµ¥ ¿µ¹®ÆÇÀº ¾î¶²Áö È®ÀÎÇغ¸Áö ¸øÇß´Ù.
        // ´ë·«ÀûÀ¸·Î Á޾°É·Î ÀÏ´Ü ³Ö±äÇÔ 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 := 'ÆíÁýÇÒ ¼ö ÀÖ´Â ÅؽºÆ®:editable text'; // °ÅÀÇ µ¿ÀÏ 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À»(¸¦) »ç¿ëÇÏ¿© ÁÖ¼Ò ÁöÁ¤ ¹× °Ë»ö:bing °Ë»ö¿£ÁøÀ» »ç¿ëÇÏ¿© ÁÖ¼Ò ÁöÁ¤ ¹× °Ë»ö';
            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¹öÀü ÀÌÈÄ¿¡ ÅÇ ÇÚµé·Î °É·Á¼­ Á¦´ë·Î ¼öÁý ¾ÈµÇ´Â ¹®Á¦°¡ ¹ß»ýÇß´Ù...
        // ±×·¡¼­ ¹«Á¶°Ç ÃÖ»óÀ§ ÇÚµéÀ» ¾ò´Â°É·Î º¸¿Ï 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;

        // ½ÇÆÐ ½Ã ã´Â ¹æ¹ý Çϳª ´õ Ãß°¡ 18_0116 15:40:27 sunk
        // sAddressBarName¿¡ ¿µ¹® ¹öÀüÀ» °í·ÁÇؼ­ ´õ Ãß°¡ Á¤º¸°¡ ÇÊ¿äÇÏ°í
        // À̸§ÀÌ OS ¹öÀü¸¶´Ù, ±âº» °Ë»ö¿£Áø¸¶´Ù ´Ù¸¦ ¼ö ÀÖÀ¸¹Ç·Î º¸¿ÏÀÌ ÇÊ¿äÇÏ´Ù
          sAddressBarName := 'bingÀ»(¸¦) »ç¿ëÇÏ¿© ÁÖ¼Ò ÁöÁ¤ ¹× °Ë»ö:bing °Ë»ö¿£ÁøÀ» »ç¿ëÇÏ¿© ÁÖ¼Ò ÁöÁ¤ ¹× °Ë»ö';
          goto LB_EnumAccessible;
        end;
      end else
      if sPName = 'msedge.exe' then
      begin
      // ¿§Áö Å©·Î¹Ì¿ò Ãß°¡ 20_0608 08:25:07 sunk
        sAddressBarName := 'ÁÖ¼Ò Ç¥½ÃÁÙ ¹× °Ë»ö â:address and search bar';
        goto LB_EnumAccessible;
      end else
      if sPName = 'whale.exe' then
      begin
      // ¿þÀÏ ºê¶ó¿ìÀú Ãß°¡ 20_0713 08:45:00 sunk
        sAddressBarName := 'ÁÖ¼Òâ ¹× °Ë»öâ: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
        // Å©·Ò 28¹öÀü ÀÌÈÄ ºÎÅÍ´Â ´Ù¸£°Ô ±¸ÇØÁà¾ß ÇÑ´Ù.. 14_1111 10:29:37 sunk
          sAddressBarName := 'ÁÖ¼Òâ ¹× °Ë»öâ:address and search bar';
          goto LB_EnumAccessible;
        end else
          Result := GetEditText(hSubTitleHWND_);
      end else
      if sPName = 'firefox.exe' then
      begin
        sAddressBarName := 'google·Î °Ë»öÇϰųª ÁÖ¼Ò ÀÔ·Â:°Ë»ö¾î³ª ÁÖ¼Ò ÀÔ·Â:search or enter address';
//          EnumAccessible(hWindow, ProcEnumAccessible);
        goto LB_EnumAccessible;
      end else
      if sPName = 'opera.exe' then
      begin
        sAddressBarName := 'ÁÖ¼Ò Çʵå:address field';
//          EnumAccessible(hWindow, ProcEnumAccessible);
        goto LB_EnumAccessible;
      end;

      exit; // ºüÁ®³ª°¡±â ÁÖÀÇ ------------------------------------------------

    LB_EnumAccessible :
    // ÅëÇÕ Ã³¸®·Î ¼öÁ¤ 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
      // ÀÌÀü°ú °°´Ù¸é ±»ÀÌ °°Àº°ª ¹ÝȯÇÏÁö ¸»°í ÃʱâÈ­¸¸ ÇØÁÖÀÚ 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.