在所有打开的标签页vb.net中枚举Chrome网址

时间:2017-02-10 05:18:23

标签: vb.net google-chrome url enumerate

我正在尝试枚举并获取chrome中所有打开的标签页的网址。有了谷歌的大量帮助(嗯......实际上来自Stackoverflow :-))我可以设法使用下面的代码枚举并获取所有打开标签的“名称”。

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浏览器中获取所选“活动”标签的网址。

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

我无法弄清楚如何获取所有打开标签的网址而不仅仅是上面第一个代码所做的名称。任何帮助都会非常有用..提前感谢: - )

我已尝试过以下帖子中的所有示例和方法,但似乎没有产生正确的结果。

Stackoverflow post similar to this post

此致

1 个答案:

答案 0 :(得分: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