interaction.vb

大名鼎鼎的mono是.NET平台的跨平台（支持linux

'
' Interaction.vb
'
' Author:
'   Mizrahi Rafael ([e-mail])
'   Guy Cohen ([e-mail])
'

'
' Copyright (C) 2002-2006 Mainsoft Corporation.
' Copyright (C) 2004-2006 Novell, Inc (http://www.novell.com)
'
' Permission is hereby granted, free of charge, to any person obtaining
' a copy of this software and associated documentation files (the
' "Software"), to deal in the Software without restriction, including
' without limitation the rights to use, copy, modify, merge, publish,
' distribute, sublicense, and/or sell copies of the Software, and to
' permit persons to whom the Software is furnished to do so, subject to
' the following conditions:
' 
' The above copyright notice and this permission notice shall be
' included in all copies or substantial portions of the Software.
' 
' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
' EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
' MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
' NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
' LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
' OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
' WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
'
Imports System
Imports Microsoft.VisualBasic.CompilerServices
#If TARGET_JVM = False Then 'Win32,Windows.Forms Not Supported by Grasshopper
Imports Microsoft.Win32
Imports System.Windows.Forms
Imports System.Drawing
#End If

Namespace Microsoft.VisualBasic
    Public Module Interaction

        Public Sub AppActivate(ByVal ProcessId As Integer)
            'TODO: OS Specific
            Throw New NotImplementedException
        End Sub
        Public Sub AppActivate(ByVal Title As String)
            'TODO: OS Specific
            Throw New NotImplementedException
        End Sub
        Public Sub Beep()
            'TODO: OS Specific
            ' Removed Throw exception, as it does not really harm that the beep does not work.
        End Sub

        <MonoLimitation("CallType.Let options is not supported.")> _
        Public Function CallByName(ByVal ObjectRef As Object, ByVal ProcName As String, ByVal UseCallType As Microsoft.VisualBasic.CallType, ByVal ParamArray Args() As Object) As Object
            Select Case UseCallType
                Case CallType.Get
                    Return LateBinding.LateGet(ObjectRef, ObjectRef.GetType(), ProcName, Args, Nothing, Nothing)
                Case CallType.Let
                    Throw New NotImplementedException("Microsoft.VisualBasic.Interaction.CallByName Case CallType.Let")
                Case CallType.Method
                    LateBinding.LateCall(ObjectRef, ObjectRef.GetType(), ProcName, Args, Nothing, Nothing)
                Case CallType.Set
                    LateBinding.LateSet(ObjectRef, ObjectRef.GetType(), ProcName, Args, Nothing)
            End Select
            Return Nothing
        End Function
        Public Function Choose(ByVal Index As Double, ByVal ParamArray Choice() As Object) As Object

            If (Choice.Rank <> 1) Then
                Throw New ArgumentException
            End If

            'FIXME: why Index is Double, while an Index of an Array is Integer ?
            Dim IntIndex As Integer
            IntIndex = Convert.ToInt32(Index)
            Dim ChoiceIndex As Integer = IntIndex - 1

            If ((IntIndex >= 0) And (ChoiceIndex <= Information.UBound(Choice))) Then
                Return Choice(ChoiceIndex)
            Else
                Return Nothing
            End If
        End Function
        Public Function Command() As String
            'TODO: OS Specific
            Return String.Join(" ", Environment.GetCommandLineArgs)
        End Function
        Public Function CreateObject(ByVal ProgId As String, Optional ByVal ServerName As String = "") As Object
            'TODO: COM
            Throw New NotImplementedException
        End Function
        Public Sub DeleteSetting(ByVal AppName As String, Optional ByVal Section As String = Nothing, Optional ByVal Key As String = Nothing)

