Search code examples
vb.netgoogle-chromeurlui-automationfreeze

How to get URL of active tab in browser in VB.net


I'm in the process of coding an application to capture URL of active tab in Chrome browser. I went through some of codes and all those codes cause the GUI freeze and take a long time to get the URL. What I realy want is to get the URL of active tab. That's all .This is what I have used. Highly appreciate your help.

Imports System.Windows.Automation

Public Class Form1
    Private Const ChromeProcess As [String] = "chrome"
    Private Const AddressCtl As [String] = "Address and search bar"
Public Function GetChromeActiveWindowUrl() As [String]
    Dim procs = Process.GetProcessesByName(ChromeProcess)

    If (procs.Length = 0) Then
        Return [String].Empty
    End If

    Return procs _
.Where(Function(p) p.MainWindowHandle <> IntPtr.Zero) _
.Select(Function(s) GetUrlControl(s)) _
.Where(Function(p) p IsNot Nothing) _
.Select(Function(s) GetValuePattern(s)) _
.Where(Function(p) p.Item2.Length > 0) _
.Select(Function(s) GetValuePatternUrl(s)) _
.FirstOrDefault

End Function

Private Function GetUrlControl(
proses As Process) _
As AutomationElement

    Dim propCondition =
    New PropertyCondition(
    AutomationElement.NameProperty,
    AddressCtl)
    Return AutomationElement _
    .FromHandle(proses.MainWindowHandle) _
    .FindFirst(
        TreeScope.Descendants,
        propCondition)

End Function

Private Function GetValuePatternUrl(
element As Tuple(Of
AutomationElement, AutomationPattern())) As [String]

    Dim ap = element.Item2(0)
    Dim ovp = element.Item1.GetCurrentPattern(ap)
    Dim vp = CType(ovp, ValuePattern)

    Return vp.Current.Value
End Function



Private Function GetValuePattern(
element As AutomationElement) _

As Tuple(Of AutomationElement, AutomationPattern())

      Return New Tuple(Of
      AutomationElement,
      AutomationPattern())(
      element,
      element.GetSupportedPatterns())
End Function

Solution

  • Finally Found the answer to my Question,

    I have blocked the requests receiving from other applications and focused only on the chrome browser

    Dim hWnd As IntPtr = GetForegroundWindow()
    Dim ProcessID As UInt32 = Nothing
    GetWindowThreadProcessId(hWnd, ProcessID)
    Dim Proc As Process = Process.GetProcessById(ProcessID)
    str_application_category = Proc.MainModule.FileVersionInfo.ProductName
    
    If str_application_category = "Google Chrome" Then
    str_application_path = GetChromeActiveWindowUrl()
    End If
    
    Catch ex As Exception
    
    End Try