如何在不重复的情况下捕获基于子字符串的活动url？

Question

我想捕获基于子字符串的活动 window 的 url 并仅在 时添加到 Memo sActiveURL 不同于 sOldURL.

我的代码中的问题是总是添加到 Memo 相同的 url 忽略验证 if sActiveURL <> sOldURL.

如何解决这个问题？

主要:

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, 'whosebug.com') then
   begin
     sOldURL := sActiveURL;
     mmo1.Lines.Add('['+sActiveURL+']<'+DateToStr(Date)+'>');
   end;
end;
end;

UIAutomationClient_TLB.pas

版本：

在调试时我发现 none 值归因于 sOldURL 变量。

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, 'whosebug.com') then
   begin
     sOldURL := sActiveURL;
     mmo1.Lines.Add(sActiveURL);
     mmo1.Lines.Add('');
     mmo1.Lines.Add('');
   end;
end;
end;

Answer 1

原因正如我在评论中简短描述的那样，当焦点 window 不是您的浏览器时，例如您的应用程序窗口 mmo1: TMemo:

GetForegroundWindow() return 是有焦点的 window。

您的 GetURL(GetForegroundWindow) 搜索焦点 window 的编辑控件 (UIA_EditControlTypeId)，并找到您的备忘录控件和 return 备忘录的内容.

此外，如果您将焦点转移到您的浏览器，它的 URL 将正确记录在备忘录中，如果您 return 焦点转移到您的应用程序，条件 if AnsiContainsText(sActiveURL, 'whosebug.com') 将是真的。

然后您写入备忘录，添加您认为真实的内容 URL，然后对每个计时器事件重复此操作。

您只需检查真实浏览器 window（跳过所有其他浏览器）的当前 URL。试试这个，如果你使用的是IE，否则你必须修改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, 'whosebug.com') then
    begin
      sOldURL := sActiveURL;
      mmo1.Lines.Add('[' + sActiveURL + ']<' + DateToStr(Date) + '>');
    end;
  end;
end;

修改后的行标有//

如何在不重复的情况下捕获基于子字符串的活动url？

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

delphi

ui-automation

delphi-10-seattle