Search code examples
delphiui-automationdelphi-10-seattle

How capture the active url based in a substring without repetition?


I want capture the url of active window based in a substring and add to Memo only if sActiveURL is different of sOldURL.

The trouble in my code is that always is added to Memo the same url ignoring the verification if sActiveURL <> sOldURL.

How fix this?

Main:

type
  TForm1 = class(TForm)
    tmr1: TTimer;
    mmo1: TMemo;
    procedure tmr1Timer(Sender: TObject);
  private
    { Private declarations }
    sActiveURL,sOldURL : string;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Flag: Boolean;

implementation
uses
 UIAutomationClient_TLB, Activex, StrUtils;

{$R *.dfm}

function GetURL(hTargetWnd: HWND): string;
  function Enumerar(pParent: IUIAutomationElement; Scope: TreeScope; pCondition: IUIAutomationCondition): String;
  var
    found    : IUIAutomationElementArray;
    ALen     : Integer;
    i        : Integer;
    iElement : IUIAutomationElement;

    retorno: integer;
    value : WideString;
    iInter: IInterface;
    ValPattern  : IUIAutomationValuePattern;
  begin
    Result := '';
    Flag := false;
    if pParent = nil then
      Exit;
    pParent.FindAll(Scope, pCondition, found);
    found.Get_Length(ALen);
    for i := 1 to ALen - 1 do
    begin
      found.GetElement(i, iElement);
      iElement.Get_CurrentControlType(retorno);
      if (
          (retorno = UIA_EditControlTypeId) or
          (retorno = UIA_GroupControlTypeId)
         ) then
      begin
        iElement.GetCurrentPattern(UIA_ValuePatternId, iInter);
        if Assigned(iInter) then
        begin
          if iInter.QueryInterface(IID_IUIAutomationValuePattern, ValPattern) = S_OK then
          begin
            ValPattern.Get_CurrentValue(value);
            Result := trim(value);
            Flag := true;
            Break;
          end;
        end;
      end;
      if not Flag then
      begin
        Result := Enumerar(iElement, Scope, pCondition);
      end;
    end;

  end;
var
  UIAuto      : IUIAutomation;
  Ret         : Integer;
  RootElement : IUIAutomationElement;
  Scope       : TreeScope;
  varProp     : OleVariant;
  pCondition  : IUIAutomationCondition;
begin
  Result := '';
  try
    UIAuto := CoCUIAutomation.Create;
    if Succeeded(UIAuto.ElementFromHandle(hTargetWnd, RootElement)) then
    begin
      TVariantArg(varProp).vt    := VT_BOOL;
      TVariantArg(varProp).vbool := True;
      UIAuto.CreatePropertyCondition(UIA_IsControlElementPropertyId,
                                     varProp,
                                     pCondition);
      Scope := TreeScope_Element or TreeScope_Children;
      Result := Enumerar(RootElement, Scope, pCondition);
    end;
  except
    Result := '';
  end;
end;

procedure TForm1.tmr1Timer(Sender: TObject);
begin
sActiveURL := GetURL(GetForegroundWindow);
if sActiveURL <> sOldURL then
begin
if AnsiContainsText(sActiveURL, 'stackoverflow.com') then
   begin
     sOldURL := sActiveURL;
     mmo1.Lines.Add('['+sActiveURL+']<'+DateToStr(Date)+'>');
   end;
end;
end;

UIAutomationClient_TLB.pas


EDITION:

On debug i discovered that none value is attrib to sOldURL variable.

procedure TForm1.tmr1Timer(Sender: TObject);
var
 sActiveURL,sOldURL : string;
begin
sActiveURL := GetURL(GetForegroundWindow);
mmo1.Lines.Add('[sOldURL  =       '+sOldURL+'      ]');
mmo1.Lines.Add('[sActiveURL  =       '+sActiveURL+'      ]');
mmo1.Lines.Add('');
if sActiveURL <> sOldURL then
begin
if AnsiContainsText(sActiveURL, 'stackoverflow.com') then
   begin
     sOldURL := sActiveURL;
     mmo1.Lines.Add(sActiveURL);
     mmo1.Lines.Add('');
     mmo1.Lines.Add('');
   end;
end;
end;

enter image description here


Solution

  • The reason is as I shortly described in comments and is visible when the focused window is not your browser, for example your applications wiindow with the mmo1: TMemo:

    GetForegroundWindow() returns the window that has focus.

    Your GetURL(GetForegroundWindow) searches for an edit control (UIA_EditControlTypeId), of the focused window, and finds your memo control and returns the content of the memo.

    Further, if you change focus to your browser, its URL will be correctly recorded in the memo, and if you return focus to your application, the condition if AnsiContainsText(sActiveURL, 'stackoverflow.com') will be true.

    You then write to the memo, adding what you think is a real URL, and then this will be repeated for every timer event.

    You need to only check the real browser window (skip all other) for its current URL. Try this, if you are using IE, otherwise you must modify FindWindow():

    procedure TForm24.tmr1Timer(Sender: TObject);
    var                //
      hIEWnd: HWND;    //
    begin
      hIEWnd := FindWindow('IEFrame', nil);  //
      sActiveURL := GetURL(hIEWnd);          //
    //  sActiveURL := GetURL(GetForegroundWindow);
      if sActiveURL <> sOldURL then
      begin
        if AnsiContainsText(sActiveURL, 'stackoverflow.com') then
        begin
          sOldURL := sActiveURL;
          mmo1.Lines.Add('[' + sActiveURL + ']<' + DateToStr(Date) + '>');
        end;
      end;
    end;
    

    Modified lines are marked with //