2017-02-10 133 views
1

我想枚举并获取chrome中所有打开的标签的URL。随着大量的来自谷歌(well..actually从:-)#1)的帮助下,我可以设法列举并获得使用下面的代码中所有打开的选项卡的“名称” ..枚举所有打开的标签中的Chrome URL vb.net

Imports System.Windows.Automation 
Imports System.Runtime.InteropServices 
Imports System.Text 

Public Class Form1 

    Public Declare Auto Function GetClassName Lib "User32.dll" (ByVal hwnd As IntPtr, _ 
    <Out()> ByVal lpClassName As System.Text.StringBuilder, ByVal nMaxCount As Integer) As Integer 

    Public Delegate Function CallBack(ByVal hwnd As Integer, ByVal lParam As Integer) As Boolean 
    Public Declare Function EnumWindows Lib "user32" (ByVal Adress As CallBack, ByVal y As Integer) As Integer 
    Public Declare Function IsWindowVisible Lib "user32.dll" (ByVal hwnd As IntPtr) As Boolean 

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click 
     GetActiveWindows() 
    End Sub 

    Public Sub GetActiveWindows() 
     EnumWindows(AddressOf Enumerator, 0) 
    End Sub 

    Private Function Enumerator(ByVal hwnd As IntPtr, ByVal lParam As Integer) As Boolean 
     '//Only active windows 
     If IsWindowVisible(hwnd) Then 
      Dim sClassName As New StringBuilder("", 256) 
      GetClassName(hwnd, sClassName, 256) 
      '//Only want visible chrome windows 
      If sClassName.ToString = "Chrome_WidgetWin_1" Then 
       FindChromeTabsURL(hwnd) 
      End If 
     End If 
     Return True 
    End Function 

    Private Sub FindChromeTabs(hwnd As IntPtr) 

     '//To find the tabs we first need to locate something reliable - the 'New Tab' button 
     Dim rootElement As AutomationElement = AutomationElement.FromHandle(hwnd) 
     Dim condNewTab As Condition = New PropertyCondition(AutomationElement.NameProperty, "New Tab") 

     '//Find the 'new tab' button 
     Dim elemNewTab As AutomationElement = rootElement.FindFirst(TreeScope.Descendants, condNewTab) 

     '//No tabstrip found 
     If elemNewTab = Nothing Then Exit Sub 

     '//Get the tabstrip by getting the parent of the 'new tab' button 
     Dim tWalker As TreeWalker = TreeWalker.ControlViewWalker 
     Dim elemTabStrip As AutomationElement = tWalker.GetParent(elemNewTab) 

     '//Loop through all the tabs and get the names which is the page title 
     Dim tabItemCondition As Condition = New PropertyCondition(AutomationElement.ControlTypeProperty, ControlType.TabItem) 
     For Each tabItem As AutomationElement In elemTabStrip.FindAll(TreeScope.Children, tabItemCondition) 
      Debug.WriteLine(tabItem.Current.Name) 
     Next 

    End Sub 

    Private Sub FindChromeTabsURL(ByVal hwnd As IntPtr) 

     '//To find the tabs we first need to locate something reliable - the 'New Tab' button 
     Dim rootElement As AutomationElement = AutomationElement.FromHandle(hwnd) 
     Dim condNewTab As Condition = New PropertyCondition(AutomationElement.NameProperty, "New Tab") 

     'retURL(hwnd) 
     'Exit Sub 

     '//Find the 'new tab' button 
     Dim elemNewTab As AutomationElement = rootElement.FindFirst(TreeScope.Descendants, condNewTab) 

     '//No tabstrip found 
     If elemNewTab = Nothing Then Exit Sub 

     '//Get the tabstrip by getting the parent of the 'new tab' button 
     Dim tWalker As TreeWalker = TreeWalker.ControlViewWalker 
     Dim elemTabStrip As AutomationElement = tWalker.GetParent(elemNewTab) 

     '//Loop through all the tabs and get the names which is the page title 
     Dim tabItemCondition As Condition = New PropertyCondition(AutomationElement.ControlTypeProperty, ControlType.TabItem) 
     For Each tabItem As AutomationElement In elemTabStrip.FindAll(TreeScope.Children, tabItemCondition) 
      Debug.WriteLine(tabItem.Current.Name) 
     Next 


    End Sub 

而且使用下面的代码我能够在Chrome浏览器中获取所选“活动”选项卡的URL。