#If TARGET_JVM = False Then

            Dim rkey As RegistryKey
            rkey = Registry.CurrentUser
            If Section = Nothing Then
                rkey.DeleteSubKeyTree(AppName)
            Else
                If Key = Nothing Then
                    rkey.DeleteSubKeyTree(Section)
                Else
                    rkey = rkey.OpenSubKey(Section)
                    rkey.DeleteValue(Key)
                End If
            End If

            'Closes the key and flushes it to disk if the contents have been modified.
            rkey.Close()
#Else
            Throw New NotImplementedException
#End If
        End Sub
        Public Function Environ(ByVal Expression As Integer) As String
            Throw New NotImplementedException
        End Function
        Public Function Environ(ByVal Expression As String) As String
            Return Environment.GetEnvironmentVariable(Expression)
        End Function

        <MonoLimitation("If this function is used the assembly have to be recompiled when you switch platforms.")> _
        Public Function GetAllSettings(ByVal AppName As String, ByVal Section As String) As String(,)

#If TARGET_JVM = False Then

            If (AppName = "") Or (AppName Is Nothing) Then Throw New System.ArgumentException(" Argument 'AppName' is Nothing or empty.")
            If (Section = "") Or (Section Is Nothing) Then Throw New System.ArgumentException(" Argument 'Section' is Nothing or empty.")

            Dim res_setting(,) As String
            Dim index, elm_count As Integer
            Dim regk As RegistryKey
            Dim arr_str() As String

            regk = Registry.CurrentUser
            Try
                ''TODO: original dll set/get settings from this path
                regk = regk.OpenSubKey("Software\VB and VBA Program Settings\" + AppName)
                regk = regk.OpenSubKey(Section)
            Catch ex As Exception
                Return Nothing
            End Try
            If (regk Is Nothing) Then
                Return Nothing
            Else
                elm_count = regk.ValueCount
                If elm_count = 0 Then Return Nothing
            End If

            ReDim Preserve arr_str(elm_count)
            ReDim Preserve res_setting(elm_count - 1, 1)
            arr_str = regk.GetValueNames()
            For index = 0 To elm_count - 1
                res_setting(index, 0) = arr_str(index)
                res_setting(index, 1) = Interaction.GetSetting(AppName, Section, arr_str(index))
            Next
            Return res_setting

#Else
            Throw New NotImplementedException
#End If
        End Function
        Public Function GetObject(Optional ByVal PathName As String = Nothing, Optional ByVal [Class] As String = Nothing) As Object
            'TODO: COM
            Throw New NotImplementedException
        End Function
        Public Function GetSetting(ByVal AppName As String, ByVal Section As String, ByVal Key As String, Optional ByVal [Default] As String = "") As String
#If TARGET_JVM = False Then
            Dim rkey As RegistryKey
            rkey = Registry.CurrentUser
            rkey = rkey.OpenSubKey("Software\VB and VBA Program Settings\" + AppName)
            rkey = rkey.OpenSubKey(Section)
            Return rkey.GetValue(Key, CObj([Default])).ToString
#Else
            Throw New NotImplementedException
#End If
        End Function
        Public Function IIf(ByVal Expression As Boolean, ByVal TruePart As Object, ByVal FalsePart As Object) As Object
            If Expression Then
                Return TruePart
            Else
                Return FalsePart
            End If
        End Function

#If TARGET_JVM = False Then
        Class InputForm
            Inherits Form
            Dim bok As Button
            Dim bcancel As Button
            Dim entry As TextBox
            Dim result As String

            Public Sub New(ByVal Prompt As String, Optional ByVal Title As String = "", Optional ByVal DefaultResponse As String = "", Optional ByVal XPos As Integer = -1, Optional ByVal YPos As Integer = -1)
                SuspendLayout()

                Text = Title
                ClientSize = New Size(400, 120)

                bok = New Button()
                bok.Text = "Ok"

                bcancel = New Button()
                bcancel.Text = "Cancel"

                entry = New TextBox()
                entry.Text = DefaultResponse
                result = DefaultResponse

                AddHandler bok.Click, AddressOf ok_Click