枚举所有打开的标签中的Chrome URL vb.net
问题描述:
我想枚举并获取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帮助下完成的网址,会更加有用..在此先感谢:-)
我曾尝试在后下的所有实例和方法,它似乎并没有产生正确的结果..
问候,
森
答
你可以比较容易地得到地址框的值。沿着这些线的东西将工作:
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
我无法运行的第二部分。我收到错误“Error 'elemTabStrip'没有声明,由于它的保护级别,它可能无法访问。”我明白这个声明是需要的,但是无法弄清楚如何定义。 – Kumsen
我使用了与'FindChromeTabsURL'函数相同的代码。它定义了elemTabStrip(其中包含每个选项卡) – theduck
另请参阅编辑其他可能的方法。 – theduck