File: Microsoft\VisualBasic\Interaction.vb
Web Access
Project: src\src\Microsoft.VisualBasic.Forms\src\Microsoft.VisualBasic.Forms.vbproj (Microsoft.VisualBasic.Forms)
' Licensed to the .NET Foundation under one or more agreements.
' The .NET Foundation licenses this file to you under the MIT license.
 
Imports System.Runtime.InteropServices
Imports System.Security
Imports System.Text
Imports System.Threading
Imports System.Windows.Forms
Imports Microsoft.VisualBasic.CompilerServices
 
Imports NativeMethods = Microsoft.VisualBasic.CompilerServices.NativeMethods
Imports VbUtils = Microsoft.VisualBasic.CompilerServices.ExceptionUtils
 
Namespace Microsoft.VisualBasic
 
    ' Helper methods invoked through reflection from Microsoft.VisualBasic.Interaction in Microsoft.VisualBasic.Core.dll.
    ' Do not change this API without also updating that dependent module.
    Friend Module _Interaction
 
        Private Sub AppActivateHelper(hwndApp As IntPtr, processId As String)
            '  if no window with name (full or truncated) or task id, return an error
            '  if the window is not enabled or not visible, get the first window owned by it that is not enabled or not visible
            Dim hwndOwned As IntPtr
            If Not SafeNativeMethods.IsWindowEnabled(hwndApp) OrElse Not SafeNativeMethods.IsWindowVisible(hwndApp) Then
                '  scan to the next window until failure
                hwndOwned = NativeMethods.GetWindow(hwndApp, NativeTypes.GW_HWNDFIRST)
                Do While IntPtr.op_Inequality(hwndOwned, IntPtr.Zero)
                    If IntPtr.op_Equality(NativeMethods.GetWindow(hwndOwned, NativeTypes.GW_OWNER), hwndApp) Then
                        If Not SafeNativeMethods.IsWindowEnabled(hwndOwned) OrElse Not SafeNativeMethods.IsWindowVisible(hwndOwned) Then
                            hwndApp = hwndOwned
                            hwndOwned = NativeMethods.GetWindow(hwndApp, NativeTypes.GW_HWNDFIRST)
                        Else
                            Exit Do
                        End If
                    End If
                    hwndOwned = NativeMethods.GetWindow(hwndOwned, NativeTypes.GW_HWNDNEXT)
                Loop
 
                '  if scan failed, return an error
                If IntPtr.op_Equality(hwndOwned, IntPtr.Zero) Then
                    Throw New ArgumentException(Utils.GetResourceString(SR.ProcessNotFound, processId))
                End If
 
                '  set active window to the owned one
                hwndApp = hwndOwned
            End If
 
            ' SetActiveWindow on Win32 only activates the Window - it does
            ' not bring to to the foreground unless the window belongs to
            ' the current thread. NativeMethods.SetForegroundWindow() activates the
            ' window, moves it to the foreground, and bumps the priority
            ' of the thread which owns the window.
 
            Dim dwDummy As Integer ' dummy arg for SafeNativeMethods.GetWindowThreadProcessId
 
            ' Attach ourselves to the window we want to set focus to
            NativeMethods.AttachThreadInput(0, SafeNativeMethods.GetWindowThreadProcessId(hwndApp, dwDummy), 1)
            ' Make it foreground and give it focus, this will occur
            ' synchronously because we are attached.
            NativeMethods.SetForegroundWindow(hwndApp)
            NativeMethods.SetFocus(hwndApp)
            ' Unattached ourselves from the window
            NativeMethods.AttachThreadInput(0, SafeNativeMethods.GetWindowThreadProcessId(hwndApp, dwDummy), 0)
        End Sub
 
        Private Function GetTitleFromAssembly(callingAssembly As Reflection.Assembly) As String
 
            Dim title As String
 
            'Get the Assembly name of the calling assembly
            'Assembly.GetName requires PathDiscovery permission so we try this first
            'and if it throws we catch the security exception and parse the name
            'from the full assembly name
            Try
                title = callingAssembly.GetName().Name
            Catch ex As SecurityException
                Dim fullName As String = callingAssembly.FullName
 
                'Find the text up to the first comma. Note, this fails if the assembly has
                'a comma in its name
                Dim firstCommaLocation As Integer = fullName.IndexOf(","c)
                If firstCommaLocation >= 0 Then
                    title = fullName.Substring(0, firstCommaLocation)
                Else
                    'The name is not in the format we're expecting so return an empty string
                    title = String.Empty
                End If
            End Try
 
            Return title
 
        End Function
 
        Private Function InternalInputBox(prompt As String, title As String, defaultResponse As String, xPos As Integer, yPos As Integer, parentWindow As IWin32Window) As String
            Using box As New VBInputBox(prompt, title, defaultResponse, xPos, yPos)
                box.ShowDialog(parentWindow)
                InternalInputBox = box.Output
            End Using
        End Function
 
        Public Sub AppActivateByProcessId(ProcessId As Integer)
            'As an optimization, we will only check the UI permission once we actually know we found the app to activate - we'll do that in AppActivateHelper
 
            Dim processIdOwningWindow As Integer
            'Note, a process can have multiple windows. What we want to do is dig through to find one
            'that we can actually activate. So first ignore all the ones that are not visible and don't support mouse
            'or keyboard input
            Dim windowHandle As IntPtr = NativeMethods.GetWindow(NativeMethods.GetDesktopWindow(), NativeTypes.GW_CHILD)
 
            Do While IntPtr.op_Inequality(windowHandle, IntPtr.Zero)
                SafeNativeMethods.GetWindowThreadProcessId(windowHandle, processIdOwningWindow)
                If (processIdOwningWindow = ProcessId) AndAlso SafeNativeMethods.IsWindowEnabled(windowHandle) AndAlso SafeNativeMethods.IsWindowVisible(windowHandle) Then
                    Exit Do 'We found a window belonging to the desired process that we can actually activate and will support user input
                End If
 
                'keep rummaging through windows looking for one that belongs to the process we are after
                windowHandle = NativeMethods.GetWindow(windowHandle, NativeTypes.GW_HWNDNEXT)
            Loop
 
            'If we didn't find a window during the pass above, try the less desirable route of finding any window that belongs to the process
            If IntPtr.op_Equality(windowHandle, IntPtr.Zero) Then
                windowHandle = NativeMethods.GetWindow(NativeMethods.GetDesktopWindow(), NativeTypes.GW_CHILD)
 
                Do While IntPtr.op_Inequality(windowHandle, IntPtr.Zero)
                    SafeNativeMethods.GetWindowThreadProcessId(windowHandle, processIdOwningWindow)
                    If processIdOwningWindow = ProcessId Then
                        Exit Do
                    End If
 
                    'keep rummaging through windows looking for one that belongs to the process we are after
                    windowHandle = NativeMethods.GetWindow(windowHandle, NativeTypes.GW_HWNDNEXT)
                Loop
            End If
 
            If IntPtr.op_Equality(windowHandle, IntPtr.Zero) Then 'we never found a window belonging to the desired process
                Throw New ArgumentException(Utils.GetResourceString(SR.ProcessNotFound, CStr(ProcessId)))
            Else
                AppActivateHelper(windowHandle, CStr(ProcessId))
            End If
        End Sub
 
        Public Sub AppActivateByTitle(Title As String)
            'As an optimization, we will only check the UI permission once we actually know we found the app to activate - we'll do that in AppActivateHelper
            Dim windowHandle As IntPtr = NativeMethods.FindWindow(Nothing, Title) 'see if we can find the window using an exact match on the title
            Const MAX_TITLE_LENGTH As Integer = 511
 
            '  if no match, search through all parent windows
            If IntPtr.op_Equality(windowHandle, IntPtr.Zero) Then
                Dim appTitle As String
                ' Old implementation uses MAX_TITLE_LENGTH characters, INCLUDING NULL character.
                ' Interop code will extend string builder to handle NULL character.
                Dim appTitleBuilder As New StringBuilder(MAX_TITLE_LENGTH)
                Dim appTitleLength As Integer
                Dim titleLength As Integer = Len(Title)
 
                'Loop through all children of the desktop
                windowHandle = NativeMethods.GetWindow(NativeMethods.GetDesktopWindow(), NativeTypes.GW_CHILD)
                Do While IntPtr.op_Inequality(windowHandle, IntPtr.Zero)
                    '  get the window caption and test for a left-aligned substring
                    appTitleLength = NativeMethods.GetWindowText(windowHandle, appTitleBuilder, appTitleBuilder.Capacity)
                    appTitle = appTitleBuilder.ToString()
 
                    If appTitleLength >= titleLength Then
                        If String.Compare(appTitle, 0, Title, 0, titleLength, StringComparison.OrdinalIgnoreCase) = 0 Then
                            Exit Do 'found one
                        End If
                    End If
 
                    'keep looking
                    windowHandle = NativeMethods.GetWindow(windowHandle, NativeTypes.GW_HWNDNEXT)
                Loop
 
                If IntPtr.op_Equality(windowHandle, IntPtr.Zero) Then
                    ' We didn't find it so try right aligned
                    windowHandle = NativeMethods.GetWindow(NativeMethods.GetDesktopWindow(), NativeTypes.GW_CHILD)
 
                    Do While IntPtr.op_Inequality(windowHandle, IntPtr.Zero)
                        '  get the window caption and test for a right-aligned substring
                        appTitleLength = NativeMethods.GetWindowText(windowHandle, appTitleBuilder, appTitleBuilder.Capacity)
                        appTitle = appTitleBuilder.ToString()
 
                        If appTitleLength >= titleLength Then
                            If String.Compare(Right(appTitle, titleLength), 0, Title, 0, titleLength, StringComparison.OrdinalIgnoreCase) = 0 Then
                                Exit Do 'found a match
                            End If
                        End If
 
                        'keep looking
                        windowHandle = NativeMethods.GetWindow(windowHandle, NativeTypes.GW_HWNDNEXT)
                    Loop
                End If
            End If
 
            If IntPtr.op_Equality(windowHandle, IntPtr.Zero) Then 'no match
                Throw New ArgumentException(Utils.GetResourceString(SR.ProcessNotFound, Title))
            Else
                AppActivateHelper(windowHandle, Title)
            End If
        End Sub
 
        Public Function InputBox(Prompt As String, Title As String, DefaultResponse As String, XPos As Integer, YPos As Integer) As String
            Dim vbHost As IVbHost
            Dim parentWindow As IWin32Window = Nothing
 
            vbHost = HostServices.VBHost
            If vbHost IsNot Nothing Then 'If we are hosted then we want to use the host as the parent window. If no parent window that's fine.
                parentWindow = vbHost.GetParentWindow()
            End If
 
            If String.IsNullOrEmpty(Title) Then
                If vbHost Is Nothing Then
                    Title = GetTitleFromAssembly(Reflection.Assembly.GetCallingAssembly())
                Else
                    Title = vbHost.GetWindowTitle()
                End If
            End If
 
            'Threading state can only be set once, and will most often be already set
            'but set to STA and check if it isn't STA, then we need to start another thread
            'to display the InputBox
            If Thread.CurrentThread.GetApartmentState() <> ApartmentState.STA Then
                Dim inputHandler As New InputBoxHandler(Prompt, Title, DefaultResponse, XPos, YPos, parentWindow)
                Dim thread As New Thread(New ThreadStart(AddressOf inputHandler.StartHere))
                thread.Start()
                thread.Join()
 
                If inputHandler.Exception IsNot Nothing Then
                    Throw inputHandler.Exception
                End If
 
                Return inputHandler.Result
            Else
                Return InternalInputBox(Prompt, Title, DefaultResponse, XPos, YPos, parentWindow)
            End If
        End Function
 
        Public Function MsgBox(Prompt As Object, Buttons As MsgBoxStyle, Title As Object) As MsgBoxResult
            Dim sPrompt As String = Nothing
            Dim sTitle As String
            Dim vbHost As IVbHost
            Dim parentWindow As IWin32Window = Nothing
 
            vbHost = HostServices.VBHost
            If vbHost IsNot Nothing Then
                parentWindow = vbHost.GetParentWindow()
            End If
 
            'Only allow legal button combinations to be set, one choice from each group
            'These bit constants are defined in System.Windows.Forms.MessageBox
            'Low-order 4 bits (0x000f), legal values: 0, 1, 2, 3, 4, 5
            '     next 4 bits (0x00f0), legal values: 0, &H10, &H20, &H30, &H40
            '     next 4 bits (0x0f00), legal values: 0, &H100, &H200
            If ((Buttons And &HFI) > MsgBoxStyle.RetryCancel) OrElse ((Buttons And &HF0I) > MsgBoxStyle.Information) _
                OrElse ((Buttons And &HF00I) > MsgBoxStyle.DefaultButton3) Then
                Buttons = MsgBoxStyle.OkOnly
            End If
 
            Try
                If Prompt IsNot Nothing Then
                    sPrompt = DirectCast(Conversions.ChangeType(Prompt, GetType(String)), String)
                End If
            Catch ex As StackOverflowException
                Throw
            Catch ex As OutOfMemoryException
                Throw
            Catch ex As ThreadAbortException
                Throw
            Catch
                Throw New ArgumentException(Utils.GetResourceString(SR.Argument_InvalidValueType2, "Prompt", "String"))
            End Try
 
            Try
                If Title Is Nothing Then
                    If vbHost Is Nothing Then
                        sTitle = GetTitleFromAssembly(Reflection.Assembly.GetCallingAssembly())
                    Else
                        sTitle = vbHost.GetWindowTitle()
                    End If
                Else
                    sTitle = CStr(Title) 'allows the title to be an expression, e.g. MsgBox(prompt, Title:=1+5)
                End If
            Catch ex As StackOverflowException
                Throw
            Catch ex As OutOfMemoryException
                Throw
            Catch ex As ThreadAbortException
                Throw
            Catch
                Throw New ArgumentException(Utils.GetResourceString(SR.Argument_InvalidValueType2, "Title", "String"))
            End Try
 
            Return CType(MessageBox.Show(parentWindow, sPrompt, sTitle,
                 CType(Buttons And &HF, MessageBoxButtons),
                 CType(Buttons And &HF0, MessageBoxIcon),
                 CType(Buttons And &HF00, MessageBoxDefaultButton),
                 CType(Buttons And &HFFFFF000, MessageBoxOptions)),
                 MsgBoxResult)
        End Function
 
        Public Function Shell(PathName As String, Style As AppWinStyle, Wait As Boolean, Timeout As Integer) As Integer
            Dim startupInfo As New NativeTypes.STARTUPINFO
            Dim processInfo As New NativeTypes.PROCESS_INFORMATION
            Dim ok As Integer
            Dim safeProcessHandle As New NativeTypes.LateInitSafeHandleZeroOrMinusOneIsInvalid()
            Dim safeThreadHandle As New NativeTypes.LateInitSafeHandleZeroOrMinusOneIsInvalid()
            Dim errorCode As Integer = 0
 
            If PathName Is Nothing Then
                Throw New ArgumentNullException(Utils.GetResourceString(SR.Argument_InvalidNullValue1, "Pathname"))
            End If
 
            If Style < 0 OrElse Style > 9 Then
                Throw New ArgumentException(Utils.GetResourceString(SR.Argument_InvalidValue1, "Style"))
            End If
 
            NativeMethods.GetStartupInfo(startupInfo)
            Try
                startupInfo.dwFlags = NativeTypes.STARTF_USESHOWWINDOW  ' we want to specify the initial window style (minimized, etc) so set this bit.
                startupInfo.wShowWindow = Style
 
                'We have to have unmanaged permissions to do this, so asking for path permissions would be redundant
                'Note: We are using the StartupInfo (defined in NativeTypes.StartupInfo) in CreateProcess() even though this version
                'of the StartupInfo type uses IntPtr instead of String because GetStartupInfo() above requires that version so we don't
                'free the string fields since the API manages it instead. But its OK here because we are just passing along the memory
                'that GetStartupInfo() allocated along to CreateProcess() which just reads the string fields.
 
                ok = NativeMethods.CreateProcess(Nothing, PathName, Nothing, Nothing, False, NativeTypes.NORMAL_PRIORITY_CLASS, Nothing, Nothing, startupInfo, processInfo)
                If ok = 0 Then
                    errorCode = Marshal.GetLastWin32Error()
                End If
                If processInfo.hProcess <> IntPtr.Zero AndAlso processInfo.hProcess <> NativeTypes.s_invalidHandle Then
                    safeProcessHandle.InitialSetHandle(processInfo.hProcess)
                End If
                If processInfo.hThread <> IntPtr.Zero AndAlso processInfo.hThread <> NativeTypes.s_invalidHandle Then
                    safeThreadHandle.InitialSetHandle(processInfo.hThread)
                End If
 
                Try
                    If ok <> 0 Then
                        If Wait Then
                            ' Is infinite wait okay here ?
                            ' This is okay since this is marked as requiring the HostPermission with ExternalProcessMgmt rights
                            ok = NativeMethods.WaitForSingleObject(safeProcessHandle, Timeout)
 
                            If ok = 0 Then 'succeeded
                                'Process ran to completion
                                Shell = 0
                            Else
                                'Wait timed out
                                Shell = processInfo.dwProcessId
                            End If
                        Else
                            NativeMethods.WaitForInputIdle(safeProcessHandle, 10000)
                            Shell = processInfo.dwProcessId
                        End If
                    Else
                        'Check for a win32 error access denied. If it is, make and throw the exception.
                        'If not, throw FileNotFound
                        Const ERROR_ACCESS_DENIED As Integer = 5
                        If errorCode = ERROR_ACCESS_DENIED Then
                            Throw VbUtils.VbMakeException(VbErrors.PermissionDenied)
                        End If
 
                        Throw VbUtils.VbMakeException(VbErrors.FileNotFound)
                    End If
                Finally
                    safeProcessHandle.Close() ' Close the process handle will not cause the process to stop.
                    safeThreadHandle.Close()
                End Try
            Finally
                startupInfo.Dispose()
            End Try
        End Function
 
    End Module
End Namespace