[VB]UIAutomation によるブラウザのリロード処理

Form1.vb

'Form に Button1, Button2 および ListView を貼って実行します
'
'下記のアセンブリを参照設定する必要があります
'   UIAutomationClient
'   UIAutomationType
'
'⚠ このコードを Visual Studio からデバッグ実行する場合には
'[デバッグ] - [ウィンドウ] - [例外設定] から
'　[Managed Debugging Assistants] - [NonComVisibleBaseClass]
'のチェックを Off にしておく必要があります
'
Option Strict On
Imports System.Windows.Automation

Public Class Form1
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Array.ForEach("Proc Secret IEMode PId hWnd Name".Split(), AddressOf ListView1.Columns.Add)
        ListView1.GridLines = True
        ListView1.View = View.Details
        ListView1.MultiSelect = False
        ListView1.FullRowSelect = True
        Button1.Text = "一覧更新"   'ListView にブラウザーを列挙する
        Button1.Enabled = True
        Button2.Text = "リロード"   '選択したブラウザーをリロードする
        Button2.Enabled = False
        RefreshBrowserList()
    End Sub

    Private Sub ListView1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ListView1.SelectedIndexChanged
        Button2.Enabled = ListView1.SelectedItems.Count > 0 AndAlso TypeOf ListView1.SelectedItems(0).Tag Is AutomationElement
    End Sub

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

    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        If ListView1.SelectedItems.Count > 0 Then
            ReloadButtonInvoke(TryCast(ListView1.SelectedItems(0).Tag, AutomationElement))
        End If
    End Sub

    Private Sub ReloadButtonInvoke(e As AutomationElement)
        'タブを分割・結合したり、ブラウザーが閉じられていた場合、InvokePattern を得られないことがあります
        '⚠ Visual Studio から実行する場合は、例外設定で NonComVisibleBaseClass を無効にしておかないと、以下の Pattern 取得時に MDA 例外で停止されることがあります
        Dim isAvailable = e?.GetCurrentPropertyValue(AutomationElement.IsInvokePatternAvailableProperty, True)
        If isAvailable IsNot Nothing AndAlso isAvailable IsNot AutomationElement.NotSupported AndAlso CBool(isAvailable) Then
            TryCast(e.GetCurrentPattern(InvokePattern.Pattern), InvokePattern)?.Invoke()
        End If
    End Sub

    Private Sub RefreshBrowserList()
        Static browsers As New Dictionary(Of String, Condition) From {
            {"iexplore", New AndCondition(
                New PropertyCondition(AutomationElement.ControlTypeProperty, ControlType.Window),
                New PropertyCondition(AutomationElement.ClassNameProperty, "IEFrame")
            )},
            {"msedge", New AndCondition(
                New PropertyCondition(AutomationElement.ControlTypeProperty, ControlType.Window),
                New PropertyCondition(AutomationElement.ClassNameProperty, "Chrome_WidgetWin_1")
            )},
            {"chrome", New AndCondition(
                New PropertyCondition(AutomationElement.ControlTypeProperty, ControlType.Pane),
                New PropertyCondition(AutomationElement.ClassNameProperty, "Chrome_WidgetWin_1")
            )},
            {"firefox", New AndCondition(
                New PropertyCondition(AutomationElement.ControlTypeProperty, ControlType.Window),
                New PropertyCondition(AutomationElement.ClassNameProperty, "MozillaWindowClass")
            )}
        }
        Button2.Enabled = False
        ListView1.BeginUpdate()
        ListView1.Items.Clear()

        Dim eBrowsers = AutomationElement.RootElement.FindAll(TreeScope.Children, New OrCondition(browsers.Values.ToArray()))
        For Each eBrowser As AutomationElement In eBrowsers
            Dim pid = eBrowser.Current.ProcessId
            Dim procName = Process.GetProcessById(pid).ProcessName
            Dim isBrowser = browsers.Keys.Any(AddressOf procName.Equals)
            Dim lvi As New ListViewItem(procName)
            lvi.SubItems.Add(If(isBrowser, "No", "")).Name = "Secret"
            lvi.SubItems.Add("").Name = "IEMode"
            Dim eRefreshButton As AutomationElement = Nothing
            Select Case procName
                Case "iexplore"
                    Dim eReBarWindow32 = eBrowser.FindFirst(TreeScope.Descendants, New PropertyCondition(AutomationElement.ClassNameProperty, "ReBarWindow32"))
                    Dim eAddressBand = eReBarWindow32?.FindFirst(TreeScope.Children, New AndCondition(New PropertyCondition(AutomationElement.ControlTypeProperty, ControlType.Pane), New PropertyCondition(AutomationElement.ClassNameProperty, "Address Band Root")))
                    '⚠例外設定で NonComVisibleBaseClass を無効にしておかなかった場合、以下の Name 検索時に MDA 例外で停止されます
                    Dim ePageToolbar = eAddressBand?.FindFirst(TreeScope.Children, New AndCondition(New PropertyCondition(AutomationElement.ControlTypeProperty, ControlType.ToolBar), New PropertyCondition(AutomationElement.NameProperty, "ページ コントロール")))
                    eRefreshButton = ePageToolbar?.FindFirst(TreeScope.Children, New AndCondition(New PropertyCondition(AutomationElement.ControlTypeProperty, ControlType.Button), New PropertyCondition(AutomationElement.NameProperty, "更新", DirectCast(2, PropertyConditionFlags))))
                    If eBrowser.Current.Name.EndsWith("- Internet Explorer - [InPrivate]") Then
                        lvi.SubItems("Secret").Text = "Yes"
                    End If
                Case "msedge"
                    Dim eWidget2 = eBrowser.FindFirst(TreeScope.Children, New PropertyCondition(AutomationElement.ClassNameProperty, "Chrome_WidgetWin_2"))
                    Dim eIEFrame = eWidget2?.FindFirst(TreeScope.Children, New PropertyCondition(AutomationElement.ClassNameProperty, "IEFrame"))
                    lvi.SubItems("IEMode").Text = If(eIEFrame IsNot Nothing, "Yes", "No")
                    Dim eBrowserRootView = eBrowser.FindFirst(TreeScope.Children, New PropertyCondition(AutomationElement.ClassNameProperty, "BrowserRootView"))
                    Dim eNonClientView = eBrowserRootView?.FindFirst(TreeScope.Children, New PropertyCondition(AutomationElement.ClassNameProperty, "NonClientView"))
                    Dim eGlassBrowserFrameView = eNonClientView?.FindFirst(TreeScope.Children, New PropertyCondition(AutomationElement.ClassNameProperty, "GlassBrowserFrameView"))
                    Dim eBrowserView = eGlassBrowserFrameView?.FindFirst(TreeScope.Children, New PropertyCondition(AutomationElement.ClassNameProperty, "BrowserView"))
                    Dim eTopContainerView = eBrowserView?.FindFirst(TreeScope.Children, New PropertyCondition(AutomationElement.ClassNameProperty, "TopContainerView"))
                    Dim eToolbarView = eTopContainerView?.FindFirst(TreeScope.Children, New PropertyCondition(AutomationElement.ClassNameProperty, "ToolbarView"))
                    eRefreshButton = eToolbarView?.FindFirst(TreeScope.Children, New PropertyCondition(AutomationElement.ClassNameProperty, "ReloadButton"))
                    If eBrowser.Current.Name.EndsWith("- [InPrivate] - Microsoft" & ChrW(&H200B) & " Edge") Then
                        lvi.SubItems("Secret").Text = "Yes"
                    End If
                Case "chrome"
                    Dim eClientPane = eBrowser.FindFirst(TreeScope.Children, New AndCondition(New PropertyCondition(AutomationElement.ControlTypeProperty, ControlType.Pane), New NotCondition(New OrCondition(New PropertyCondition(AutomationElement.ClassNameProperty, "Chrome_WidgetWin_1"), New PropertyCondition(AutomationElement.ClassNameProperty, "Intermediate D3D Window")))))
                    Dim eContentsPane = eClientPane?.FindFirst(TreeScope.Children, New PropertyCondition(AutomationElement.ControlTypeProperty, ControlType.Pane))
                    Dim eBrowserView = eContentsPane?.FindAll(TreeScope.Children, New PropertyCondition(AutomationElement.ControlTypeProperty, ControlType.Pane))(1)
                    Dim eTopContainerView = eBrowserView?.FindFirst(TreeScope.Children, New PropertyCondition(AutomationElement.ControlTypeProperty, ControlType.Pane))
                    Dim eToolbar = eTopContainerView?.FindFirst(TreeScope.Children, New PropertyCondition(AutomationElement.ControlTypeProperty, ControlType.ToolBar))
                    eRefreshButton = eToolbar?.FindFirst(TreeScope.Children, New PropertyCondition(AutomationElement.NameProperty, "再読み込み"))
                    If eBrowser.Current.Name.EndsWith("- Google Chrome（シークレット モード）") Then
                        lvi.SubItems("Secret").Text = "Yes"
                    End If
                Case "firefox"
                    Dim eNavBar = eBrowser.FindFirst(TreeScope.Children, New AndCondition(New PropertyCondition(AutomationElement.ControlTypeProperty, ControlType.ToolBar), New PropertyCondition(AutomationElement.NameProperty, "ナビゲーション")))
                    eRefreshButton = eNavBar?.FindFirst(TreeScope.Children, New AndCondition(New PropertyCondition(AutomationElement.ControlTypeProperty, ControlType.Button), New PropertyCondition(AutomationElement.NameProperty, "更新")))
                    If eBrowser.Current.Name.EndsWith(ChrW(&H2014) & " Mozilla " & ChrW(&H2014) & " Mozilla Firefox プライベートブラウジング") Then
                        lvi.SubItems("Secret").Text = "Yes"
                    End If
                Case Else
                    '上記 3 種以外のプロセス(Visual Studio Code など)を列挙したくない場合はここで Continue For します
                    '
                    'Continue For
            End Select
            lvi.SubItems.Add(CStr(pid)).Name = "PId"
            Dim nativeHandleNoDefault As Object = eBrowser.GetCurrentPropertyValue(AutomationElement.NativeWindowHandleProperty, True)
            lvi.SubItems.Add(If(nativeHandleNoDefault Is AutomationElement.NotSupported, "", $"0x{nativeHandleNoDefault:X}")).Name = "hWnd"
            lvi.SubItems.Add(eBrowser.Current.Name).Name = "Name"
            lvi.Tag = eRefreshButton
            ListView1.Items.Add(lvi)
        Next
        ListView1.AutoResizeColumns(ColumnHeaderAutoResizeStyle.ColumnContent)
        ListView1.EndUpdate()
    End Sub
End Class