Dim procsChrome As Process() = Process.GetProcessesByName("chrome") 
For Each chrome As Process In procsChrome 
    If chrome.MainWindowHandle = IntPtr.Zero Then Continue For 

    Dim elm As AutomationElement = AutomationElement.FromHandle(hwnd) 
    Dim elmUrlBar As AutomationElement = elm.FindFirst(TreeScope.Descendants, New PropertyCondition(AutomationElement.NameProperty, "Address and search bar")) 


    If elmUrlBar IsNot Nothing Then 
     Dim patterns As AutomationPattern() = elmUrlBar.GetSupportedPatterns() 
     If patterns.Length > 0 Then 
      Dim val As ValuePattern = DirectCast(elmUrlBar.GetCurrentPattern(patterns(0)), ValuePattern) 
      If Not elmUrlBar.GetCurrentPropertyValue(AutomationElement.HasKeyboardFocusProperty) Then MsgBox(LCase(val.Current.Value).Trim) 
      'Exit For 
     End If 
    End If 
Next 

我无法弄清楚如何让所有打开的标签,而不是唯一的名称作为它的第一码above.Any帮助下完成的网址,会更加有用..在此先感谢:-)

我曾尝试在后下的所有实例和方法,它似乎并没有产生正确的结果..

Stackoverflow post similar to this post

问候,

回答

1

你可以比较容易地得到地址框的值。沿着这些线的东西将工作:

Dim rootElement As AutomationElement = AutomationElement.FromHandle(hwnd) 

Dim addressCondition As Condition = New PropertyCondition(AutomationElement.NameProperty, "Address and search bar") 
Dim addressBar = rootElement.FindFirst(TreeScope.Descendants, addressCondition) 
Debug.WriteLine(addressBar.GetCurrentPattern(ValuePattern.Pattern).Current.Value) 

这会给你当前选定的选项卡的网址。注意:所有选项卡只有一个地址框 - 当用户选择每个选项卡(即每个选项卡没有单独的地址框)时,框中的值会更改。

您可以选择每个选项卡,然后从地址框中取值。像这样的东西应该工作:

Dim tabItemCondition As Condition = New PropertyCondition(AutomationElement.ControlTypeProperty, ControlType.TabItem) 
For Each tabItem As AutomationElement In elemTabStrip.FindAll(TreeScope.Children, tabItemCondition) 

    Dim selectionItemPattern As SelectionItemPattern = tabItem.GetCurrentPattern(SelectionItemPattern.Pattern) 
    selectionItemPattern.Select() 

    ... (Grab the address box value here) 

Next 

非常快尝尝这在Chrome 55并没有为我工作,并扔了SelectionItem模式甚至不支持一个错误,虽然显示为可使用Inspect.exe它。这里似乎有个相关的问题:Control pattern availability is set to true but returns `Unsupported pattern.` exception

您还可以使用SendKeys来移动标签。添加下面的声明在你的代码的开始:

Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As IntPtr) As Boolean 

然后你FindChromeTabsURL()看起来是这样的:

Private Sub FindChromeTabsURL(ByVal hwnd As IntPtr) 
    Dim rootElement As AutomationElement = AutomationElement.FromHandle(hwnd) 
    Dim condNewTab As Condition = New PropertyCondition(AutomationElement.NameProperty, "New Tab") 
    Dim elemNewTab As AutomationElement = rootElement.FindFirst(TreeScope.Descendants, condNewTab) 
    If elemNewTab = Nothing Then Exit Sub 

    '//Get the tabstrip by getting the parent of the 'new tab' button 
    Dim tWalker As TreeWalker = TreeWalker.ControlViewWalker 
    Dim elemTabStrip As AutomationElement = tWalker.GetParent(elemNewTab) 

    SetForegroundWindow(hwnd) 
    Dim addressCondition As Condition = New PropertyCondition(AutomationElement.NameProperty, "Address and search bar") 
    Dim addressBar = rootElement.FindFirst(TreeScope.Descendants, addressCondition) 

    Dim tabItemCondition As Condition = New PropertyCondition(AutomationElement.ControlTypeProperty, ControlType.TabItem) 
    For Each tabItem As AutomationElement In elemTabStrip.FindAll(TreeScope.Children, tabItemCondition) 
     SendKeys.Send("^{TAB}") 
     Debug.WriteLine(addressBar.GetCurrentPattern(ValuePattern.Pattern).Current.Value) 
    Next 

End Sub 
+0

我无法运行的第二部分。我收到错误“Error 'elemTabStrip'没有声明,由于它的保护级别,它可能无法访问。”我明白这个声明是需要的,但是无法弄清楚如何定义。 – Kumsen

+0

我使用了与'FindChromeTabsURL'函数相同的代码。它定义了elemTabStrip(其中包含每个选项卡) – theduck

+0

另请参阅编辑其他可能的方法。 – theduck