2017-02-10 132 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