├── .editorconfig ├── .github └── FUNDING.yml ├── .gitignore ├── Community.VisualBasic.Tests ├── AssemblyAttributes.vb ├── ByteTypeTests.vb ├── CharTypeTests.vb ├── CollectionsTests.vb ├── Community.VisualBasic.Tests.vbproj ├── Community │ └── VisualBasic │ │ ├── ComClassAttributeTests.vb │ │ ├── CompilerServices │ │ ├── DesignerGeneratedAttributeTests.vb │ │ ├── OptionCompareAttributeTests.vb │ │ ├── OptionTextAttributeTests.vb │ │ ├── StandardModuleAttributeTests.vb │ │ └── StructUtilsTests.vb │ │ ├── FileIO │ │ ├── FileSystemTests.vb │ │ ├── SpecialDirectoriesTests.vb │ │ └── TextFieldParserTests.vb │ │ ├── HideModuleNameAttributeTests.vb │ │ ├── MyGroupCollectionAttributeTests.vb │ │ ├── VBFixedArrayAttributeTests.vb │ │ └── VBFixedStringAttributeTests.vb ├── CompilerServices │ ├── BooleanTypeTests.vb │ ├── DecimalTypeTests.vb │ ├── DoubleTypeTests.vb │ └── VersionedTests.vb ├── ConversionTests.vb ├── ConversionsTests.vb ├── DateAndTimeTests.vb ├── DateTypeTests.vb ├── ErrObjectTests.vb ├── FileSystemTests.vb ├── FinancialTests.vb ├── IConvertableWrapper.vb ├── InformationTests.vb ├── IntegerTypeTests.vb ├── InteractionTests.vb ├── Interop │ └── Unix │ │ └── Interop.vb ├── LateBindingTests.vb ├── LikeOperatorTests.vb ├── LongTypeTests.vb ├── NewLateBindingTests.vb ├── ObjectTypeTests.vb ├── OperatorsTests.Comparison.vb ├── OperatorsTests.vb ├── ProjectDataTests.vb ├── ShortTypeTests.vb ├── SingleTypeTests.vb ├── StringTypeTests.vb ├── StringsTests.vb ├── TestUtilities │ └── System │ │ ├── AdminHelpers.vb │ │ ├── AssertExtensions.vb │ │ ├── IO │ │ ├── FileCleanupTestBase.vb │ │ └── StreamExtensions.vb │ │ ├── PlatformDetection.Unix.vb │ │ ├── PlatformDetection.vb │ │ ├── PletformDetection.Windows.vb │ │ └── ThreadCultureChange.vb ├── UtilsTests.vb └── VBMathTests.vb ├── Community.VisualBasic.sln ├── Community.VisualBasic ├── ApplicationServices │ ├── ApplicationBase.vb │ ├── AssemblyInfo.vb │ ├── ConsoleApplicationBase.vb │ └── User.vb ├── Collection.vb ├── ComClassAttribute.vb ├── Community.VisualBasic.vbproj ├── CompilerServices │ ├── BooleanType.vb │ ├── ByteType.vb │ ├── CacheDict.vb │ ├── CharArrayType.vb │ ├── CharType.vb │ ├── ConversionResolution.vb │ ├── Conversions.vb │ ├── DateType.vb │ ├── DecimalType.vb │ ├── DoubleType.vb │ ├── ExceptionUtils.vb │ ├── IDOBinder.vb │ ├── IOUtils.vb │ ├── IntegerType.vb │ ├── LateBinding.vb │ ├── LongType.vb │ ├── NewLateBinding.vb │ ├── ObjectType.vb │ ├── Operators.Resolution.vb │ ├── Operators.vb │ ├── OverloadResolution.vb │ ├── ProjectData.vb │ ├── ShortType.vb │ ├── SingleType.vb │ ├── StringType.vb │ ├── StructUtils.vb │ ├── Symbols.vb │ ├── Utils.LateBinder.vb │ ├── Utils.vb │ ├── VB6BinaryFile.vb │ ├── VB6File.vb │ ├── VB6InputFile.vb │ ├── VB6OutputFile.vb │ ├── VB6RandomFile.vb │ ├── VBBinder.vb │ └── Versioned.vb ├── Constants.vb ├── ControlChars.vb ├── Conversion.vb ├── DateAndTime.vb ├── Devices │ └── Computer │ │ ├── Audio.vb │ │ ├── Clock.vb │ │ ├── Computer.vb │ │ ├── ComputerInfo.vb │ │ ├── Keyboard.vb │ │ ├── Mouse.vb │ │ ├── Network.vb │ │ └── ServerComputer.vb ├── ErrObject.vb ├── Extension.vb ├── FileIO │ ├── FileSystem.vb │ ├── MalformedLineException.vb │ ├── SpecialDirectories.vb │ └── TextFieldParser.vb ├── FileSystem.vb ├── Financial.vb ├── Globals.vb ├── Helpers │ ├── FileSystemUtils.vb │ ├── ForEachEnum.vb │ ├── NativeMethods.vb │ ├── NativeTypes.vb │ ├── SafeNativeMethods.vb │ └── UnsafeNativeMethods.vb ├── Information.vb ├── Interaction.vb ├── Logging │ ├── FileLogTraceListener.vb │ └── Log.vb ├── My Project │ ├── Resources.Designer.vb │ └── Resources.resx ├── MyGroupCollectionAttribute.vb ├── MyServices │ ├── ClipBoardProxy.vb │ ├── FileSystemProxy.vb │ ├── Internal │ │ ├── ContextValue.vb │ │ ├── ProgressDialog.vb │ │ └── WebClientCopy.vb │ └── SpecialDirectoriesProxy.vb ├── OperatingSystemEx.vb ├── Resources │ └── SR.vb ├── Strings.vb ├── VBFixedArrayAttribute.vb ├── VBFixedStringAttribute.vb ├── VBMath.vb └── _Stub.vb ├── LICENSE ├── ProjectTypeTests ├── net4-console │ ├── App.config │ ├── Module1.vb │ ├── My Project │ │ ├── Application.Designer.vb │ │ ├── Application.myapp │ │ ├── AssemblyInfo.vb │ │ ├── Resources.Designer.vb │ │ ├── Resources.resx │ │ ├── Settings.Designer.vb │ │ └── Settings.settings │ └── net4-console.vbproj ├── net5-console │ ├── My Project │ │ └── launchSettings.json │ ├── My.vb │ ├── Program.vb │ └── net5-console.vbproj ├── net5-windows │ ├── ApplicationEvents.vb │ ├── Form1.Designer.vb │ ├── Form1.resx │ ├── Form1.vb │ ├── My Project │ │ ├── Application.Designer.HighDpi.vb │ │ ├── Application.Designer.vb │ │ └── Application.myapp │ └── net5-windows.vbproj └── netstandard2_0 │ ├── Class1.Late.vb │ ├── Class1.vb │ ├── My.vb │ ├── OperatingSystemEx.vb │ └── netstandard2_0.vbproj └── README.md /.editorconfig: -------------------------------------------------------------------------------- 1 | # Remove the line below if you want to inherit .editorconfig settings from higher directories 2 | root = true 3 | 4 | # Visual Basic files 5 | [*.vb] 6 | 7 | #### Core EditorConfig Options #### 8 | 9 | # Indentation and spacing 10 | indent_size = 2 11 | indent_style = space 12 | tab_width = 2 13 | 14 | # New line preferences 15 | end_of_line = crlf 16 | insert_final_newline = false 17 | 18 | #### .NET Coding Conventions #### 19 | 20 | # Organize usings 21 | dotnet_separate_import_directive_groups = false 22 | dotnet_sort_system_directives_first = true 23 | file_header_template = unset 24 | 25 | # this. and Me. preferences 26 | dotnet_style_qualification_for_event = false:suggestion 27 | dotnet_style_qualification_for_field = false:silent 28 | dotnet_style_qualification_for_method = false:suggestion 29 | dotnet_style_qualification_for_property = false:suggestion 30 | 31 | # Language keywords vs BCL types preferences 32 | dotnet_style_predefined_type_for_locals_parameters_members = true:silent 33 | dotnet_style_predefined_type_for_member_access = true:silent 34 | 35 | # Parentheses preferences 36 | dotnet_style_parentheses_in_arithmetic_binary_operators = always_for_clarity:silent 37 | dotnet_style_parentheses_in_other_binary_operators = always_for_clarity:silent 38 | dotnet_style_parentheses_in_other_operators = never_if_unnecessary:silent 39 | dotnet_style_parentheses_in_relational_binary_operators = always_for_clarity:silent 40 | 41 | # Modifier preferences 42 | dotnet_style_require_accessibility_modifiers = for_non_interface_members:silent 43 | 44 | # Expression-level preferences 45 | dotnet_style_coalesce_expression = true:suggestion 46 | dotnet_style_collection_initializer = true:suggestion 47 | dotnet_style_explicit_tuple_names = true:suggestion 48 | dotnet_style_null_propagation = true:suggestion 49 | dotnet_style_object_initializer = true:suggestion 50 | dotnet_style_operator_placement_when_wrapping = beginning_of_line 51 | dotnet_style_prefer_auto_properties = true:silent 52 | dotnet_style_prefer_compound_assignment = true:suggestion 53 | dotnet_style_prefer_conditional_expression_over_assignment = true:silent 54 | dotnet_style_prefer_conditional_expression_over_return = true:silent 55 | dotnet_style_prefer_inferred_anonymous_type_member_names = true:suggestion 56 | dotnet_style_prefer_inferred_tuple_names = true:suggestion 57 | dotnet_style_prefer_is_null_check_over_reference_equality_method = true:suggestion 58 | dotnet_style_prefer_simplified_boolean_expressions = true:suggestion 59 | dotnet_style_prefer_simplified_interpolation = true:suggestion 60 | 61 | # Field preferences 62 | dotnet_style_readonly_field = true:suggestion 63 | 64 | # Parameter preferences 65 | dotnet_code_quality_unused_parameters = all:suggestion 66 | 67 | # Suppression preferences 68 | dotnet_remove_unnecessary_suppression_exclusions = none 69 | 70 | #### VB Coding Conventions #### 71 | 72 | # Modifier preferences 73 | visual_basic_preferred_modifier_order = partial,default,private,protected,public,friend,notoverridable,overridable,mustoverride,overloads,overrides,mustinherit,notinheritable,static,shared,shadows,readonly,writeonly,dim,const,withevents,widening,narrowing,custom,async,iterator:silent 74 | 75 | # Expression-level preferences 76 | visual_basic_style_prefer_isnot_expression = true:suggestion 77 | visual_basic_style_unused_value_assignment_preference = unused_local_variable:suggestion 78 | visual_basic_style_unused_value_expression_statement_preference = unused_local_variable:silent 79 | 80 | #### Naming styles #### 81 | 82 | # Naming rules 83 | 84 | dotnet_naming_rule.interface_should_be_begins_with_i.severity = suggestion 85 | dotnet_naming_rule.interface_should_be_begins_with_i.symbols = interface 86 | dotnet_naming_rule.interface_should_be_begins_with_i.style = begins_with_i 87 | 88 | dotnet_naming_rule.types_should_be_pascal_case.severity = suggestion 89 | dotnet_naming_rule.types_should_be_pascal_case.symbols = types 90 | dotnet_naming_rule.types_should_be_pascal_case.style = pascal_case 91 | 92 | dotnet_naming_rule.non_field_members_should_be_pascal_case.severity = suggestion 93 | dotnet_naming_rule.non_field_members_should_be_pascal_case.symbols = non_field_members 94 | dotnet_naming_rule.non_field_members_should_be_pascal_case.style = pascal_case 95 | 96 | # Symbol specifications 97 | 98 | dotnet_naming_symbols.interface.applicable_kinds = interface 99 | dotnet_naming_symbols.interface.applicable_accessibilities = public, friend, private, protected, protected_friend, private_protected 100 | dotnet_naming_symbols.interface.required_modifiers = 101 | 102 | dotnet_naming_symbols.types.applicable_kinds = class, struct, interface, enum 103 | dotnet_naming_symbols.types.applicable_accessibilities = public, friend, private, protected, protected_friend, private_protected 104 | dotnet_naming_symbols.types.required_modifiers = 105 | 106 | dotnet_naming_symbols.non_field_members.applicable_kinds = property, event, method 107 | dotnet_naming_symbols.non_field_members.applicable_accessibilities = public, friend, private, protected, protected_friend, private_protected 108 | dotnet_naming_symbols.non_field_members.required_modifiers = 109 | 110 | # Naming styles 111 | 112 | dotnet_naming_style.pascal_case.required_prefix = 113 | dotnet_naming_style.pascal_case.required_suffix = 114 | dotnet_naming_style.pascal_case.word_separator = 115 | dotnet_naming_style.pascal_case.capitalization = pascal_case 116 | 117 | dotnet_naming_style.begins_with_i.required_prefix = I 118 | dotnet_naming_style.begins_with_i.required_suffix = 119 | dotnet_naming_style.begins_with_i.word_separator = 120 | dotnet_naming_style.begins_with_i.capitalization = pascal_case 121 | -------------------------------------------------------------------------------- /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | 3 | github: dualbrain 4 | patreon: # Replace with a single Patreon username 5 | open_collective: # Replace with a single Open Collective username 6 | ko_fi: # Replace with a single Ko-fi username 7 | tidelift: # Replace with a single Tidelift platform-name/package-name e.g., npm/babel 8 | community_bridge: # Replace with a single Community Bridge project-name e.g., cloud-foundry 9 | liberapay: # Replace with a single Liberapay username 10 | issuehunt: # Replace with a single IssueHunt username 11 | otechie: # Replace with a single Otechie username 12 | lfx_crowdfunding: # Replace with a single LFX Crowdfunding project-name e.g., cloud-foundry 13 | custom: # Replace with up to 4 custom sponsorship URLs e.g., ['link1', 'link2'] 14 | -------------------------------------------------------------------------------- /Community.VisualBasic.Tests/AssemblyAttributes.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Option Compare Text 5 | Option Explicit On 6 | Option Infer Off 7 | Option Strict On 8 | 9 | Imports Xunit 10 | 11 | ' Tests that use ProjectData or AssemblyData rely on shared state 12 | ' and should not be run in parallel. 13 | 14 | -------------------------------------------------------------------------------- /Community.VisualBasic.Tests/Community.VisualBasic.Tests.vbproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | Community.VisualBasic.Tests 5 | net7.0 6 | 7 | false 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | runtime; build; native; contentfiles; analyzers; buildtransitive 17 | all 18 | 19 | 20 | runtime; build; native; contentfiles; analyzers; buildtransitive 21 | all 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | -------------------------------------------------------------------------------- /Community.VisualBasic.Tests/Community/VisualBasic/ComClassAttributeTests.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Option Compare Text 5 | Option Explicit On 6 | Option Infer Off 7 | Option Strict On 8 | 9 | Imports Xunit 10 | 11 | Namespace Global.Community.VisualBasic.Tests 12 | 13 | Public Class ComClassAttributeTests 14 | 15 | 16 | Public Sub Ctor_Default() 17 | Dim attribute As Community.VisualBasic.ComClassAttribute = New ComClassAttribute 18 | Assert.Null(attribute.ClassID) 19 | Assert.Null(attribute.InterfaceID) 20 | Assert.Null(attribute.EventID) 21 | Assert.[False](attribute.InterfaceShadows) 22 | End Sub 23 | 24 | 25 | 26 | 27 | 28 | Public Sub Ctor_String(classID1 As String) 29 | Dim attribute As Community.VisualBasic.ComClassAttribute = New ComClassAttribute(classID1) 30 | Assert.Equal(classID1, attribute.ClassID) 31 | Assert.Null(attribute.InterfaceID) 32 | Assert.Null(attribute.EventID) 33 | Assert.[False](attribute.InterfaceShadows) 34 | End Sub 35 | 36 | 37 | 38 | 39 | 40 | Public Sub Ctor_String_String(classID1 As String, interfaceID1 As String) 41 | Dim attribute As Community.VisualBasic.ComClassAttribute = New ComClassAttribute(classID1, interfaceID1) 42 | Assert.Equal(classID1, attribute.ClassID) 43 | Assert.Equal(interfaceID1, attribute.InterfaceID) 44 | Assert.Null(attribute.EventID) 45 | Assert.[False](attribute.InterfaceShadows) 46 | End Sub 47 | 48 | 49 | 50 | 51 | 52 | Public Sub Ctor_String_String_String(classID1 As String, interfaceID1 As String, eventID1 As String) 53 | Dim attribute As Community.VisualBasic.ComClassAttribute = New ComClassAttribute(classID1, interfaceID1, eventID1) 54 | Assert.Equal(classID1, attribute.ClassID) 55 | Assert.Equal(interfaceID1, attribute.InterfaceID) 56 | Assert.Equal(eventID1, attribute.EventID) 57 | Assert.[False](attribute.InterfaceShadows) 58 | End Sub 59 | 60 | 61 | 62 | 63 | Public Sub InterfaceShadows_Set_GetReturnsExpected(value As Boolean) 64 | Dim attribute As Community.VisualBasic.ComClassAttribute = New ComClassAttribute() With 65 | { 66 | .InterfaceShadows = value} 67 | Assert.Equal(value, attribute.InterfaceShadows) 68 | End Sub 69 | 70 | End Class 71 | 72 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic.Tests/Community/VisualBasic/CompilerServices/DesignerGeneratedAttributeTests.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Option Compare Text 5 | Option Explicit On 6 | Option Infer Off 7 | Option Strict On 8 | 9 | Imports Xunit 10 | 11 | Namespace Global.Community.VisualBasic.CompilerServices.Tests 12 | 13 | Public Class DesignerGeneratedAttributeTests 14 | 15 | 16 | Public Sub Ctor_Empty_Success() 17 | Dim tempVar As New Microsoft.VisualBasic.CompilerServices.DesignerGeneratedAttribute 18 | End Sub 19 | 20 | End Class 21 | 22 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic.Tests/Community/VisualBasic/CompilerServices/OptionCompareAttributeTests.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Option Compare Text 5 | Option Explicit On 6 | Option Infer Off 7 | Option Strict On 8 | 9 | Imports Xunit 10 | 11 | Namespace Global.Community.VisualBasic.CompilerServices.Tests 12 | 13 | Public Class OptionCompareAttributeTests 14 | 15 | 16 | Public Sub Ctor_Empty_Success() 17 | Dim tempVar As New Microsoft.VisualBasic.CompilerServices.OptionCompareAttribute 18 | End Sub 19 | 20 | End Class 21 | 22 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic.Tests/Community/VisualBasic/CompilerServices/OptionTextAttributeTests.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Option Compare Text 5 | Option Explicit On 6 | Option Infer Off 7 | Option Strict On 8 | 9 | Imports Xunit 10 | 11 | Namespace Global.Community.VisualBasic.CompilerServices.Tests 12 | 13 | Public Class OptionTextAttributeTests 14 | 15 | 16 | Public Sub Ctor_Empty_Success() 17 | Dim tempVar As New Microsoft.VisualBasic.CompilerServices.OptionTextAttribute 18 | End Sub 19 | 20 | End Class 21 | 22 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic.Tests/Community/VisualBasic/CompilerServices/StandardModuleAttributeTests.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Option Compare Text 5 | Option Explicit On 6 | Option Infer Off 7 | Option Strict On 8 | 9 | Imports Xunit 10 | 11 | Namespace Global.Community.VisualBasic.CompilerServices.Tests 12 | 13 | Public Class StandardModuleAttributeTests 14 | 15 | 16 | Public Sub Ctor_Empty_Success() 17 | Dim tempVar As New Microsoft.VisualBasic.CompilerServices.StandardModuleAttribute 18 | End Sub 19 | 20 | End Class 21 | 22 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic.Tests/Community/VisualBasic/CompilerServices/StructUtilsTests.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Option Compare Text 5 | Option Explicit On 6 | Option Infer Off 7 | Option Strict On 8 | 9 | Imports System.Collections.Generic 10 | Imports Xunit 11 | 12 | Namespace Global.Community.VisualBasic.CompilerServices.Tests 13 | 14 | Public Module StructUtilsTestData 15 | 16 | Public Function RecordsAndLength() As TheoryData(Of Object, Integer) 17 | Return New TheoryData(Of Object, Integer) From { 18 | {Nothing, 0}, 19 | {New Struct_Empty, 0}, 20 | {New Struct_T(Of Single), 4}, 21 | {New Struct_T(Of Double), 8}, 22 | {New Struct_T(Of Short), 2}, 23 | {New Struct_T(Of Integer), 4}, 24 | {New Struct_T(Of Byte), 1}, 25 | {New Struct_T(Of Long), 8}, 26 | {New Struct_T(Of DateTime), 8}, 27 | {New Struct_T(Of Boolean), 2}, 28 | {New Struct_T(Of Decimal), 16}, 29 | {New Struct_T(Of Char), 2}, 30 | {New Struct_T(Of String), 4}, 31 | {New Struct_ArrayT(Of Byte)(elementCount:=10), 4}, 32 | {New Struct_ArrayT(Of Integer)(elementCount:=10), 4}, 33 | {New Struct_FixedArrayT10(Of Byte), 10}, 34 | {New Struct_FixedArrayT10(Of Integer), 40}, 35 | {New Struct_FixedArrayT10x20(Of Byte), 200}, 36 | {New Struct_FixedArrayT10x20(Of Integer), 800}, 37 | {New Struct_FixedString10, 10}, 38 | {New Struct_PrivateInt, 0}, 39 | {New Struct_MultipleWithAlignment, 22}} 40 | End Function 41 | 42 | Public Structure Struct_Empty 43 | End Structure 44 | 45 | Public Structure Struct_T(Of T) 46 | Public x As T 47 | End Structure 48 | 49 | Public Structure Struct_ArrayT(Of T) 50 | 51 | Public Sub New(elementCount As Integer) 52 | x = New T(elementCount - 1) {} 53 | End Sub 54 | 55 | Public x As T() 56 | 57 | End Structure 58 | 59 | Public Structure Struct_FixedArrayT10(Of T) 60 | Public x As T() 61 | End Structure 62 | 63 | Public Structure Struct_FixedArrayT10x20(Of T) 64 | Public x As T() 65 | End Structure 66 | 67 | Public Structure Struct_FixedString10 68 | Public x As String 69 | End Structure 70 | 71 | Public Structure Struct_PrivateInt 72 | #Disable Warning IDE0051 ' Remove unused private members 73 | Private ReadOnly x As Integer 74 | #Enable Warning IDE0051 ' Remove unused private members 75 | End Structure 76 | 77 | Public Structure Struct_MultipleWithAlignment 78 | Public b As Byte 79 | Public c As Char 80 | Public s As String 81 | Public d As Decimal 82 | End Structure 83 | 84 | End Module 85 | 86 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic.Tests/Community/VisualBasic/FileIO/SpecialDirectoriesTests.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Option Compare Text 5 | Option Explicit On 6 | Option Infer Off 7 | Option Strict On 8 | 9 | Imports System.Environment 10 | Imports Xunit 11 | 12 | Namespace Global.Community.VisualBasic.FileIO.Tests 13 | 14 | Public NotInheritable Class SpecialDirectoriesTests 15 | 16 | Private Shared Sub CheckSpecialFolder(folder As SpecialFolder, getSpecialDirectory As Func(Of String)) 17 | Dim path As String = Environment.GetFolderPath(folder) 18 | If String.IsNullOrEmpty(path) Then 19 | Assert.Throws(Of IO.DirectoryNotFoundException)(getSpecialDirectory) 20 | Else 21 | Assert.Equal(TrimSeparators(path), TrimSeparators(getSpecialDirectory())) 22 | End If 23 | End Sub 24 | 25 | ' 26 | 27 | Public Shared Sub AllUsersApplicationDataFolderTest() 28 | Assert.Throws(Of IO.DirectoryNotFoundException)(Function() SpecialDirectories.AllUsersApplicationData) 29 | End Sub 30 | 31 | ' 32 | 33 | Public Shared Sub CurrentUserApplicationDataFolderTest() 34 | Assert.Throws(Of IO.DirectoryNotFoundException)(Function() SpecialDirectories.CurrentUserApplicationData) 35 | End Sub 36 | 37 | 38 | Public Shared Sub DesktopFolderTest() 39 | CheckSpecialFolder(SpecialFolder.Desktop, Function() SpecialDirectories.Desktop) 40 | End Sub 41 | 42 | 43 | Public Shared Sub MyDocumentsFolderTest() 44 | If PlatformDetection.IsWindowsNanoServer Then 45 | Assert.Throws(Of IO.DirectoryNotFoundException)(Function() SpecialDirectories.MyDocuments) 46 | Else 47 | CheckSpecialFolder(SpecialFolder.MyDocuments, Function() SpecialDirectories.MyDocuments) 48 | End If 49 | End Sub 50 | 51 | 52 | Public Shared Sub MyMusicFolderTest() 53 | CheckSpecialFolder(SpecialFolder.MyMusic, Function() SpecialDirectories.MyMusic) 54 | End Sub 55 | 56 | 57 | Public Shared Sub MyPicturesFolderTest() 58 | CheckSpecialFolder(SpecialFolder.MyPictures, Function() SpecialDirectories.MyPictures) 59 | End Sub 60 | 61 | 62 | Public Shared Sub ProgramFilesFolderTest() 63 | CheckSpecialFolder(SpecialFolder.ProgramFiles, Function() SpecialDirectories.ProgramFiles) 64 | End Sub 65 | 66 | 67 | Public Shared Sub ProgramsFolderTest() 68 | CheckSpecialFolder(SpecialFolder.Programs, Function() SpecialDirectories.Programs) 69 | End Sub 70 | 71 | 72 | Public Shared Sub TempFolderTest() 73 | ' On Nano Server >=1809 the temp path's case is changed during the normalization. 74 | Assert.Equal(TrimSeparators(IO.Path.GetTempPath()), TrimSeparators(SpecialDirectories.Temp), ignoreCase:=PlatformDetection.IsWindowsNanoServer) 75 | End Sub 76 | 77 | Private Shared Function TrimSeparators(s As String) As String 78 | Return s.TrimEnd(System.IO.Path.DirectorySeparatorChar, System.IO.Path.AltDirectorySeparatorChar) 79 | End Function 80 | 81 | End Class 82 | 83 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic.Tests/Community/VisualBasic/HideModuleNameAttributeTests.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Option Compare Text 5 | Option Explicit On 6 | Option Infer Off 7 | Option Strict On 8 | 9 | Imports Xunit 10 | 11 | Namespace Global.Community.VisualBasic.Tests 12 | 13 | Public Class HideModuleNameAttributeTests 14 | 15 | 16 | Public Sub Ctor_Empty_Success() 17 | Dim tempVar As New HideModuleNameAttribute 18 | End Sub 19 | 20 | End Class 21 | 22 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic.Tests/Community/VisualBasic/MyGroupCollectionAttributeTests.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Option Compare Text 5 | Option Explicit On 6 | Option Infer Off 7 | Option Strict On 8 | 9 | Imports Xunit 10 | 11 | Namespace Global.Community.VisualBasic.Tests 12 | 13 | Public Class MyGroupCollectionAttributeTests 14 | 15 | 16 | 17 | 18 | Public Sub Ctor_String_String_String(typeToCollect As String, createInstanceMethodName As String, disposeInstanceMethodName As String, defaultInstanceAlias As String) 19 | Dim attribute As Community.VisualBasic.MyGroupCollectionAttribute = New MyGroupCollectionAttribute(typeToCollect, createInstanceMethodName, disposeInstanceMethodName, defaultInstanceAlias) 20 | Assert.Equal(typeToCollect, attribute.MyGroupName) 21 | Assert.Equal(createInstanceMethodName, attribute.CreateMethod) 22 | Assert.Equal(disposeInstanceMethodName, attribute.DisposeMethod) 23 | Assert.Equal(defaultInstanceAlias, attribute.DefaultInstanceAlias) 24 | End Sub 25 | 26 | End Class 27 | 28 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic.Tests/Community/VisualBasic/VBFixedArrayAttributeTests.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Option Compare Text 5 | Option Explicit On 6 | Option Infer Off 7 | Option Strict On 8 | 9 | Imports Xunit 10 | 11 | Namespace Global.Community.VisualBasic.Tests 12 | 13 | Public Class VBFixedArrayAttributeTests 14 | 15 | 16 | 17 | 18 | Public Sub Ctor_Int(upperBound As Integer, expectedLength As Integer) 19 | Dim attribute As Community.VisualBasic.VBFixedArrayAttribute = New VBFixedArrayAttribute(upperBound) 20 | Assert.Equal(New Integer() {upperBound}, attribute.Bounds) 21 | Assert.Equal(expectedLength, attribute.Length) 22 | End Sub 23 | 24 | 25 | 26 | 27 | 28 | 29 | Public Sub Ctor_Int_Int(upperBound1 As Integer, upperBound2 As Integer, expectedLength As Integer) 30 | Dim attribute As Community.VisualBasic.VBFixedArrayAttribute = New VBFixedArrayAttribute(upperBound1, upperBound2) 31 | Assert.Equal(New Integer() {upperBound1, upperBound2}, attribute.Bounds) 32 | Assert.Equal(expectedLength, attribute.Length) 33 | End Sub 34 | 35 | 36 | Public Sub Ctor_NegativeUpperBound1_ThrowsArgumentException() 37 | AssertExtensions.Throws(Of ArgumentException)(Nothing, Function() As Community.VisualBasic.VBFixedArrayAttribute 38 | Return New VBFixedArrayAttribute(-1) 39 | End Function) 40 | AssertExtensions.Throws(Of ArgumentException)(Nothing, Function() As Community.VisualBasic.VBFixedArrayAttribute 41 | Return New VBFixedArrayAttribute(-1, 0) 42 | End Function) 43 | End Sub 44 | 45 | 46 | Public Sub Ctor_NegativeUpperBound2_ThrowsArgumentException() 47 | AssertExtensions.Throws(Of ArgumentException)(Nothing, Function() As Community.VisualBasic.VBFixedArrayAttribute 48 | Return New VBFixedArrayAttribute(0, -1) 49 | End Function) 50 | End Sub 51 | 52 | End Class 53 | 54 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic.Tests/Community/VisualBasic/VBFixedStringAttributeTests.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Option Compare Text 5 | Option Explicit On 6 | Option Infer Off 7 | Option Strict On 8 | 9 | Imports Xunit 10 | 11 | Namespace Global.Community.VisualBasic.Tests 12 | 13 | Public Class VBFixedStringAttributeTests 14 | 15 | 16 | 17 | 18 | Public Sub Ctor_Int(length As Integer) 19 | Dim attribute As Community.VisualBasic.VBFixedStringAttribute = New VBFixedStringAttribute(length) 20 | Assert.Equal(length, attribute.Length) 21 | End Sub 22 | 23 | 24 | 25 | 26 | 27 | Public Sub Ctor_InvalidLength_ThrowsArgumentException(length As Integer) 28 | AssertExtensions.Throws(Of ArgumentException)(Nothing, Function() As Community.VisualBasic.VBFixedStringAttribute 29 | Return New VBFixedStringAttribute(length) 30 | End Function) 31 | End Sub 32 | 33 | End Class 34 | 35 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic.Tests/CompilerServices/BooleanTypeTests.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Option Compare Text 5 | Option Explicit On 6 | Option Infer Off 7 | Option Strict On 8 | 9 | Imports System.Globalization 10 | Imports Community.VisualBasic.CompilerServices 11 | Imports Xunit 12 | 13 | Namespace Global.Community.VisualBasic.Tests 14 | 15 | Public Class BooleanTypeTests 16 | 17 | 18 | Public Sub NullData() 19 | ' Null is valid input for Boolean.FromObject 20 | Assert.Throws(Of InvalidCastException)(Function() BooleanType.FromString(Nothing)) 21 | End Sub 22 | 23 | 24 | 25 | Public Sub InvalidCastString(value As String) 26 | Assert.Throws(Of InvalidCastException)(Function() BooleanType.FromString(value)) 27 | End Sub 28 | 29 | 30 | 31 | 32 | Public Sub InvalidCastObject(value As Object) 33 | Assert.Throws(Of InvalidCastException)(Function() BooleanType.FromObject(value)) 34 | End Sub 35 | 36 | Public Shared ReadOnly Property InvalidStringData As TheoryData(Of String) 37 | Get 38 | Return New TheoryData(Of String) From { 39 | {""}, 40 | {"23&"}, 41 | {"abc"}} 42 | End Get 43 | End Property 44 | 45 | Public Shared ReadOnly Property InvalidObjectData As TheoryData(Of Object) 46 | Get 47 | Return New TheoryData(Of Object) From { 48 | {DateTime.Now}, 49 | {"c"c}, 50 | {Guid.Empty}} 51 | End Get 52 | End Property 53 | 54 | 55 | 56 | Public Sub FromString(expected As Boolean, value As String) 57 | Assert.Equal(expected, BooleanType.FromString(value)) 58 | End Sub 59 | 60 | 61 | 62 | 63 | Public Sub FromObject(expected As Boolean, value As Object) 64 | Assert.Equal(expected, BooleanType.FromObject(value)) 65 | End Sub 66 | 67 | Public Shared ReadOnly Property BoolStringData As TheoryData(Of Boolean, String) 68 | Get 69 | Return New TheoryData(Of Boolean, String) From { 70 | {False, "0"}, 71 | {False, "False"}, 72 | {True, "True"}, 73 | {True, "1"}, 74 | {True, "1" & CultureInfo.CurrentCulture.NumberFormat.NumberDecimalSeparator & "2"}, 75 | {True, "2"}, 76 | {True, "-1"}, 77 | {False, "&H00"}, 78 | {False, "&O00"}, 79 | {True, "&H01"}, 80 | {True, "&O01"}, 81 | {True, "9999999999999999999999999999999999999"}} 82 | End Get 83 | End Property 84 | 85 | Public Shared ReadOnly Property BoolObjectData As TheoryData(Of Boolean, Object) 86 | Get 87 | Return New TheoryData(Of Boolean, Object) From { 88 | {False, 0}, 89 | {False, Nothing}, 90 | {False, False}, 91 | {True, True}, 92 | {True, 1}, 93 | {True, "1" & CultureInfo.CurrentCulture.NumberFormat.NumberDecimalSeparator & "2"}, 94 | {True, 2}, 95 | {True, -1}, 96 | {False, CByte(0)}, 97 | {True, CByte(1)}, 98 | {False, CShort(Fix(0))}, 99 | {True, CShort(Fix(1))}, 100 | {False, CDbl(0)}, 101 | {True, CDbl(1)}, 102 | {False, CDec(0)}, 103 | {True, CDec(1)}} 104 | End Get 105 | End Property 106 | 107 | End Class 108 | 109 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic.Tests/CompilerServices/DecimalTypeTests.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Option Compare Text 5 | Option Explicit On 6 | Option Infer Off 7 | Option Strict On 8 | 9 | Imports System.Globalization 10 | Imports Community.VisualBasic.CompilerServices 11 | Imports Xunit 12 | 13 | Namespace Global.Community.VisualBasic.Tests 14 | 15 | Public Class DecimalTypeTests 16 | 17 | 18 | 19 | 20 | Public Sub FromBoolean(value As Boolean, expected As Decimal) 21 | Assert.Equal(expected, DecimalType.FromBoolean(value)) 22 | End Sub 23 | 24 | 25 | 26 | 27 | 28 | 29 | Public Sub FromString(value As String, expected As Decimal) 30 | Assert.Equal(expected, DecimalType.FromString(value)) 31 | End Sub 32 | 33 | 34 | Public Sub FromString_Invalid() 35 | Assert.Throws(Of OverflowException)(Function() DecimalType.FromString("9999999999999999999999999999999999999")) 36 | Assert.Throws(Of InvalidCastException)(Function() DecimalType.FromString("abc")) 37 | End Sub 38 | 39 | 40 | Public Sub FromObject() 41 | Assert.Equal(0D, DecimalType.FromObject(Nothing)) 42 | Assert.Equal(-1D, DecimalType.FromObject(True)) 43 | Assert.Equal(123D, DecimalType.FromObject(CByte(123))) 44 | Assert.Equal(123D, DecimalType.FromObject(CShort(Fix(123)))) 45 | Assert.Equal(123D, DecimalType.FromObject(CInt(Fix(123)))) 46 | Assert.Equal(123D, DecimalType.FromObject(CLng(Fix(123)))) 47 | Assert.Equal(123D, DecimalType.FromObject(CSng(123))) 48 | Assert.Equal(123D, DecimalType.FromObject(CDbl(123))) 49 | Assert.Equal(123D, DecimalType.FromObject(CDec(123))) 50 | Assert.Equal(123D, DecimalType.FromObject("123")) 51 | End Sub 52 | 53 | 54 | Public Sub FromObject_Invalid() 55 | Assert.Throws(Of InvalidCastException)(Function() DecimalType.FromObject("1"c)) 56 | Assert.Throws(Of InvalidCastException)(Function() DecimalType.FromObject(DateTime.MinValue)) 57 | Assert.Throws(Of InvalidCastException)(Function() DecimalType.FromObject(Guid.Empty)) 58 | End Sub 59 | 60 | 61 | 62 | 63 | Public Sub Parse(value As String, expected As Decimal) 64 | Assert.Equal(expected, DecimalType.Parse(value, CultureInfo.InvariantCulture.NumberFormat)) 65 | End Sub 66 | 67 | 68 | Public Sub Parse_Invalid() 69 | Assert.Throws(Of ArgumentNullException)(Function() DecimalType.Parse(Nothing, Nothing)) 70 | Assert.Throws(Of FormatException)(Function() DecimalType.Parse("abc", CultureInfo.InvariantCulture.NumberFormat)) 71 | End Sub 72 | 73 | End Class 74 | 75 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic.Tests/CompilerServices/DoubleTypeTests.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Option Compare Text 5 | Option Explicit On 6 | Option Infer Off 7 | Option Strict On 8 | 9 | Imports System.Globalization 10 | Imports Community.VisualBasic.CompilerServices 11 | Imports Xunit 12 | 13 | Namespace Global.Community.VisualBasic.Tests 14 | 15 | Public Class DoubleTypeTests 16 | 17 | 18 | 19 | 20 | 21 | 22 | Public Sub FromString(value As String, expected As Double) 23 | Assert.Equal(expected, DoubleType.FromString(value)) 24 | End Sub 25 | 26 | 27 | Public Sub FromString_Invalid() 28 | Assert.Throws(Of InvalidCastException)(Function() DoubleType.FromString("abc")) 29 | End Sub 30 | 31 | 32 | Public Sub FromObject() 33 | Assert.Equal(0R, DoubleType.FromObject(Nothing)) 34 | Assert.Equal(-1.0R, DoubleType.FromObject(True)) 35 | Assert.Equal(123.0R, DoubleType.FromObject(CByte(123))) 36 | Assert.Equal(123.0R, DoubleType.FromObject(CShort(Fix(123)))) 37 | Assert.Equal(123.0R, DoubleType.FromObject(CInt(Fix(123)))) 38 | Assert.Equal(123.0R, DoubleType.FromObject(CLng(Fix(123)))) 39 | Assert.Equal(123.0R, DoubleType.FromObject(CSng(123))) 40 | Assert.Equal(123.0R, DoubleType.FromObject(CDbl(123))) 41 | Assert.Equal(123.0R, DoubleType.FromObject(CDec(123))) 42 | Assert.Equal(123.0R, DoubleType.FromObject("123")) 43 | End Sub 44 | 45 | 46 | Public Sub FromObject_Invalid() 47 | Assert.Throws(Of InvalidCastException)(Function() DoubleType.FromObject("1"c)) 48 | Assert.Throws(Of InvalidCastException)(Function() DoubleType.FromObject(DateTime.MinValue)) 49 | Assert.Throws(Of InvalidCastException)(Function() DoubleType.FromObject(Guid.Empty)) 50 | End Sub 51 | 52 | 53 | 54 | 55 | Public Sub Parse(value As String, expected As Double) 56 | Assert.Equal(expected, DoubleType.Parse(value, CultureInfo.InvariantCulture.NumberFormat)) 57 | End Sub 58 | 59 | 60 | Public Sub Parse_Invalid() 61 | Assert.Throws(Of ArgumentNullException)(Function() DoubleType.Parse(Nothing, Nothing)) 62 | Assert.Throws(Of FormatException)(Function() DoubleType.Parse("abc", CultureInfo.InvariantCulture.NumberFormat)) 63 | End Sub 64 | 65 | End Class 66 | 67 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic.Tests/IConvertableWrapper.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Option Compare Text 5 | Option Explicit On 6 | Option Infer Off 7 | Option Strict On 8 | 9 | Namespace Global.Community.VisualBasic.Tests 10 | 11 | Public Class ConvertibleWrapper 12 | Implements IConvertible 13 | 14 | Public ReadOnly Property Value As IConvertible 15 | 16 | Public Sub New(value1 As IConvertible) 17 | Value = value1 18 | End Sub 19 | 20 | Public Function GetTypeCode() As TypeCode Implements System.IConvertible.GetTypeCode 21 | Return Value.GetTypeCode() 22 | End Function 23 | 24 | Public Function ToBoolean(provider As IFormatProvider) As Boolean Implements System.IConvertible.ToBoolean 25 | Return Value.ToBoolean(provider) 26 | End Function 27 | 28 | Public Function ToByte(provider As IFormatProvider) As Byte Implements System.IConvertible.ToByte 29 | Return Value.ToByte(provider) 30 | End Function 31 | 32 | Public Function ToChar(provider As IFormatProvider) As Char Implements System.IConvertible.ToChar 33 | Return Value.ToChar(provider) 34 | End Function 35 | Public Function ToDateTime(provider As IFormatProvider) As DateTime Implements System.IConvertible.ToDateTime 36 | Return Value.ToDateTime(provider) 37 | End Function 38 | Public Function ToDecimal(provider As IFormatProvider) As Decimal Implements System.IConvertible.ToDecimal 39 | Return Value.ToDecimal(provider) 40 | End Function 41 | Public Function ToDouble(provider As IFormatProvider) As Double Implements System.IConvertible.ToDouble 42 | Return Value.ToDouble(provider) 43 | End Function 44 | Public Function ToInt16(provider As IFormatProvider) As Short Implements System.IConvertible.ToInt16 45 | Return Value.ToInt16(provider) 46 | End Function 47 | Public Function ToInt32(provider As IFormatProvider) As Integer Implements System.IConvertible.ToInt32 48 | Return Value.ToInt32(provider) 49 | End Function 50 | Public Function ToInt64(provider As IFormatProvider) As Long Implements System.IConvertible.ToInt64 51 | Return Value.ToInt64(provider) 52 | End Function 53 | Public Function ToSByte(provider As IFormatProvider) As SByte Implements System.IConvertible.ToSByte 54 | Return Value.ToSByte(provider) 55 | End Function 56 | Public Function ToSingle(provider As IFormatProvider) As Single Implements System.IConvertible.ToSingle 57 | Return Value.ToSingle(provider) 58 | End Function 59 | Public Shadows Function ToString(provider As IFormatProvider) As String Implements System.IConvertible.ToString 60 | Return Value.ToString(provider) 61 | End Function 62 | Public Function ToType(conversionType As Type, provider As IFormatProvider) As Object Implements System.IConvertible.ToType 63 | Return Value.ToType(conversionType, provider) 64 | End Function 65 | Public Function ToUInt16(provider As IFormatProvider) As UShort Implements System.IConvertible.ToUInt16 66 | Return Value.ToUInt16(provider) 67 | End Function 68 | Public Function ToUInt32(provider As IFormatProvider) As UInteger Implements System.IConvertible.ToUInt32 69 | Return Value.ToUInt32(provider) 70 | End Function 71 | Public Function ToUInt64(provider As IFormatProvider) As ULong Implements System.IConvertible.ToUInt64 72 | Return Value.ToUInt64(provider) 73 | End Function 74 | 75 | End Class 76 | 77 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic.Tests/LikeOperatorTests.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Option Compare Text 5 | Option Explicit On 6 | Option Infer Off 7 | Option Strict On 8 | 9 | Imports System.Collections.Generic 10 | Imports Xunit 11 | 12 | Namespace Global.Community.VisualBasic.CompilerServices.Tests 13 | 14 | Public Class LikeOperatorTests 15 | 16 | 17 | 18 | Public Sub LikeObject(source As Object, pattern As Object, expectedBinaryCompare As Object, expectedTextCompare As Object) 19 | Assert.Equal(expectedBinaryCompare, Microsoft.VisualBasic.CompilerServices.LikeOperator.LikeObject(source, pattern, Microsoft.VisualBasic.CompareMethod.Binary)) 20 | Assert.Equal(expectedTextCompare, Microsoft.VisualBasic.CompilerServices.LikeOperator.LikeObject(source, pattern, Microsoft.VisualBasic.CompareMethod.Text)) 21 | End Sub 22 | 23 | 24 | Public Sub LikeString(source As String, pattern As String, expectedBinaryCompare As Boolean, expectedTextCompare As Boolean) 25 | Assert.Equal(expectedBinaryCompare, Microsoft.VisualBasic.CompilerServices.LikeOperator.LikeString(source, pattern, Microsoft.VisualBasic.CompareMethod.Binary)) 26 | Assert.Equal(expectedTextCompare, Microsoft.VisualBasic.CompilerServices.LikeOperator.LikeString(source, pattern, Microsoft.VisualBasic.CompareMethod.Text)) 27 | End Sub 28 | Public Shared Iterator Function LikeObject_TestData() As IEnumerable(Of Object()) 29 | Yield New Object() {Nothing, New Char() {"*"c}, True, True} 30 | Yield New Object() {Array.Empty(Of Char)(), Nothing, True, True} 31 | Yield New Object() {"a3", New Char() {"A"c, "#"c}, False, True} 32 | Yield New Object() {New Char() {"A"c, "3"c}, "a#", False, True} 33 | End Function 34 | 35 | Public Shared Iterator Function LikeString_TestData() As IEnumerable(Of Object()) 36 | Yield New Object() {Nothing, Nothing, True, True} 37 | Yield New Object() {Nothing, "*", True, True} 38 | Yield New Object() {"", Nothing, True, True} 39 | Yield New Object() {"", "*", True, True} 40 | Yield New Object() {"", "?", False, False} 41 | Yield New Object() {"a", "?", True, True} 42 | Yield New Object() {"a3", "[A-Z]#", False, True} 43 | Yield New Object() {"A3", "[a-a]#", False, True} 44 | End Function 45 | 46 | End Class 47 | 48 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic.Tests/ProjectDataTests.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Option Compare Text 5 | Option Explicit On 6 | Option Infer On 7 | Option Strict On 8 | 9 | #If RemoteExecutor Then 10 | Imports Microsoft.DotNet.RemoteExecutor 11 | #End If 12 | Imports System 13 | Imports Xunit 14 | 15 | Namespace Global.Community.VisualBasic.CompilerServices.Tests 16 | 17 | Public Class ProjectDataTests 18 | 19 | 20 | Public Sub CreateProjectError() 21 | Dim temp = Assert.Throws(Of ArgumentException)(Function() ProjectData.CreateProjectError(0)).ToString() 22 | temp = Assert.IsType(Of Exception)(ProjectData.CreateProjectError(1)).ToString() 23 | temp = Assert.IsType(Of OutOfMemoryException)(ProjectData.CreateProjectError(7)).ToString() 24 | temp = Assert.IsType(Of Exception)(ProjectData.CreateProjectError(32768)).ToString() 25 | temp = Assert.IsType(Of Exception)(ProjectData.CreateProjectError(40068)).ToString() 26 | temp = Assert.IsType(Of Exception)(ProjectData.CreateProjectError(41000)).ToString() 27 | End Sub 28 | 29 | 30 | Public Sub SetProjectError() 31 | 32 | Dim e As Exception = New ArgumentException 33 | ProjectData.SetProjectError(e) 34 | Assert.Same(e, Information.Err().GetException()) 35 | Assert.Equal(0, Information.Err().Erl) 36 | 37 | e = New InvalidOperationException 38 | ProjectData.SetProjectError(e, 3) 39 | Assert.Same(e, Information.Err().GetException()) 40 | Assert.Equal(3, Information.Err().Erl) 41 | 42 | e = New Exception 43 | ProjectData.SetProjectError(e) 44 | Assert.Same(e, Information.Err().GetException()) 45 | Assert.Equal(0, Information.Err().Erl) 46 | 47 | End Sub 48 | 49 | 50 | Public Sub ClearProjectError() 51 | ProjectData.SetProjectError(New ArgumentException, 3) 52 | ProjectData.ClearProjectError() 53 | Assert.Null(Information.Err().GetException()) 54 | Assert.Equal(0, Information.Err().Erl) 55 | End Sub 56 | 57 | #If RemoteExecutor Then 58 | 59 | Public Sub EndApp() 60 | RemoteExecutor.Invoke( 61 | New Action(Sub() 62 | ' See FileSystemTests.CloseAllFiles() for a test that EndApp() closes open files. 63 | ProjectData.EndApp() 64 | Throw New Exception ' Shouldn't reach here. 65 | End Sub), 66 | New RemoteInvokeOptions() With {}.ExpectedExitCode = 0}).Dispose() 67 | End Sub 68 | #End If 69 | 70 | End Class 71 | 72 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic.Tests/TestUtilities/System/AdminHelpers.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Option Compare Text 5 | Option Explicit On 6 | Option Infer Off 7 | Option Strict On 8 | 9 | Imports System.ComponentModel 10 | Imports System.Diagnostics 11 | Imports System.Runtime.InteropServices 12 | Imports System.Security.Principal 13 | Imports Microsoft.Win32.SafeHandles 14 | Imports Xunit 15 | 16 | Namespace Global.Community 17 | 18 | Public Module AdminHelpers 19 | 20 | ''' 21 | ''' Runs the given command as sudo (for Unix). 22 | ''' 23 | ''' The command line to run as sudo 24 | ''' Returns the process exit code (0 typically means it is successful) 25 | Public Function RunAsSudo(commandLine As String) As Integer 26 | Dim startInfo As New ProcessStartInfo() With { 27 | .FileName = "sudo", 28 | .Arguments = commandLine} 29 | Using process1 As Process = Process.Start(startInfo) 30 | Assert.[True](process1.WaitForExit(30000)) 31 | Return process1.ExitCode 32 | End Using 33 | End Function 34 | 35 | Public Function IsProcessElevated() As Boolean 36 | If Not RuntimeInformation.IsOSPlatform(OSPlatform.Windows) Then 37 | Dim userId As UInteger = Interop.Sys.GetEUid() 38 | Return (userId = 0) 39 | End If 40 | 41 | Dim token As SafeAccessTokenHandle = Nothing 42 | If Not Interop.Advapi32.OpenProcessToken(Interop.Kernel32.GetCurrentProcess(), TokenAccessLevels.Read, token) Then 43 | Throw New Win32Exception(Marshal.GetLastWin32Error(), "Open process token failed") 44 | End If 45 | 46 | Using token 47 | Dim elevation As New Interop.Advapi32.TOKEN_ELEVATION 48 | Dim ignore As UInteger 49 | If Not Interop.Advapi32.GetTokenInformation(token, 50 | Interop.Advapi32.TOKEN_INFORMATION_CLASS.TokenElevation, 51 | elevation, 52 | CUInt(Len(New Interop.Advapi32.TOKEN_ELEVATION())), 53 | ignore) Then 54 | Throw New Win32Exception(Marshal.GetLastWin32Error(), "Get token information failed") 55 | End If 56 | 57 | Return elevation.TokenIsElevated <> Interop.BOOL.[FALSE] 58 | End Using 59 | End Function 60 | 61 | End Module 62 | 63 | End Namespace 64 | -------------------------------------------------------------------------------- /Community.VisualBasic.Tests/TestUtilities/System/IO/StreamExtensions.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Option Compare Text 5 | Option Explicit On 6 | Option Infer Off 7 | Option Strict On 8 | 9 | Imports System.Threading 10 | Imports System.Threading.Tasks 11 | Imports System.Runtime.CompilerServices 12 | Imports System 13 | 14 | Namespace Global.Community.IOx 15 | 16 | Public Module StreamExtensions 17 | 18 | 19 | Public Async Function ReadByteAsync(stream1 As System.IO.Stream, Optional cancellationToken1 As CancellationToken = CType(Nothing, CancellationToken)) As Task(Of Integer) 20 | Dim buffer As Byte() = New Byte(0) {} 21 | Dim numBytesRead As Integer = Await stream1.ReadAsync(buffer.AsMemory(0, 1), cancellationToken1) 22 | If numBytesRead = 0 Then 23 | Return -1 ' EOF 24 | End If 25 | Return buffer(0) 26 | End Function 27 | 28 | End Module 29 | 30 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic.Tests/TestUtilities/System/ThreadCultureChange.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Option Compare Text 5 | Option Explicit On 6 | Option Infer Off 7 | Option Strict On 8 | 9 | ' TODO: Skipped Null-able Directive enable 10 | Imports System.Globalization 11 | 12 | Namespace Global.Community.Tests 13 | 14 | Public NotInheritable Class ThreadCultureChange 15 | Implements IDisposable 16 | 17 | Private ReadOnly _origCulture As CultureInfo = CultureInfo.CurrentCulture 18 | Private ReadOnly _origUICulture As CultureInfo = CultureInfo.CurrentUICulture 19 | 20 | Public Sub New(cultureName As String) 21 | 'MyBase.New(If(cultureName IsNot Nothing, New CultureInfo(cultureName), Nothing)) 22 | If cultureName IsNot Nothing Then 23 | _origCulture = CultureInfo.CurrentCulture 24 | CultureInfo.CurrentCulture = New CultureInfo(cultureName) 25 | End If 26 | End Sub 27 | 28 | Public Sub New(newCulture As CultureInfo) 29 | 'MyBase.New(newCulture, nothing) 30 | If newCulture IsNot Nothing Then 31 | _origCulture = CultureInfo.CurrentCulture 32 | CultureInfo.CurrentCulture = newCulture 33 | End If 34 | End Sub 35 | 36 | Public Sub New(newCulture As CultureInfo, newUICulture As CultureInfo) 37 | If newCulture IsNot Nothing Then 38 | _origCulture = CultureInfo.CurrentCulture 39 | CultureInfo.CurrentCulture = newCulture 40 | End If 41 | 42 | If newUICulture IsNot Nothing Then 43 | _origUICulture = CultureInfo.CurrentUICulture 44 | CultureInfo.CurrentUICulture = newUICulture 45 | End If 46 | End Sub 47 | 48 | Public Sub Dispose() Implements IDisposable.Dispose 49 | CultureInfo.CurrentCulture = _origCulture 50 | CultureInfo.CurrentUICulture = _origUICulture 51 | End Sub 52 | 53 | End Class 54 | 55 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic.Tests/UtilsTests.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Option Compare Text 5 | Option Explicit On 6 | Option Infer Off 7 | Option Strict On 8 | 9 | Imports System.Collections.Generic 10 | Imports Community.VisualBasic.CompilerServices 11 | Imports Xunit 12 | 13 | Namespace Global.Community.VisualBasic.CompilerServices.Tests 14 | 15 | Public Class UtilsTests 16 | 17 | Public Shared Iterator Function CopyArray_TestData() As IEnumerable(Of Object()) 18 | 19 | Yield New Object() {New Integer() {1, 2}, New Integer(2) {}, New Integer() {1, 2, 0}} 20 | Yield New Object() {New Integer() {1, 2}, New Integer(1) {}, New Integer() {1, 2}} 21 | Yield New Object() {New Integer() {1, 2}, New Integer(0) {}, New Integer() {1}} 22 | 23 | Yield New Object() {New Integer(,) { 24 | {1, 2}, 25 | {3, 4}}, New Integer(1, 1) {}, New Integer(,) { 26 | {1, 2}, 27 | {3, 4}}} 28 | 29 | If PlatformDetection.IsNonZeroLowerBoundArraySupported Then 30 | Dim array1 As Array = Array.CreateInstance(GetType(Integer), 1) 31 | Dim array2 As Array = Array.CreateInstance(GetType(Integer), New Integer() {1}, New Integer() {2}) 32 | Yield New Object() {array1, array2, array2} 33 | 34 | Dim array3 As Array = Array.CreateInstance(GetType(Integer), New Integer() {1, 1}, New Integer() {0, -1}) 35 | Dim array4 As Array = Array.CreateInstance(GetType(Integer), New Integer() {1, 0}, New Integer() {0, 2}) 36 | Yield New Object() {array3, array4, array4} 37 | 38 | Dim array5 As Array = Array.CreateInstance(GetType(Integer), New Integer() {1, 2}, New Integer() {0, 0}) 39 | Dim array6 As Array = Array.CreateInstance(GetType(Integer), New Integer() {1, 1}, New Integer() {0, 1}) 40 | Yield New Object() {array5, array6, array6} 41 | End If 42 | 43 | End Function 44 | 45 | 46 | 47 | Public Sub CopyArray_Valid_ReturnsExpected(source As Array, destination As Array, expected As Array) 48 | Assert.Same(destination, Utils.CopyArray(source, destination)) 49 | Assert.Equal(expected, destination) 50 | End Sub 51 | 52 | 53 | Public Sub CopyArray_NullSourceArray_ReturnsDestination() 54 | Dim destination As Array = Array.Empty(Of Object)() 55 | Assert.Same(destination, Utils.CopyArray(Nothing, destination)) 56 | End Sub 57 | 58 | 59 | Public Sub CopyArray_EmptySourceArray_ReturnsDestination() 60 | Dim destination As Array = Array.Empty(Of Object)() 61 | Assert.Same(destination, Utils.CopyArray(Array.Empty(Of Integer)(), destination)) 62 | Assert.Null(Utils.CopyArray(Array.Empty(Of Integer)(), Nothing)) 63 | End Sub 64 | 65 | 66 | Public Sub CopyArray_NullDestinationArray_ThrowsNullReferenceException() 67 | Assert.Throws(Of NullReferenceException)(Function() Utils.CopyArray(New Integer(0) {}, Nothing)) 68 | End Sub 69 | 70 | 71 | Public Sub CopyArray_NonMatchingRanks_ThrowsInvalidCastException() 72 | Assert.Throws(Of InvalidCastException)(Function() Utils.CopyArray(New Integer(0) {}, New Integer(0, 0) {})) 73 | End Sub 74 | 75 | ' 76 | 77 | Public Sub CopyArray_RankGreaterThanTwoAndNonMatchingBounds_ThrowsArrayTypeMismatchException() 78 | Dim array1 As Array = Array.CreateInstance(GetType(Integer), New Integer() {1, 2, 3}, New Integer() {2, 3, 4}) 79 | Dim array2 As Array = Array.CreateInstance(GetType(Integer), New Integer() {1, 2, 3}, New Integer() {2, 4, 4}) 80 | Assert.Throws(Of ArrayTypeMismatchException)(Function() Utils.CopyArray(array1, array2)) 81 | Assert.Throws(Of ArrayTypeMismatchException)(Function() Utils.CopyArray(array2, array1)) 82 | End Sub 83 | 84 | ' 85 | 86 | Public Sub CopyArray_NonMatchingBounds_ThrowsArgumentOutOfRangeException() 87 | Dim array1 As Array = Array.CreateInstance(GetType(Integer), New Integer() {1, 2}, New Integer() {2, 3}) 88 | Dim array2 As Array = Array.CreateInstance(GetType(Integer), New Integer() {1, 2}, New Integer() {2, 4}) 89 | AssertExtensions.Throws(Of ArgumentOutOfRangeException)("sourceIndex", "srcIndex", Function() Utils.CopyArray(array1, array2)) 90 | AssertExtensions.Throws(Of ArgumentOutOfRangeException)("sourceIndex", "srcIndex", Function() Utils.CopyArray(array2, array1)) 91 | End Sub 92 | 93 | 94 | Public Sub GetResourceString() 95 | If System.Threading.Thread.CurrentThread.CurrentCulture.Name = "en-US" Then 96 | Assert.Equal("Argument '42' is not a valid value.", Utils.GetResourceString("Argument_InvalidValue1", "42")) 97 | Assert.Equal("Argument '42' is not a valid value.", Utils.GetResourceString(ResourceKey:="Argument_InvalidValue1", {"42"})) 98 | Assert.Equal("Application-defined or object-defined error.", Utils.GetResourceString("UnrecognizedResourceKey")) 99 | End If 100 | End Sub 101 | 102 | End Class 103 | 104 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic.sln: -------------------------------------------------------------------------------- 1 |  2 | Microsoft Visual Studio Solution File, Format Version 12.00 3 | # Visual Studio Version 16 4 | VisualStudioVersion = 16.0.30711.63 5 | MinimumVisualStudioVersion = 10.0.40219.1 6 | Project("{778DAE3C-4631-46EA-AA77-85C1314464D9}") = "Community.VisualBasic", "Community.VisualBasic\Community.VisualBasic.vbproj", "{5C7333BA-E36F-4918-95F0-82BF3AE6F6E3}" 7 | EndProject 8 | Project("{778DAE3C-4631-46EA-AA77-85C1314464D9}") = "net5-console", "ProjectTypeTests\net5-console\net5-console.vbproj", "{0D2B402A-8913-40F5-9361-0B2EC828338B}" 9 | EndProject 10 | Project("{778DAE3C-4631-46EA-AA77-85C1314464D9}") = "net5-windows", "ProjectTypeTests\net5-windows\net5-windows.vbproj", "{F331BCC6-7773-47D3-89FE-946341D39F73}" 11 | EndProject 12 | Project("{778DAE3C-4631-46EA-AA77-85C1314464D9}") = "netstandard2_0", "ProjectTypeTests\netstandard2_0\netstandard2_0.vbproj", "{7DD0482C-2D6E-47B0-BA0C-28D5589D70C7}" 13 | EndProject 14 | Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "net4-console", "ProjectTypeTests\net4-console\net4-console.vbproj", "{95EED873-FA2D-4A31-815A-15D74D6AEEA1}" 15 | EndProject 16 | Project("{778DAE3C-4631-46EA-AA77-85C1314464D9}") = "Community.VisualBasic.Tests", "Community.VisualBasic.Tests\Community.VisualBasic.Tests.vbproj", "{78554D4F-CE23-411F-9660-E016AE00C956}" 17 | EndProject 18 | Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "ProjectTypeTests", "ProjectTypeTests", "{2D1C234B-3890-48B7-9338-980BCD043856}" 19 | EndProject 20 | Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution Items", "{59F85EF7-136F-40E6-816D-BB14EAEC44DC}" 21 | ProjectSection(SolutionItems) = preProject 22 | .editorconfig = .editorconfig 23 | LICENSE = LICENSE 24 | README.md = README.md 25 | EndProjectSection 26 | EndProject 27 | Global 28 | GlobalSection(SolutionConfigurationPlatforms) = preSolution 29 | Debug|Any CPU = Debug|Any CPU 30 | Release|Any CPU = Release|Any CPU 31 | EndGlobalSection 32 | GlobalSection(ProjectConfigurationPlatforms) = postSolution 33 | {5C7333BA-E36F-4918-95F0-82BF3AE6F6E3}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 34 | {5C7333BA-E36F-4918-95F0-82BF3AE6F6E3}.Debug|Any CPU.Build.0 = Debug|Any CPU 35 | {5C7333BA-E36F-4918-95F0-82BF3AE6F6E3}.Release|Any CPU.ActiveCfg = Release|Any CPU 36 | {5C7333BA-E36F-4918-95F0-82BF3AE6F6E3}.Release|Any CPU.Build.0 = Release|Any CPU 37 | {0D2B402A-8913-40F5-9361-0B2EC828338B}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 38 | {0D2B402A-8913-40F5-9361-0B2EC828338B}.Debug|Any CPU.Build.0 = Debug|Any CPU 39 | {0D2B402A-8913-40F5-9361-0B2EC828338B}.Release|Any CPU.ActiveCfg = Release|Any CPU 40 | {0D2B402A-8913-40F5-9361-0B2EC828338B}.Release|Any CPU.Build.0 = Release|Any CPU 41 | {F331BCC6-7773-47D3-89FE-946341D39F73}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 42 | {F331BCC6-7773-47D3-89FE-946341D39F73}.Debug|Any CPU.Build.0 = Debug|Any CPU 43 | {F331BCC6-7773-47D3-89FE-946341D39F73}.Release|Any CPU.ActiveCfg = Release|Any CPU 44 | {F331BCC6-7773-47D3-89FE-946341D39F73}.Release|Any CPU.Build.0 = Release|Any CPU 45 | {7DD0482C-2D6E-47B0-BA0C-28D5589D70C7}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 46 | {7DD0482C-2D6E-47B0-BA0C-28D5589D70C7}.Debug|Any CPU.Build.0 = Debug|Any CPU 47 | {7DD0482C-2D6E-47B0-BA0C-28D5589D70C7}.Release|Any CPU.ActiveCfg = Release|Any CPU 48 | {7DD0482C-2D6E-47B0-BA0C-28D5589D70C7}.Release|Any CPU.Build.0 = Release|Any CPU 49 | {95EED873-FA2D-4A31-815A-15D74D6AEEA1}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 50 | {95EED873-FA2D-4A31-815A-15D74D6AEEA1}.Debug|Any CPU.Build.0 = Debug|Any CPU 51 | {95EED873-FA2D-4A31-815A-15D74D6AEEA1}.Release|Any CPU.ActiveCfg = Release|Any CPU 52 | {95EED873-FA2D-4A31-815A-15D74D6AEEA1}.Release|Any CPU.Build.0 = Release|Any CPU 53 | {78554D4F-CE23-411F-9660-E016AE00C956}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 54 | {78554D4F-CE23-411F-9660-E016AE00C956}.Debug|Any CPU.Build.0 = Debug|Any CPU 55 | {78554D4F-CE23-411F-9660-E016AE00C956}.Release|Any CPU.ActiveCfg = Release|Any CPU 56 | {78554D4F-CE23-411F-9660-E016AE00C956}.Release|Any CPU.Build.0 = Release|Any CPU 57 | EndGlobalSection 58 | GlobalSection(SolutionProperties) = preSolution 59 | HideSolutionNode = FALSE 60 | EndGlobalSection 61 | GlobalSection(NestedProjects) = preSolution 62 | {0D2B402A-8913-40F5-9361-0B2EC828338B} = {2D1C234B-3890-48B7-9338-980BCD043856} 63 | {F331BCC6-7773-47D3-89FE-946341D39F73} = {2D1C234B-3890-48B7-9338-980BCD043856} 64 | {7DD0482C-2D6E-47B0-BA0C-28D5589D70C7} = {2D1C234B-3890-48B7-9338-980BCD043856} 65 | {95EED873-FA2D-4A31-815A-15D74D6AEEA1} = {2D1C234B-3890-48B7-9338-980BCD043856} 66 | EndGlobalSection 67 | GlobalSection(ExtensibilityGlobals) = postSolution 68 | SolutionGuid = {AB9112E2-7B45-4CF7-9583-08415020ED66} 69 | EndGlobalSection 70 | EndGlobal 71 | -------------------------------------------------------------------------------- /Community.VisualBasic/ApplicationServices/ApplicationBase.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | ' See the LICENSE file in the project root for more information. 4 | 5 | Option Strict On 6 | Option Explicit On 7 | 8 | Imports ExUtils = Community.VisualBasic.CompilerServices.ExceptionUtils 9 | 10 | Namespace Global.Community.VisualBasic.ApplicationServices 11 | 12 | ''' 13 | ''' Abstract class that defines the application Startup/Shutdown model for VB 14 | ''' Windows Applications such as console, WinForms, dll, service. 15 | ''' 16 | Public Class ApplicationBase 17 | 18 | Public Sub New() 19 | End Sub 20 | 21 | ''' 22 | ''' Returns the value of the specified environment variable. 23 | ''' 24 | ''' A String containing the name of the environment variable. 25 | ''' A string containing the value of the environment variable. 26 | ''' if name is Nothing. 27 | ''' if the specified environment variable does not exist. 28 | Public Function GetEnvironmentVariable(name As String) As String 29 | 30 | ' Framework returns Null if not found. 31 | Dim VariableValue As String = Environment.GetEnvironmentVariable(name) 32 | 33 | ' Since the explicitly requested a specific environment variable and we couldn't find it, throw 34 | If VariableValue Is Nothing Then 35 | Throw ExUtils.GetArgumentExceptionWithArgName("name", SR.EnvVarNotFound_Name, name) 36 | End If 37 | 38 | Return VariableValue 39 | End Function 40 | 41 | ''' 42 | ''' Provides access to logging capability. 43 | ''' 44 | ''' Returns a Microsoft.VisualBasic.Windows.Log object used for logging to OS log, debug window 45 | ''' and a delimited text file or xml log. 46 | Public ReadOnly Property Log() As Logging.Log 47 | Get 48 | If _log Is Nothing Then 49 | _log = New Logging.Log 50 | End If 51 | Return _log 52 | End Get 53 | End Property 54 | 55 | ''' 56 | ''' Returns the info about the application. If we are executing in a DLL, we still return the info 57 | ''' about the application, not the DLL. 58 | ''' 59 | Public ReadOnly Property Info() As AssemblyInfo 60 | Get 61 | If _info Is Nothing Then 62 | Dim Assembly As Reflection.Assembly = Reflection.Assembly.GetEntryAssembly() 63 | If Assembly Is Nothing Then 'It can be nothing if we are an add-in or a dll on the web 64 | Assembly = Reflection.Assembly.GetCallingAssembly() 65 | End If 66 | _info = New AssemblyInfo(Assembly) 67 | End If 68 | Return _info 69 | End Get 70 | End Property 71 | 72 | ''' 73 | ''' Gets the information about the current culture used by the current thread. 74 | ''' 75 | Public ReadOnly Property Culture() As Globalization.CultureInfo 76 | Get 77 | Return Threading.Thread.CurrentThread.CurrentCulture 78 | End Get 79 | End Property 80 | 81 | ''' 82 | ''' Gets the information about the current culture used by the Resource 83 | ''' Manager to look up culture-specific resource at run time. 84 | ''' 85 | ''' 86 | ''' The CultureInfo object that represents the culture used by the 87 | ''' Resource Manager to look up culture-specific resources at run time. 88 | ''' 89 | Public ReadOnly Property UICulture() As Globalization.CultureInfo 90 | Get 91 | Return Threading.Thread.CurrentThread.CurrentUICulture 92 | End Get 93 | End Property 94 | 95 | ''' 96 | ''' Changes the culture currently in used by the current thread. 97 | ''' 98 | ''' 99 | ''' CultureInfo constructor will throw exceptions if cultureName is Nothing 100 | ''' or an invalid CultureInfo ID. We are not catching those exceptions. 101 | ''' 102 | Public Sub ChangeCulture(cultureName As String) 103 | Threading.Thread.CurrentThread.CurrentCulture = New Globalization.CultureInfo(cultureName) 104 | End Sub 105 | 106 | ''' 107 | ''' Changes the culture currently used by the Resource Manager to look 108 | ''' up culture-specific resource at runtime. 109 | ''' 110 | ''' 111 | ''' CultureInfo constructor will throw exceptions if cultureName is Nothing 112 | ''' or an invalid CultureInfo ID. We are not catching those exceptions. 113 | ''' 114 | Public Sub ChangeUICulture(cultureName As String) 115 | Threading.Thread.CurrentThread.CurrentUICulture = New Globalization.CultureInfo(cultureName) 116 | End Sub 117 | 118 | Private _log As Logging.Log 'Lazy-initialized and cached log object. 119 | Private _info As AssemblyInfo ' The executing application (the EntryAssembly) 120 | 121 | End Class 122 | 123 | End Namespace 124 | -------------------------------------------------------------------------------- /Community.VisualBasic/ApplicationServices/ConsoleApplicationBase.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | ' See the LICENSE file in the project root for more information. 4 | 5 | Option Strict On 6 | Option Explicit On 7 | 8 | Imports System.ComponentModel 9 | 10 | Namespace Global.Community.VisualBasic.ApplicationServices 11 | 12 | ''' 13 | ''' Abstract class that defines the application Startup/Shutdown model for VB 14 | ''' Windows Applications such as console, winforms, dll, service. 15 | ''' 16 | Public Class ConsoleApplicationBase : Inherits ApplicationBase 17 | 18 | ''' 19 | ''' Constructs the application Shutdown/Startup model object 20 | ''' 21 | ''' We have to have a parameterless constructor because the platform specific Application 22 | ''' object derives from this one and it doesn't define a constructor. The partial class generated by the 23 | ''' designer defines the constructor in order to configure the application. 24 | Public Sub New() 25 | MyBase.New() 26 | End Sub 27 | 28 | ''' 29 | ''' Returns the command line arguments for the current application. 30 | ''' 31 | ''' This function differs from System.Environment.GetCommandLineArgs in that the 32 | ''' path of the executing file (the 0th entry) is omitted from the returned collection 33 | Public ReadOnly Property CommandLineArgs() As ObjectModel.ReadOnlyCollection(Of String) 34 | Get 35 | If _commandLineArgs Is Nothing Then 36 | 'Get rid of Arg(0) which is the path of the executing program. Main(args() as string) doesn't report the name of the app and neither will we 37 | Dim EnvArgs As String() = System.Environment.GetCommandLineArgs 38 | If EnvArgs.GetLength(0) >= 2 Then '1 element means no args, just the executing program. >= 2 means executing program + one or more command line arguments 39 | Dim NewArgs(EnvArgs.GetLength(0) - 2) As String 'dimming z(0) gives a z() of 1 element. 40 | Array.Copy(EnvArgs, 1, NewArgs, 0, EnvArgs.GetLength(0) - 1) 'copy everything but the 0th element (the path of the executing program) 41 | _commandLineArgs = New ObjectModel.ReadOnlyCollection(Of String)(NewArgs) 42 | Else 43 | _commandLineArgs = New ObjectModel.ReadOnlyCollection(Of String)(Array.Empty(Of String)()) 'provide the empty set 44 | End If 45 | End If 46 | Return _commandLineArgs 47 | End Get 48 | End Property 49 | 50 | ''' 51 | ''' Allows derived classes to set what the command line should look like. WindowsFormsApplicationBase calls this 52 | ''' for instance because we snag the command line from Main(). 53 | ''' 54 | 55 | Protected WriteOnly Property InternalCommandLine() As ObjectModel.ReadOnlyCollection(Of String) 56 | Set(value As ObjectModel.ReadOnlyCollection(Of String)) 57 | _commandLineArgs = value 58 | End Set 59 | End Property 60 | 61 | Private _commandLineArgs As ObjectModel.ReadOnlyCollection(Of String) ' Lazy-initialized and cached collection of command line arguments. 62 | 63 | End Class 64 | 65 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/ApplicationServices/User.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | ' See the LICENSE file in the project root for more information. 4 | 5 | Option Explicit On 6 | Option Strict On 7 | 8 | Imports System.ComponentModel 9 | Imports System.Security.Principal 10 | 11 | Namespace Global.Community.VisualBasic.ApplicationServices 12 | 13 | ''' 14 | ''' Class abstracting the computer user 15 | ''' 16 | Public Class User 17 | 18 | ''' 19 | ''' Creates an instance of User 20 | ''' 21 | Public Sub New() 22 | 23 | 'For Windows applications, only projects built on the Windows Application template initialize the 24 | 'My.User object by default. In all other Windows project types, you must initialize the My.User 25 | 'object by calling the InitializeWithWindowsUser method explicitly Or by assigning a value To CurrentPrincipal. 26 | 27 | End Sub 28 | 29 | ''' 30 | ''' The name of the current user 31 | ''' 32 | Public ReadOnly Property Name() As String 33 | Get 34 | Return InternalPrincipal.Identity.Name 35 | End Get 36 | End Property 37 | 38 | ''' 39 | ''' The current IPrincipal which represents the current user 40 | ''' 41 | ''' An IPrincipal representing the current user 42 | 43 | Public Property CurrentPrincipal() As IPrincipal 44 | Get 45 | Return InternalPrincipal 46 | End Get 47 | Set(value As IPrincipal) 48 | InternalPrincipal = value 49 | End Set 50 | End Property 51 | 52 | ''' 53 | ''' Indicates whether or not the current user has been authenticated. 54 | ''' 55 | Public ReadOnly Property IsAuthenticated() As Boolean 56 | Get 57 | Return InternalPrincipal.Identity.IsAuthenticated 58 | End Get 59 | End Property 60 | 61 | ''' 62 | ''' Indicates whether or not the current user is a member of the passed in role 63 | ''' 64 | ''' The name of the role 65 | ''' True if the user is a member of the role otherwise False 66 | Public Function IsInRole(role As String) As Boolean 67 | Return InternalPrincipal.IsInRole(role) 68 | End Function 69 | 70 | ''' 71 | ''' The principal representing the current user. 72 | ''' 73 | ''' An IPrincipal representing the current user 74 | ''' 75 | ''' This should be overridden by derived classes that don't get the current 76 | ''' user from the current thread 77 | ''' 78 | Protected Overridable Property InternalPrincipal() As IPrincipal 79 | Get 80 | Return System.Threading.Thread.CurrentPrincipal 81 | End Get 82 | Set(value As IPrincipal) 83 | System.Threading.Thread.CurrentPrincipal = value 84 | End Set 85 | End Property 86 | 87 | End Class 88 | 89 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/ComClassAttribute.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Imports System 5 | 6 | Namespace Global.Community.VisualBasic 7 | 8 | ''' 9 | ''' ComClass is used by the VB compiler to mark a public class 10 | ''' that will be exposed via COM interop. 11 | ''' 12 | 13 | Public NotInheritable Class ComClassAttribute 14 | Inherits Attribute 15 | 16 | Public Sub New() 17 | End Sub 18 | 19 | Public Sub New(_ClassID As String) 20 | ClassID = _ClassID 21 | End Sub 22 | 23 | Public Sub New(_ClassID As String, _InterfaceID As String) 24 | ClassID = _ClassID 25 | InterfaceID = _InterfaceID 26 | End Sub 27 | 28 | Public Sub New(_ClassID As String, _InterfaceID As String, _EventId As String) 29 | ClassID = _ClassID 30 | InterfaceID = _InterfaceID 31 | EventID = _EventId 32 | End Sub 33 | 34 | Public ReadOnly Property ClassID() As String 35 | 36 | Public ReadOnly Property InterfaceID() As String 37 | 38 | Public ReadOnly Property EventID() As String 39 | 40 | Public Property InterfaceShadows() As Boolean 41 | End Class 42 | 43 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/Community.VisualBasic.vbproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | Community.VisualBasic 5 | netstandard2.0 6 | 7 | 8 | 9 | TARGET_WINDOWS=False, DEBUGRESOURCES=False 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | True 19 | True 20 | Resources.resx 21 | 22 | 23 | 24 | 25 | 26 | My.Resources 27 | VbMyResourcesResXFileCodeGenerator 28 | Resources.Designer.vb 29 | 30 | 31 | 32 | 33 | -------------------------------------------------------------------------------- /Community.VisualBasic/CompilerServices/BooleanType.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Imports System 5 | Imports System.Globalization 6 | 7 | Imports Community.VisualBasic.CompilerServices.Utils 8 | 9 | Namespace Global.Community.VisualBasic.CompilerServices 10 | 11 | 12 | Public NotInheritable Class BooleanType 13 | ' Prevent creation. 14 | Private Sub New() 15 | End Sub 16 | 17 | Public Shared Function FromString(Value As String) As Boolean 18 | 19 | If Value Is Nothing Then 20 | 'For VB6 compatibility, treat Nothing as empty string. 21 | Value = "" 22 | End If 23 | 24 | Try 25 | Dim loc As CultureInfo = GetCultureInfo() 26 | 27 | 'Use untrimmed Value to test for 'True'/'False' 28 | If System.String.Compare(Value, Boolean.FalseString, True, loc) = 0 Then 29 | Return False 30 | ElseIf System.String.Compare(Value, Boolean.TrueString, True, loc) = 0 Then 31 | Return True 32 | End If 33 | 34 | Dim i64Value As Int64 35 | 36 | If IsHexOrOctValue(Value, i64Value) Then 37 | Return CBool(i64Value) 38 | End If 39 | 40 | Return CBool(DoubleType.Parse(Value)) 41 | 42 | Catch e As FormatException 43 | Throw New InvalidCastException(SR.Format(SR.InvalidCast_FromStringTo, Left(Value, 32), "Boolean"), e) 44 | End Try 45 | 46 | End Function 47 | 48 | Public Shared Function FromObject(Value As Object) As Boolean 49 | 50 | If Value Is Nothing Then 51 | Return False 52 | End If 53 | 54 | Dim ValueInterface As IConvertible 55 | Dim ValueTypeCode As TypeCode 56 | 57 | ValueInterface = TryCast(Value, IConvertible) 58 | 59 | If ValueInterface IsNot Nothing Then 60 | 61 | ValueTypeCode = ValueInterface.GetTypeCode() 62 | 63 | Select Case ValueTypeCode 64 | 65 | Case TypeCode.Boolean 66 | If TypeOf Value Is Boolean Then 67 | Return CBool(DirectCast(Value, Boolean)) 68 | Else 69 | Return CBool(ValueInterface.ToBoolean(Nothing)) 70 | End If 71 | 72 | Case TypeCode.Byte 73 | 'Using ToByte also handles enums 74 | If TypeOf Value Is Byte Then 75 | Return CBool(DirectCast(Value, Byte)) 76 | Else 77 | Return CBool(ValueInterface.ToByte(Nothing)) 78 | End If 79 | 80 | Case TypeCode.Int16 81 | If TypeOf Value Is Int16 Then 82 | Return CBool(DirectCast(Value, Int16)) 83 | Else 84 | 'Using ToInt16 also handles enums 85 | Return CBool(ValueInterface.ToInt16(Nothing)) 86 | End If 87 | 88 | Case TypeCode.Int32 89 | If TypeOf Value Is Int32 Then 90 | Return CBool(DirectCast(Value, Int32)) 91 | Else 92 | 'Using ToInt32 also handles enums 93 | Return CBool(ValueInterface.ToInt32(Nothing)) 94 | End If 95 | 96 | Case TypeCode.Int64 97 | If TypeOf Value Is Int64 Then 98 | Return CBool(DirectCast(Value, Int64)) 99 | Else 100 | 'Using ToInt64 also handles enums 101 | Return CBool(ValueInterface.ToInt64(Nothing)) 102 | End If 103 | 104 | Case TypeCode.Single 105 | If TypeOf Value Is Single Then 106 | Return CBool(DirectCast(Value, Single)) 107 | Else 108 | Return CBool(ValueInterface.ToSingle(Nothing)) 109 | End If 110 | 111 | Case TypeCode.Double 112 | If TypeOf Value Is Double Then 113 | Return CBool(DirectCast(Value, Double)) 114 | Else 115 | Return CBool(ValueInterface.ToDouble(Nothing)) 116 | End If 117 | 118 | Case TypeCode.Decimal 119 | Return DecimalToBoolean(ValueInterface) 120 | 121 | Case TypeCode.String 122 | Dim ValueString As String = TryCast(Value, String) 123 | 124 | If ValueString IsNot Nothing Then 125 | Return CBool(BooleanType.FromString(ValueString)) 126 | Else 127 | Return CBool(BooleanType.FromString(ValueInterface.ToString(Nothing))) 128 | End If 129 | Case TypeCode.Char, 130 | TypeCode.DateTime 131 | ' Fall through to error 132 | 133 | Case Else 134 | ' Fall through to error 135 | End Select 136 | End If 137 | 138 | Throw New InvalidCastException(SR.Format(SR.InvalidCast_FromTo, VBFriendlyName(Value), "Boolean")) 139 | End Function 140 | 141 | Private Shared Function DecimalToBoolean(ValueInterface As IConvertible) As Boolean 142 | Return CBool(ValueInterface.ToDecimal(Nothing)) 143 | End Function 144 | 145 | End Class 146 | 147 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/CompilerServices/ByteType.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Imports System 5 | 6 | Imports Community.VisualBasic.CompilerServices.Utils 7 | 8 | Namespace Global.Community.VisualBasic.CompilerServices 9 | 10 | 11 | Public NotInheritable Class ByteType 12 | ' Prevent creation. 13 | Private Sub New() 14 | End Sub 15 | 16 | Public Shared Function FromString(Value As String) As Byte 17 | 18 | If Value Is Nothing Then 19 | Return 0 20 | End If 21 | 22 | Try 23 | Dim i64Value As Int64 24 | 25 | If IsHexOrOctValue(Value, i64Value) Then 26 | Return CByte(i64Value) 27 | End If 28 | 29 | Return CByte(DoubleType.Parse(Value)) 30 | 31 | Catch e As FormatException 32 | Throw New InvalidCastException(SR.Format(SR.InvalidCast_FromStringTo, Left(Value, 32), "Byte"), e) 'UNSIGNED: make these strings constants 33 | End Try 34 | 35 | End Function 36 | 37 | Public Shared Function FromObject(Value As Object) As Byte 38 | 39 | If Value Is Nothing Then 40 | Return 0 41 | End If 42 | 43 | Dim ValueInterface As IConvertible 44 | Dim ValueTypeCode As TypeCode 45 | 46 | ValueInterface = TryCast(Value, IConvertible) 47 | 48 | If ValueInterface Is Nothing Then 49 | GoTo ThrowInvalidCast 50 | End If 51 | 52 | ValueTypeCode = ValueInterface.GetTypeCode() 53 | 54 | Select Case ValueTypeCode 55 | 56 | Case TypeCode.Boolean 57 | Return CByte(ValueInterface.ToBoolean(Nothing)) 58 | 59 | Case TypeCode.Byte 60 | If TypeOf Value Is System.Byte Then 61 | Return CByte(DirectCast(Value, Byte)) 62 | Else 63 | Return CByte(ValueInterface.ToByte(Nothing)) 64 | End If 65 | 66 | Case TypeCode.Int16 67 | If TypeOf Value Is System.Int16 Then 68 | Return CByte(DirectCast(Value, Int16)) 69 | Else 70 | Return CByte(ValueInterface.ToInt16(Nothing)) 71 | End If 72 | 73 | Case TypeCode.Int32 74 | If TypeOf Value Is System.Int32 Then 75 | Return CByte(DirectCast(Value, Int32)) 76 | Else 77 | Return CByte(ValueInterface.ToInt32(Nothing)) 78 | End If 79 | 80 | Case TypeCode.Int64 81 | If TypeOf Value Is System.Int64 Then 82 | Return CByte(DirectCast(Value, Int64)) 83 | Else 84 | Return CByte(ValueInterface.ToInt64(Nothing)) 85 | End If 86 | 87 | Case TypeCode.Single 88 | If TypeOf Value Is System.Single Then 89 | Return CByte(DirectCast(Value, Single)) 90 | Else 91 | Return CByte(ValueInterface.ToSingle(Nothing)) 92 | End If 93 | 94 | Case TypeCode.Double 95 | If TypeOf Value Is System.Double Then 96 | Return CByte(DirectCast(Value, Double)) 97 | Else 98 | Return CByte(ValueInterface.ToDouble(Nothing)) 99 | End If 100 | 101 | Case TypeCode.Decimal 102 | 'Do not use .ToDecimal because of jit temp issue effects all perf 103 | Return DecimalToByte(ValueInterface) 104 | 105 | Case TypeCode.String 106 | Return ByteType.FromString(ValueInterface.ToString(Nothing)) 107 | Case TypeCode.Char, 108 | TypeCode.DateTime 109 | ' Fall through to error 110 | 111 | Case Else 112 | ' Fall through to error 113 | End Select 114 | 115 | ThrowInvalidCast: 116 | Throw New InvalidCastException(SR.Format(SR.InvalidCast_FromTo, VBFriendlyName(Value), "Byte")) 117 | 118 | End Function 119 | 120 | Private Shared Function DecimalToByte(ValueInterface As IConvertible) As Byte 121 | Return CByte(ValueInterface.ToDecimal(Nothing)) 122 | End Function 123 | 124 | End Class 125 | 126 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/CompilerServices/CacheDict.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Imports System.Collections.Generic 5 | Imports System.Runtime.InteropServices 6 | 7 | Namespace Global.Community.VisualBasic.CompilerServices 8 | 9 | ' Implements a MRU collection for caching dynamic methods used in IDO late binding. 10 | Friend Class CacheDict(Of TKey, TValue) 11 | ' The Dictionary to quickly access cached data 12 | Private ReadOnly _dict As Dictionary(Of TKey, KeyInfo) 13 | ' MRU sorted linked list 14 | Private ReadOnly _list As LinkedList(Of TKey) 15 | ' Maximum size 16 | Private ReadOnly _maxSize As Integer 17 | 18 | Friend Sub New(maxSize As Integer) 19 | _dict = New Dictionary(Of TKey, KeyInfo) 20 | _list = New LinkedList(Of TKey) 21 | _maxSize = maxSize 22 | End Sub 23 | 24 | Friend Sub Add(key As TKey, value As TValue) 25 | Dim info As New KeyInfo 26 | If _dict.TryGetValue(key, info) Then 27 | ' If the key is already in the collection, remove it 28 | _list.Remove(info.List) 29 | ElseIf (_list.Count = _maxSize) Then 30 | ' Age out the last element if we hit the max size 31 | Dim last As LinkedListNode(Of TKey) = _list.Last 32 | _list.RemoveLast() 33 | _dict.Remove(last.Value) 34 | End If 35 | 36 | ' Add the new element 37 | Dim node As New LinkedListNode(Of TKey)(key) 38 | _list.AddFirst(node) 39 | _dict.Item(key) = New KeyInfo(value, node) 40 | End Sub 41 | 42 | Friend Function TryGetValue(key As TKey, ByRef value As TValue) As Boolean 43 | Dim info As New KeyInfo 44 | If _dict.TryGetValue(key, info) Then 45 | Dim list As LinkedListNode(Of TKey) = info.List 46 | If (list.Previous IsNot Nothing) Then 47 | _list.Remove(list) 48 | _list.AddFirst(list) 49 | End If 50 | value = info.Value 51 | Return True 52 | End If 53 | value = Nothing 54 | Return False 55 | End Function 56 | 57 | ' KeyInfo to store in the dictionary 58 | Private Structure KeyInfo 59 | Friend ReadOnly Value As TValue 60 | Friend ReadOnly List As LinkedListNode(Of TKey) 61 | 62 | Friend Sub New(v As TValue, l As LinkedListNode(Of TKey)) 63 | Value = v 64 | List = l 65 | End Sub 66 | End Structure 67 | End Class 68 | 69 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/CompilerServices/CharArrayType.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Imports System 5 | 6 | Imports Community.VisualBasic.CompilerServices.Utils 7 | 8 | Namespace Global.Community.VisualBasic.CompilerServices 9 | 10 | 11 | Public NotInheritable Class CharArrayType 12 | ' Prevent creation. 13 | Private Sub New() 14 | End Sub 15 | 16 | Public Shared Function FromString(Value As String) As Char() 17 | 18 | If Value Is Nothing Then 19 | Value = "" 20 | End If 21 | 22 | Return Value.ToCharArray() 23 | 24 | End Function 25 | 26 | Public Shared Function FromObject(Value As Object) As Char() 27 | 28 | If Value Is Nothing Then 29 | Return "".ToCharArray() 30 | End If 31 | 32 | Dim CharArray As Char() = TryCast(Value, Char()) 33 | 34 | If CharArray IsNot Nothing AndAlso CharArray.Rank = 1 Then 35 | Return CharArray 36 | 37 | Else 38 | Dim ValueInterface As IConvertible 39 | ValueInterface = TryCast(Value, IConvertible) 40 | 41 | If ValueInterface IsNot Nothing Then 42 | If (ValueInterface.GetTypeCode() = TypeCode.String) Then 43 | Return ValueInterface.ToString(Nothing).ToCharArray() 44 | End If 45 | End If 46 | 47 | End If 48 | 49 | Throw New InvalidCastException(SR.Format(SR.InvalidCast_FromTo, VBFriendlyName(Value), "Char()")) 50 | 51 | End Function 52 | 53 | End Class 54 | 55 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/CompilerServices/CharType.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Imports System 5 | 6 | Imports Community.VisualBasic.CompilerServices.Utils 7 | 8 | Namespace Global.Community.VisualBasic.CompilerServices 9 | 10 | 11 | Public NotInheritable Class CharType 12 | ' Prevent creation. 13 | Private Sub New() 14 | End Sub 15 | 16 | Public Shared Function FromString(Value As String) As Char 17 | If (Value Is Nothing) OrElse (Value.Length = 0) Then 18 | Return ControlChars.NullChar 19 | End If 20 | 21 | Return Value.Chars(0) 22 | End Function 23 | 24 | Public Shared Function FromObject(Value As Object) As Char 25 | 26 | If Value Is Nothing Then 27 | Return ChrW(0) 28 | End If 29 | 30 | Dim ValueInterface As IConvertible 31 | Dim ValueTypeCode As TypeCode 32 | 33 | ValueInterface = TryCast(Value, IConvertible) 34 | 35 | If ValueInterface IsNot Nothing Then 36 | 37 | ValueTypeCode = ValueInterface.GetTypeCode() 38 | 39 | Select Case ValueTypeCode 40 | Case TypeCode.Char 41 | Return ValueInterface.ToChar(Nothing) 42 | 43 | Case TypeCode.String 44 | Return CharType.FromString(ValueInterface.ToString(Nothing)) 45 | 46 | Case TypeCode.Boolean, 47 | TypeCode.Byte, 48 | TypeCode.Int16, 49 | TypeCode.Int32, 50 | TypeCode.Int64, 51 | TypeCode.Single, 52 | TypeCode.Double, 53 | TypeCode.Decimal, 54 | TypeCode.DateTime 55 | ' Fall through to error 56 | 57 | Case Else 58 | ' Fall through to error 59 | End Select 60 | End If 61 | 62 | Throw New InvalidCastException(SR.Format(SR.InvalidCast_FromTo, VBFriendlyName(Value), "Char")) 63 | End Function 64 | 65 | End Class 66 | 67 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/CompilerServices/DateType.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Imports System 5 | Imports System.Globalization 6 | 7 | Imports Community.VisualBasic.CompilerServices.Utils 8 | 9 | Namespace Global.Community.VisualBasic.CompilerServices 10 | 11 | 12 | Public NotInheritable Class DateType 13 | ' Prevent creation. 14 | Private Sub New() 15 | End Sub 16 | 17 | Public Shared Function FromString(Value As String) As Date 18 | Return DateType.FromString(Value, GetCultureInfo()) 19 | End Function 20 | 21 | Public Shared Function FromString(Value As String, culture As Globalization.CultureInfo) As Date 22 | If culture IsNot Nothing Then 23 | End If 24 | Dim ParsedDate As System.DateTime 25 | 26 | If TryParse(Value, ParsedDate) Then 27 | Return ParsedDate 28 | Else 29 | 'Truncate the string to 32 characters for the message 30 | Throw New InvalidCastException(SR.Format(SR.InvalidCast_FromStringTo, Left(Value, 32), "Date")) 31 | End If 32 | End Function 33 | 34 | Public Shared Function FromObject(Value As Object) As Date 35 | 36 | If Value Is Nothing Then 37 | Return Nothing 38 | End If 39 | 40 | Dim ValueInterface As IConvertible 41 | Dim ValueTypeCode As TypeCode 42 | 43 | ValueInterface = TryCast(Value, IConvertible) 44 | 45 | If ValueInterface IsNot Nothing Then 46 | 47 | ValueTypeCode = ValueInterface.GetTypeCode() 48 | 49 | Select Case ValueTypeCode 50 | Case TypeCode.DateTime 51 | Return ValueInterface.ToDateTime(Nothing) 52 | 53 | Case TypeCode.String 54 | Return DateType.FromString(ValueInterface.ToString(Nothing), GetCultureInfo()) 55 | 56 | Case TypeCode.Boolean, 57 | TypeCode.Byte, 58 | TypeCode.Int16, 59 | TypeCode.Int32, 60 | TypeCode.Int64, 61 | TypeCode.Single, 62 | TypeCode.Double, 63 | TypeCode.Decimal, 64 | TypeCode.Char 65 | ' Fall through to error 66 | 67 | Case Else 68 | ' Fall through to error 69 | End Select 70 | 71 | End If 72 | 73 | Throw New InvalidCastException(SR.Format(SR.InvalidCast_FromTo, VBFriendlyName(Value), "Date")) 74 | End Function 75 | 76 | Friend Shared Function TryParse(Value As String, ByRef Result As System.DateTime) As Boolean 77 | Const ParseStyle As DateTimeStyles = 78 | DateTimeStyles.AllowWhiteSpaces Or 79 | DateTimeStyles.NoCurrentDateDefault 80 | Dim Culture As CultureInfo = GetCultureInfo() 81 | Return System.DateTime.TryParse(ToHalfwidthNumbers(Value, Culture), Culture, ParseStyle, Result) 82 | End Function 83 | 84 | End Class 85 | 86 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/CompilerServices/IOUtils.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Imports System 5 | Imports System.Security 6 | Imports System.IO 7 | 8 | Imports Community.VisualBasic.CompilerServices.ExceptionUtils 9 | 10 | Namespace Global.Community.VisualBasic.CompilerServices 11 | 12 | 13 | Class IOUtils 14 | ' Prevent creation. 15 | Private Sub New() 16 | End Sub 17 | 18 | Friend Shared Function FindFirstFile(assem As System.Reflection.Assembly, PathName As String, Attributes As IO.FileAttributes) As String 19 | Dim Dir As DirectoryInfo 20 | Dim DirName As String = Nothing 21 | Dim FileName As String 22 | Dim files() As FileSystemInfo 23 | Dim oAssemblyData As AssemblyData 24 | Const DiskNotReadyError As Integer = &H80070015 25 | 26 | If PathName.Length > 0 AndAlso PathName.Chars(PathName.Length - 1) = Path.DirectorySeparatorChar Then 27 | DirName = Path.GetFullPath(PathName) 28 | FileName = "*.*" 29 | Else 30 | If PathName.Length = 0 Then 31 | FileName = "*.*" 32 | Else 33 | FileName = Path.GetFileName(PathName) 34 | DirName = Path.GetDirectoryName(PathName) 35 | 36 | If (FileName Is Nothing) OrElse (FileName.Length = 0) OrElse (FileName = ".") Then 37 | FileName = "*.*" 38 | End If 39 | End If 40 | 41 | If (DirName Is Nothing) OrElse (DirName.Length = 0) Then 42 | If Path.IsPathRooted(PathName) Then 43 | DirName = Path.GetPathRoot(PathName) 44 | Else 45 | DirName = Environment.CurrentDirectory 46 | If DirName.Chars(DirName.Length - 1) <> Path.DirectorySeparatorChar Then 47 | DirName &= Path.DirectorySeparatorChar 48 | End If 49 | End If 50 | Else 51 | If DirName.Chars(DirName.Length - 1) <> Path.DirectorySeparatorChar Then 52 | DirName &= Path.DirectorySeparatorChar 53 | End If 54 | End If 55 | 56 | If FileName = ".." Then 57 | DirName &= "..\" 58 | FileName = "*.*" 59 | End If 60 | End If 61 | 62 | Try 63 | Dir = Directory.GetParent(DirName & FileName) 64 | files = Dir.GetFileSystemInfos(FileName) 65 | Catch ex As SecurityException 66 | Throw ex 67 | Catch IOex As IOException When _ 68 | (System.Runtime.InteropServices.Marshal.GetHRForException(IOex) = DiskNotReadyError) 69 | Throw VbMakeException(vbErrors.BadFileNameOrNumber) 70 | Catch ex As StackOverflowException 71 | Throw ex 72 | Catch ex As OutOfMemoryException 73 | Throw ex 74 | Catch 75 | Return "" 76 | End Try 77 | 78 | oAssemblyData = ProjectData.GetProjectData().GetAssemblyData(assem) 79 | oAssemblyData.m_DirFiles = files 80 | oAssemblyData.m_DirNextFileIndex = 0 81 | oAssemblyData.m_DirAttributes = Attributes 82 | 83 | If (files Is Nothing) OrElse (files.Length = 0) Then 84 | Return "" 85 | End If 86 | 87 | Return FindFileFilter(oAssemblyData) 88 | End Function 89 | 90 | Friend Shared Function FindNextFile(assem As System.Reflection.Assembly) As String 91 | Dim oAssemblyData As AssemblyData 92 | 93 | oAssemblyData = ProjectData.GetProjectData().GetAssemblyData(assem) 94 | 95 | If oAssemblyData.m_DirFiles Is Nothing Then 96 | Throw New ArgumentException(SR.DIR_IllegalCall) 97 | End If 98 | 99 | If oAssemblyData.m_DirNextFileIndex > oAssemblyData.m_DirFiles.GetUpperBound(0) Then 100 | 'Prevent hitting the security check in this scenario 101 | oAssemblyData.m_DirFiles = Nothing 102 | oAssemblyData.m_DirNextFileIndex = 0 103 | Return Nothing 104 | End If 105 | 106 | Return FindFileFilter(oAssemblyData) 107 | End Function 108 | 109 | Private Shared Function FindFileFilter(oAssemblyData As AssemblyData) As String 110 | Dim Index As Integer 111 | Dim files() As FileSystemInfo 112 | Dim file As FileSystemInfo 113 | 114 | files = oAssemblyData.m_DirFiles 115 | Index = oAssemblyData.m_DirNextFileIndex 116 | 117 | Do While True 118 | If Index > files.GetUpperBound(0) Then 119 | oAssemblyData.m_DirFiles = Nothing 120 | oAssemblyData.m_DirNextFileIndex = 0 121 | Return Nothing 122 | End If 123 | 124 | file = files(Index) 125 | 126 | If ((file.Attributes And (FileAttributes.Directory Or FileAttributes.System Or FileAttributes.Hidden)) = 0) OrElse 127 | ((file.Attributes And oAssemblyData.m_DirAttributes) <> 0) Then 128 | oAssemblyData.m_DirNextFileIndex = Index + 1 129 | Return files(Index).Name 130 | End If 131 | 132 | Index += 1 133 | Loop 134 | Return Nothing 135 | End Function 136 | 137 | End Class 138 | 139 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/CompilerServices/IntegerType.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Imports System 5 | 6 | Imports Community.VisualBasic.CompilerServices.Utils 7 | 8 | Namespace Global.Community.VisualBasic.CompilerServices 9 | 10 | 11 | Public NotInheritable Class IntegerType 12 | ' Prevent creation. 13 | Private Sub New() 14 | End Sub 15 | 16 | Public Shared Function FromString(Value As String) As Integer 17 | 18 | If Value Is Nothing Then 19 | Return 0 20 | End If 21 | 22 | Try 23 | Dim i64Value As Int64 24 | 25 | If IsHexOrOctValue(Value, i64Value) Then 26 | Return CInt(i64Value) 27 | End If 28 | 29 | Return CInt(DoubleType.Parse(Value)) 30 | 31 | Catch e As FormatException 32 | Throw New InvalidCastException(SR.Format(SR.InvalidCast_FromStringTo, Left(Value, 32), "Integer"), e) 33 | End Try 34 | 35 | End Function 36 | 37 | Public Shared Function FromObject(Value As Object) As Integer 38 | 39 | If Value Is Nothing Then 40 | Return 0 41 | End If 42 | 43 | Dim ValueInterface As IConvertible 44 | Dim ValueTypeCode As TypeCode 45 | 46 | ValueInterface = TryCast(Value, IConvertible) 47 | 48 | If ValueInterface Is Nothing Then 49 | GoTo ThrowInvalidCast 50 | End If 51 | 52 | ValueTypeCode = ValueInterface.GetTypeCode() 53 | 54 | Select Case ValueTypeCode 55 | 56 | Case TypeCode.Boolean 57 | Return CInt(ValueInterface.ToBoolean(Nothing)) 58 | 59 | Case TypeCode.Byte 60 | If TypeOf Value Is System.Byte Then 61 | Return CInt(DirectCast(Value, Byte)) 62 | Else 63 | Return CInt(ValueInterface.ToByte(Nothing)) 64 | End If 65 | 66 | Case TypeCode.Int16 67 | If TypeOf Value Is System.Int16 Then 68 | Return CInt(DirectCast(Value, Int16)) 69 | Else 70 | Return CInt(ValueInterface.ToInt16(Nothing)) 71 | End If 72 | 73 | Case TypeCode.Int32 74 | If TypeOf Value Is System.Int32 Then 75 | Return CInt(DirectCast(Value, Int32)) 76 | Else 77 | Return CInt(ValueInterface.ToInt32(Nothing)) 78 | End If 79 | 80 | Case TypeCode.Int64 81 | If TypeOf Value Is System.Int64 Then 82 | Return CInt(DirectCast(Value, Int64)) 83 | Else 84 | Return CInt(ValueInterface.ToInt64(Nothing)) 85 | End If 86 | 87 | Case TypeCode.Single 88 | If TypeOf Value Is System.Single Then 89 | Return CInt(DirectCast(Value, Single)) 90 | Else 91 | Return CInt(ValueInterface.ToSingle(Nothing)) 92 | End If 93 | 94 | Case TypeCode.Double 95 | If TypeOf Value Is System.Double Then 96 | Return CInt(DirectCast(Value, Double)) 97 | Else 98 | Return CInt(ValueInterface.ToDouble(Nothing)) 99 | End If 100 | 101 | Case TypeCode.Decimal 102 | 'Do not use .ToDecimal because of jit temp issue effects all perf 103 | Return DecimalToInteger(ValueInterface) 104 | 105 | Case TypeCode.String 106 | Return IntegerType.FromString(ValueInterface.ToString(Nothing)) 107 | Case TypeCode.Char, 108 | TypeCode.DateTime 109 | ' Fall through to error 110 | 111 | Case Else 112 | ' Fall through to error 113 | End Select 114 | ThrowInvalidCast: 115 | Throw New InvalidCastException(SR.Format(SR.InvalidCast_FromTo, VBFriendlyName(Value), "Integer")) 116 | End Function 117 | 118 | Private Shared Function DecimalToInteger(ValueInterface As IConvertible) As Integer 119 | Return CInt(ValueInterface.ToDecimal(Nothing)) 120 | End Function 121 | 122 | End Class 123 | 124 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/CompilerServices/LongType.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Imports System 5 | 6 | Imports Community.VisualBasic.CompilerServices.Utils 7 | 8 | Namespace Global.Community.VisualBasic.CompilerServices 9 | 10 | 11 | Public NotInheritable Class LongType 12 | ' Prevent creation. 13 | Private Sub New() 14 | End Sub 15 | 16 | Public Shared Function FromString(Value As String) As Long 17 | 18 | If (Value Is Nothing) Then 19 | Return 0 20 | End If 21 | 22 | Try 23 | Dim i64Value As Int64 24 | 25 | If IsHexOrOctValue(Value, i64Value) Then 26 | Return CLng(i64Value) 27 | End If 28 | 29 | 'Using Decimal parse so that we full range of Int64 30 | ' and still get currency and thousands parsing 31 | Return CLng(DecimalType.Parse(Value, Nothing)) 32 | 33 | 34 | Catch e As FormatException 35 | Throw New InvalidCastException(SR.Format(SR.InvalidCast_FromStringTo, Left(Value, 32), "Long"), e) 36 | End Try 37 | 38 | End Function 39 | 40 | Public Shared Function FromObject(Value As Object) As Long 41 | 42 | If Value Is Nothing Then 43 | Return 0L 44 | End If 45 | 46 | Dim ValueInterface As IConvertible 47 | Dim ValueTypeCode As TypeCode 48 | 49 | ValueInterface = TryCast(Value, IConvertible) 50 | 51 | If ValueInterface Is Nothing Then 52 | GoTo ThrowInvalidCast 53 | End If 54 | 55 | ValueTypeCode = ValueInterface.GetTypeCode() 56 | 57 | Select Case ValueTypeCode 58 | 59 | Case TypeCode.Boolean 60 | Return CLng(ValueInterface.ToBoolean(Nothing)) 61 | 62 | Case TypeCode.Byte 63 | If TypeOf Value Is System.Byte Then 64 | Return CLng(DirectCast(Value, Byte)) 65 | Else 66 | Return CLng(ValueInterface.ToByte(Nothing)) 67 | End If 68 | 69 | Case TypeCode.Int16 70 | If TypeOf Value Is System.Int16 Then 71 | Return CLng(DirectCast(Value, Int16)) 72 | Else 73 | Return CLng(ValueInterface.ToInt16(Nothing)) 74 | End If 75 | 76 | Case TypeCode.Int32 77 | If TypeOf Value Is System.Int32 Then 78 | Return CLng(DirectCast(Value, Int32)) 79 | Else 80 | Return CLng(ValueInterface.ToInt32(Nothing)) 81 | End If 82 | 83 | Case TypeCode.Int64 84 | If TypeOf Value Is System.Int64 Then 85 | Return CLng(DirectCast(Value, Int64)) 86 | Else 87 | Return CLng(ValueInterface.ToInt64(Nothing)) 88 | End If 89 | 90 | Case TypeCode.Single 91 | If TypeOf Value Is System.Single Then 92 | Return CLng(DirectCast(Value, Single)) 93 | Else 94 | Return CLng(ValueInterface.ToSingle(Nothing)) 95 | End If 96 | 97 | Case TypeCode.Double 98 | If TypeOf Value Is System.Double Then 99 | Return CLng(DirectCast(Value, Double)) 100 | Else 101 | Return CLng(ValueInterface.ToDouble(Nothing)) 102 | End If 103 | 104 | Case TypeCode.Decimal 105 | 'Do not use .ToDecimal because of jit temp issue effects all perf 106 | Return DecimalToLong(ValueInterface) 107 | 108 | Case TypeCode.String 109 | Return LongType.FromString(ValueInterface.ToString(Nothing)) 110 | Case TypeCode.Char, 111 | TypeCode.DateTime 112 | ' Fall through to error 113 | 114 | Case Else 115 | ' Fall through to error 116 | End Select 117 | ThrowInvalidCast: 118 | Throw New InvalidCastException(SR.Format(SR.InvalidCast_FromTo, VBFriendlyName(Value), "Long")) 119 | End Function 120 | 121 | Private Shared Function DecimalToLong(ValueInterface As IConvertible) As Long 122 | Return CLng(ValueInterface.ToDecimal(Nothing)) 123 | End Function 124 | 125 | End Class 126 | 127 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/CompilerServices/ShortType.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Imports System 5 | 6 | Imports Community.VisualBasic.CompilerServices.Utils 7 | 8 | Namespace Global.Community.VisualBasic.CompilerServices 9 | 10 | 11 | Public NotInheritable Class ShortType 12 | 13 | ' Prevent creation. 14 | Private Sub New() 15 | End Sub 16 | 17 | Public Shared Function FromString(Value As String) As Short 18 | 19 | If Value Is Nothing Then 20 | Return 0 21 | End If 22 | 23 | Try 24 | Dim i64Value As Int64 25 | 26 | If IsHexOrOctValue(Value, i64Value) Then 27 | Return CShort(i64Value) 28 | End If 29 | 30 | Return CShort(DoubleType.Parse(Value)) 31 | 32 | Catch e As FormatException 33 | Throw New InvalidCastException(SR.Format(SR.InvalidCast_FromStringTo, Left(Value, 32), "Short"), e) 34 | End Try 35 | 36 | End Function 37 | 38 | Public Shared Function FromObject(Value As Object) As Short 39 | 40 | If Value Is Nothing Then 41 | Return 0S 42 | End If 43 | 44 | Dim ValueInterface As IConvertible 45 | Dim ValueTypeCode As TypeCode 46 | 47 | ValueInterface = TryCast(Value, IConvertible) 48 | 49 | If ValueInterface Is Nothing Then 50 | GoTo ThrowInvalidCast 51 | End If 52 | 53 | ValueTypeCode = ValueInterface.GetTypeCode() 54 | 55 | Select Case ValueTypeCode 56 | 57 | Case TypeCode.Boolean 58 | Return CShort(ValueInterface.ToBoolean(Nothing)) 59 | 60 | Case TypeCode.Byte 61 | If TypeOf Value Is System.Byte Then 62 | Return CShort(DirectCast(Value, Byte)) 63 | Else 64 | Return CShort(ValueInterface.ToByte(Nothing)) 65 | End If 66 | 67 | Case TypeCode.Int16 68 | If TypeOf Value Is System.Int16 Then 69 | Return CShort(DirectCast(Value, Int16)) 70 | Else 71 | Return CShort(ValueInterface.ToInt16(Nothing)) 72 | End If 73 | 74 | Case TypeCode.Int32 75 | If TypeOf Value Is System.Int32 Then 76 | Return CShort(DirectCast(Value, Int32)) 77 | Else 78 | Return CShort(ValueInterface.ToInt32(Nothing)) 79 | End If 80 | 81 | Case TypeCode.Int64 82 | If TypeOf Value Is System.Int64 Then 83 | Return CShort(DirectCast(Value, Int64)) 84 | Else 85 | Return CShort(ValueInterface.ToInt64(Nothing)) 86 | End If 87 | 88 | Case TypeCode.Single 89 | If TypeOf Value Is System.Single Then 90 | Return CShort(DirectCast(Value, Single)) 91 | Else 92 | Return CShort(ValueInterface.ToSingle(Nothing)) 93 | End If 94 | 95 | Case TypeCode.Double 96 | If TypeOf Value Is System.Double Then 97 | Return CShort(DirectCast(Value, Double)) 98 | Else 99 | Return CShort(ValueInterface.ToDouble(Nothing)) 100 | End If 101 | 102 | Case TypeCode.Decimal 103 | 'Do not use .ToDecimal because of jit temp issue effects all perf 104 | Return DecimalToShort(ValueInterface) 105 | 106 | Case TypeCode.String 107 | Return ShortType.FromString(ValueInterface.ToString(Nothing)) 108 | Case TypeCode.Char, 109 | TypeCode.DateTime 110 | ' Fall through to error 111 | 112 | Case Else 113 | ' Fall through to error 114 | End Select 115 | ThrowInvalidCast: 116 | Throw New InvalidCastException(SR.Format(SR.InvalidCast_FromTo, VBFriendlyName(Value), "Short")) 117 | 118 | End Function 119 | 120 | Private Shared Function DecimalToShort(ValueInterface As IConvertible) As Short 121 | Return CShort(ValueInterface.ToDecimal(Nothing)) 122 | End Function 123 | 124 | End Class 125 | 126 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/CompilerServices/SingleType.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Imports System 5 | Imports System.Globalization 6 | 7 | Imports Community.VisualBasic.CompilerServices.Utils 8 | 9 | Namespace Global.Community.VisualBasic.CompilerServices 10 | 11 | 12 | Public NotInheritable Class SingleType 13 | ' Prevent creation. 14 | Private Sub New() 15 | End Sub 16 | 17 | Public Shared Function FromString(Value As String) As Single 18 | Return FromString(Value, Nothing) 19 | End Function 20 | 21 | Public Shared Function FromString(Value As String, NumberFormat As NumberFormatInfo) As Single 22 | 23 | If Value Is Nothing Then 24 | Return 0 25 | End If 26 | 27 | Try 28 | Dim i64Value As Int64 29 | 30 | If IsHexOrOctValue(Value, i64Value) Then 31 | Return CSng(i64Value) 32 | End If 33 | 34 | Dim Result As Double = DoubleType.Parse(Value, NumberFormat) 35 | If (Result < System.Single.MinValue OrElse Result > System.Single.MaxValue) AndAlso 36 | Not System.Double.IsInfinity(Result) Then 37 | Throw New OverflowException 38 | End If 39 | Return CSng(Result) 40 | 41 | Catch e As FormatException 42 | Throw New InvalidCastException(SR.Format(SR.InvalidCast_FromStringTo, Left(Value, 32), "Single"), e) 43 | End Try 44 | 45 | End Function 46 | 47 | Public Shared Function FromObject(Value As Object) As Single 48 | Return FromObject(Value, Nothing) 49 | End Function 50 | 51 | Public Shared Function FromObject(Value As Object, NumberFormat As NumberFormatInfo) As Single 52 | 53 | If Value Is Nothing Then 54 | Return 0 55 | End If 56 | 57 | Dim ValueInterface As IConvertible 58 | Dim ValueTypeCode As TypeCode 59 | 60 | ValueInterface = TryCast(Value, IConvertible) 61 | 62 | If ValueInterface Is Nothing Then 63 | GoTo ThrowInvalidCast 64 | End If 65 | 66 | ValueTypeCode = ValueInterface.GetTypeCode() 67 | 68 | Select Case ValueTypeCode 69 | 70 | Case TypeCode.Boolean 71 | Return CSng(ValueInterface.ToBoolean(Nothing)) 72 | 73 | Case TypeCode.Byte 74 | If TypeOf Value Is System.Byte Then 75 | Return CSng(DirectCast(Value, Byte)) 76 | Else 77 | Return CSng(ValueInterface.ToByte(Nothing)) 78 | End If 79 | 80 | Case TypeCode.Int16 81 | If TypeOf Value Is System.Int16 Then 82 | Return CSng(DirectCast(Value, Int16)) 83 | Else 84 | Return CSng(ValueInterface.ToInt16(Nothing)) 85 | End If 86 | 87 | Case TypeCode.Int32 88 | If TypeOf Value Is System.Int32 Then 89 | Return CSng(DirectCast(Value, Int32)) 90 | Else 91 | Return CSng(ValueInterface.ToInt32(Nothing)) 92 | End If 93 | 94 | Case TypeCode.Int64 95 | If TypeOf Value Is System.Int64 Then 96 | Return CSng(DirectCast(Value, Int64)) 97 | Else 98 | Return CSng(ValueInterface.ToInt64(Nothing)) 99 | End If 100 | 101 | Case TypeCode.Single 102 | If TypeOf Value Is System.Single Then 103 | Return DirectCast(Value, Single) 104 | Else 105 | Return ValueInterface.ToSingle(Nothing) 106 | End If 107 | 108 | Case TypeCode.Double 109 | If TypeOf Value Is System.Double Then 110 | Return CSng(DirectCast(Value, Double)) 111 | Else 112 | Return CSng(ValueInterface.ToDouble(Nothing)) 113 | End If 114 | 115 | Case TypeCode.Decimal 116 | 'Do not use .ToDecimal because of jit temp issue effects all perf 117 | Return DecimalToSingle(ValueInterface) 118 | 119 | Case TypeCode.String 120 | Return SingleType.FromString(ValueInterface.ToString(Nothing), NumberFormat) 121 | 122 | Case TypeCode.Char, 123 | TypeCode.DateTime 124 | ' Fall through to error 125 | 126 | Case Else 127 | ' Fall through to error 128 | End Select 129 | 130 | ThrowInvalidCast: 131 | Throw New InvalidCastException(SR.Format(SR.InvalidCast_FromTo, VBFriendlyName(Value), "Single")) 132 | End Function 133 | 134 | Private Shared Function DecimalToSingle(ValueInterface As IConvertible) As Single 135 | Return CSng(ValueInterface.ToDecimal(Nothing)) 136 | End Function 137 | 138 | End Class 139 | 140 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/CompilerServices/VB6OutputFile.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Imports System 5 | Imports System.IO 6 | Imports System.Security 7 | 8 | Imports Community.VisualBasic.CompilerServices.ExceptionUtils 9 | Imports Community.VisualBasic.CompilerServices.Utils 10 | 11 | Namespace Global.Community.VisualBasic.CompilerServices 12 | 13 | 14 | Friend Class VB6OutputFile 15 | 16 | '============================================================================ 17 | ' Declarations 18 | '============================================================================ 19 | Inherits VB6File 20 | 21 | '============================================================================ 22 | ' Constructor 23 | '============================================================================ 24 | Friend Sub New() 25 | MyBase.New() 26 | End Sub 27 | 28 | Friend Sub New(FileName As String, share As OpenShare, fAppend As Boolean) 29 | MyBase.New(FileName, OpenAccess.Write, share, -1) 30 | m_fAppend = fAppend 31 | End Sub 32 | 33 | '============================================================================ 34 | ' Operations 35 | '============================================================================ 36 | Friend Overrides Sub OpenFile() 37 | 'MyBase.OpenFile() 38 | 39 | Try 40 | If m_fAppend Then 41 | 'consider checking WRITE if cannot open READWRITE 42 | If File.Exists(m_sFullPath) Then 43 | m_file = New FileStream(m_sFullPath, FileMode.Open, CType(m_access, FileAccess), CType(m_share, FileShare)) 44 | Else 45 | m_file = New FileStream(m_sFullPath, FileMode.Create, CType(m_access, FileAccess), CType(m_share, FileShare)) 46 | End If 47 | Else 48 | m_file = New FileStream(m_sFullPath, FileMode.Create, CType(m_access, FileAccess), CType(m_share, FileShare)) 49 | End If 50 | Catch ex As FileNotFoundException 51 | Throw VbMakeException(ex, vbErrors.FileNotFound) 52 | Catch ex As SecurityException 53 | Throw VbMakeException(ex, vbErrors.FileNotFound) 54 | Catch ex As DirectoryNotFoundException 55 | Throw VbMakeException(ex, vbErrors.PathNotFound) 56 | Catch ex As IOException 57 | Throw VbMakeException(ex, vbErrors.PathFileAccess) 58 | End Try 59 | 60 | m_Encoding = GetFileIOEncoding() 61 | m_sw = New StreamWriter(m_file, m_Encoding) With { 62 | .AutoFlush = True 63 | } 64 | 65 | If m_fAppend Then 66 | 'Now position at end of file 67 | Dim lEndOfFile As Long 68 | lEndOfFile = m_file.Length 69 | m_file.Position = lEndOfFile 70 | m_position = lEndOfFile 71 | End If 72 | End Sub 73 | 74 | Friend Overrides Sub WriteLine(s As String) 75 | If s Is Nothing Then 76 | m_sw.WriteLine() 77 | m_position += 2 78 | Else 79 | If m_bPrint AndAlso (m_lWidth <> 0) Then 80 | If m_lCurrentColumn >= m_lWidth Then 81 | m_sw.WriteLine() 82 | m_position += 2 83 | End If 84 | End If 85 | 86 | m_sw.WriteLine(s) 87 | Diagnostics.Debug.Assert(m_Encoding IsNot Nothing) 88 | m_position += m_Encoding.GetByteCount(s) + 2 89 | End If 90 | 91 | m_lCurrentColumn = 0 92 | End Sub 93 | 94 | Friend Overrides Sub WriteString(s As String) 95 | If (s Is Nothing) OrElse (s.Length = 0) Then 96 | Exit Sub 97 | End If 98 | 99 | If m_bPrint AndAlso (m_lWidth <> 0) Then 100 | If (m_lCurrentColumn >= m_lWidth) OrElse 101 | (m_lCurrentColumn <> 0 AndAlso (m_lCurrentColumn + s.Length) > m_lWidth) Then 102 | m_sw.WriteLine() 103 | m_position += 2 104 | m_lCurrentColumn = 0 105 | End If 106 | End If 107 | 108 | m_sw.Write(s) 109 | Diagnostics.Debug.Assert(m_Encoding IsNot Nothing) 110 | Dim ByteLength As Integer = m_Encoding.GetByteCount(s) 111 | m_position += ByteLength 112 | m_lCurrentColumn += s.Length 113 | End Sub 114 | 115 | Friend Overrides Function CanWrite() As Boolean 116 | CanWrite = True 117 | End Function 118 | 119 | Public Overrides Function GetMode() As OpenMode 120 | If m_fAppend Then 121 | GetMode = OpenMode.Append 122 | Else 123 | GetMode = OpenMode.Output 124 | End If 125 | End Function 126 | 127 | Friend Overrides Function EOF() As Boolean 128 | EOF = True 129 | End Function 130 | 131 | Friend Overrides Function LOC() As Long 132 | Return ((m_position + 127) \ 128) 133 | End Function 134 | 135 | End Class 136 | 137 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/ControlChars.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Namespace Global.Community.VisualBasic 5 | 6 | ' Constants for the Control Characters 7 | Public NotInheritable Class ControlChars 8 | Public Const CrLf As String = ChrW(13) & ChrW(10) 9 | Public Const NewLine As String = ChrW(13) & ChrW(10) 10 | Public Const Cr As Char = ChrW(13) 11 | Public Const Lf As Char = ChrW(10) 12 | Public Const Back As Char = ChrW(8) 13 | Public Const FormFeed As Char = ChrW(12) 14 | Public Const [Tab] As Char = ChrW(9) 15 | Public Const VerticalTab As Char = ChrW(11) 16 | Public Const NullChar As Char = ChrW(0) 17 | Public Const Quote As Char = ChrW(34) 18 | End Class 19 | 20 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/Devices/Computer/Clock.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | ' See the LICENSE file in the project root for more information. 4 | 5 | Option Strict On 6 | Option Explicit On 7 | 8 | Namespace Global.Community.VisualBasic.Devices 9 | 10 | ''' 11 | ''' A wrapper object that acts as a discovery mechanism to quickly find out 12 | ''' the current local time of the machine and the GMT time. 13 | ''' 14 | Public Class Clock 15 | 16 | ''' 17 | ''' Gets a Date that is the current local date and time on this computer. 18 | ''' 19 | ''' A Date whose value is the current date and time. 20 | Public ReadOnly Property LocalTime() As Date 21 | Get 22 | Return Date.Now 23 | End Get 24 | End Property 25 | 26 | ''' 27 | ''' Gets a DateTime that is the current local date and time on this 28 | ''' computer expressed as GMT time. 29 | ''' 30 | ''' A Date whose value is the current date and time expressed as GMT time. 31 | Public ReadOnly Property GmtTime() As Date 32 | Get 33 | Return Date.UtcNow 34 | End Get 35 | End Property 36 | 37 | ''' 38 | ''' This property wraps the Environment.TickCount property to get the 39 | ''' number of milliseconds elapsed since the system started. 40 | ''' 41 | ''' An Integer containing the amount of time in milliseconds. 42 | Public ReadOnly Property TickCount() As Integer 43 | Get 44 | Return Environment.TickCount 45 | End Get 46 | End Property 47 | 48 | End Class 49 | 50 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/Devices/Computer/Computer.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | ' See the LICENSE file in the project root for more information. 4 | 5 | Option Strict On 6 | Option Explicit On 7 | 8 | Imports Community.VisualBasic.MyServices 9 | 10 | Namespace Global.Community.VisualBasic.Devices 11 | 12 | ''' 13 | ''' A RAD object representing the 'computer' that serves as a discovery 14 | ''' mechanism for finding principle abstractions in the system that you can 15 | ''' code against such as the file system, the clipboard, performance 16 | ''' counters, etc. It also provides functionality you would expect to see 17 | ''' associated with the computer such as playing sound, timers, access to 18 | ''' environment variables, etc. This class represent a general computer 19 | ''' available from a Windows Application, Web app, Dll library, etc. 20 | ''' 21 | Public Class Computer : Inherits ServerComputer 22 | 23 | Private _audio As Audio 'Lazy initialized cache for the Audio class. 24 | Private Shared s_mouse As Mouse 'Lazy initialized cache for the Mouse class. SHARED because Mouse behaves as a ReadOnly singleton class 25 | Private Shared s_keyboardInstance As Keyboard 'Lazy initialized cache for the Keyboard class. SHARED because Keyboard behaves as a ReadOnly singleton class 26 | Private Shared s_clipboard As ClipboardProxy 'Lazy initialized cache for the clipboard class. (proxies can be shared - they have no state) 27 | 28 | 'NOTE: The .Net design guidelines state that access to Instance members does not have to be thread-safe. Access to Shared members does have to be thread-safe. 29 | 'Since My.Computer creates the instance of Computer in a thread-safe way, access to the Computer will necessarily be thread-safe. 30 | 'There is nothing to prevent a user from passing our computer object across threads or creating their own instance and then getting into trouble. 31 | ' But that is completely consistent with the rest of the FX design. It is MY.* that is thread safe and leads to best practice access to these objects. 32 | ' If you dim them up yourself, you are responsible for managing the threading. 33 | 34 | ''' 35 | ''' Gets an Audio object which can play sound files or resources. 36 | ''' 37 | ''' A sound object. 38 | Public ReadOnly Property Audio() As Audio 39 | Get 40 | If _audio IsNot Nothing Then Return _audio 41 | _audio = New Audio() 42 | Return _audio 43 | End Get 44 | End Property 45 | 46 | ''' 47 | ''' A thin wrapper for System.Windows.Forms.Clipboard 48 | ''' 49 | ''' An object representing the clipboard 50 | Public ReadOnly Property Clipboard() As ClipboardProxy 51 | Get 52 | If s_clipboard Is Nothing Then 53 | s_clipboard = New ClipboardProxy() 54 | End If 55 | 56 | Return s_clipboard 57 | End Get 58 | End Property 59 | 60 | ''' 61 | ''' This property returns the Mouse object containing information about 62 | ''' the physical mouse installed to the machine. 63 | ''' 64 | ''' An instance of the Mouse class. 65 | Public ReadOnly Property Mouse() As Mouse 66 | Get 67 | If s_mouse IsNot Nothing Then Return s_mouse 68 | s_mouse = New Mouse 69 | Return s_mouse 70 | End Get 71 | End Property 72 | 73 | ''' 74 | ''' This property returns the Keyboard object representing some 75 | ''' keyboard properties and a send keys method 76 | ''' 77 | ''' An instance of the Keyboard class. 78 | Public ReadOnly Property Keyboard() As Keyboard 79 | Get 80 | If s_keyboardInstance IsNot Nothing Then Return s_keyboardInstance 81 | s_keyboardInstance = New Keyboard 82 | Return s_keyboardInstance 83 | End Get 84 | End Property 85 | 86 | ''' 87 | ''' This property returns the primary display screen. 88 | ''' 89 | ''' A System.Windows.Forms.Screen object as the primary screen. 90 | Public ReadOnly Property Screen() As Windows.Forms.Screen 91 | Get 92 | 'Don't cache this. The Screen class responds to display resolution changes by nulling out AllScreens, which 93 | 'PrimaryScreen relies on to find the primary. So we always need to access the latest PrimaryScreen so we 94 | 'will get the current resolution reported. 95 | Return Windows.Forms.Screen.PrimaryScreen 96 | End Get 97 | End Property 98 | 99 | End Class 100 | 101 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/Devices/Computer/Keyboard.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | ' See the LICENSE file in the project root for more information. 4 | 5 | Option Explicit On 6 | Option Strict On 7 | 8 | #If WINFORMS Then 9 | Imports System.Windows.Forms 10 | #Else 11 | Imports Windows.Forms 12 | #End If 13 | 14 | Imports Community.VisualBasic.CompilerServices 15 | 16 | Namespace Global.Community.VisualBasic.Devices 17 | 18 | ''' 19 | ''' A class representing a computer keyboard. Enables discovery of key 20 | ''' state information for the most common scenarios and enables SendKeys 21 | ''' 22 | Public Class Keyboard 23 | 24 | ''' 25 | ''' Sends keys to the active window as if typed as keyboard with wait = false. 26 | ''' 27 | ''' A string containing the keys to be sent (typed). 28 | Public Sub SendKeys(keys As String) 29 | SendKeys(keys, False) 30 | End Sub 31 | 32 | ''' 33 | ''' Sends keys to the active window as if typed at keyboard. This overloaded 34 | ''' version uses the same conventions as the VB6 SendKeys. 35 | ''' 36 | ''' A string containing the keys to be sent (typed). 37 | ''' Wait for messages to be processed before returning. 38 | Public Sub SendKeys(keys As String, wait As Boolean) 39 | If wait Then 40 | Windows.Forms.SendKeys.SendWait(keys) 41 | Else 42 | Windows.Forms.SendKeys.Send(keys) 43 | End If 44 | End Sub 45 | 46 | ''' 47 | ''' Gets the state (up or down) of the Shift key. 48 | ''' 49 | ''' True if the key is down otherwise false. 50 | Public ReadOnly Property ShiftKeyDown() As Boolean 51 | Get 52 | Dim Keys As Keys = Control.ModifierKeys 53 | Return CType(Keys And Keys.Shift, Boolean) 54 | End Get 55 | End Property 56 | 57 | ''' 58 | ''' Gets the state (up or down) of the Alt key. 59 | ''' 60 | ''' True if the key is down otherwise false. 61 | Public ReadOnly Property AltKeyDown() As Boolean 62 | Get 63 | Dim Keys As Keys = Control.ModifierKeys 64 | Return CType(Keys And Keys.Alt, Boolean) 65 | End Get 66 | End Property 67 | 68 | ''' 69 | ''' Gets the state (up or down) of the Ctrl key. 70 | ''' 71 | ''' True if the key is down otherwise false. 72 | Public ReadOnly Property CtrlKeyDown() As Boolean 73 | Get 74 | Dim Keys As Keys = Control.ModifierKeys 75 | Return CType(Keys And Keys.Control, Boolean) 76 | End Get 77 | End Property 78 | 79 | ''' 80 | ''' Gets the toggle state of the Caps Lock key. 81 | ''' 82 | ''' True if the key is down otherwise false. 83 | Public ReadOnly Property CapsLock() As Boolean 84 | Get 85 | 'Security Note: Only the state of the Caps Lock is returned 86 | 87 | 'The low order byte of the return value from GetKeyState is 1 if the key is 88 | 'toggled on. 89 | Return CType((UnsafeNativeMethods.GetKeyState(Keys.CapsLock) And 1), Boolean) 90 | End Get 91 | End Property 92 | 93 | ''' 94 | ''' Gets the toggle state of the Num Lock key. 95 | ''' 96 | ''' True if the key is down otherwise false. 97 | Public ReadOnly Property NumLock() As Boolean 98 | Get 99 | 'Security Note: Only the state of the Num Lock is returned 100 | 101 | 'The low order byte of the return value from GetKeyState is 1 if the key is 102 | 'toggled on. 103 | Return CType((UnsafeNativeMethods.GetKeyState(Keys.NumLock) And 1), Boolean) 104 | End Get 105 | End Property 106 | 107 | ''' 108 | ''' Gets the toggle state of the Scroll Lock key. 109 | ''' 110 | ''' True if the key is down otherwise false. 111 | Public ReadOnly Property ScrollLock() As Boolean 112 | Get 113 | 'Security Note: Only the state of the Scroll Lock is returned 114 | 115 | 'The low order byte of the return value from GetKeyState is 1 if the key is 116 | 'toggled on. 117 | Return CType((UnsafeNativeMethods.GetKeyState(Keys.Scroll) And 1), Boolean) 118 | End Get 119 | End Property 120 | 121 | End Class 122 | 123 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/Devices/Computer/Mouse.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | ' See the LICENSE file in the project root for more information. 4 | 5 | Option Strict On 6 | Option Explicit On 7 | 8 | #If WINFORMS Then 9 | Imports System.Windows.Forms 10 | #Else 11 | Imports Windows.Forms 12 | #End If 13 | Imports Community.VisualBasic.CompilerServices.ExceptionUtils 14 | 15 | Namespace Global.Community.VisualBasic.Devices 16 | 17 | ''' 18 | ''' A wrapper object that acts as a discovery mechanism for finding 19 | ''' information about the mouse on your computer such as whether the mouse 20 | ''' exists, the number of buttons, WheelScrolls details. 21 | ''' 22 | ''' This class is a Singleton Class. See Common.Computer for details. 23 | ''' 24 | Public Class Mouse 25 | 26 | ''' 27 | ''' Gets a value indicating whether the functions of the left and right 28 | ''' mouses buttons have been swapped. 29 | ''' 30 | ''' 31 | ''' true if the functions of the left and right mouse buttons are swapped. false otherwise. 32 | ''' 33 | ''' If no mouse is installed. 34 | Public ReadOnly Property ButtonsSwapped() As Boolean 35 | Get 36 | If Windows.Forms.SystemInformation.MousePresent Then 37 | Return SystemInformation.MouseButtonsSwapped 38 | Else 39 | Throw GetInvalidOperationException(SR.Mouse_NoMouseIsPresent) 40 | End If 41 | End Get 42 | End Property 43 | 44 | ''' 45 | ''' Gets a value indicating whether a mouse with a mouse wheel is installed 46 | ''' 47 | ''' true if a mouse with a mouse wheel is installed, false otherwise. 48 | ''' If no mouse is installed. 49 | Public ReadOnly Property WheelExists() As Boolean 50 | Get 51 | If Windows.Forms.SystemInformation.MousePresent Then 52 | Return SystemInformation.MouseWheelPresent 53 | Else 54 | Throw GetInvalidOperationException(SR.Mouse_NoMouseIsPresent) 55 | End If 56 | End Get 57 | End Property 58 | 59 | ''' 60 | ''' Gets the number of lines to scroll when the mouse wheel is rotated. 61 | ''' 62 | ''' The number of lines to scroll. 63 | ''' if no mouse is installed or no wheels exists. 64 | Public ReadOnly Property WheelScrollLines() As Integer 65 | Get 66 | Throw New NotImplementedException 67 | If WheelExists Then 68 | Return SystemInformation.MouseWheelScrollLines 69 | Else 70 | Throw GetInvalidOperationException(SR.Mouse_NoWheelIsPresent) 71 | End If 72 | End Get 73 | End Property 74 | 75 | End Class 76 | 77 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/Devices/Computer/ServerComputer.vb: -------------------------------------------------------------------------------- 1 | Option Explicit On 2 | Option Strict On 3 | Option Infer On 4 | 5 | Imports Community.VisualBasic.MyServices 6 | 7 | Namespace Global.Community.VisualBasic.Devices 8 | 9 | ''' 10 | ''' A RAD object representing the server 'computer' for the web/Windows Services 11 | ''' that serves as a discovery mechanism for finding principle abstractions in 12 | ''' the system that you can code against 13 | ''' 14 | Public Class ServerComputer 15 | 16 | Private _computerInfo As ComputerInfo 'Lazy initialized cache for ComputerInfo 17 | Private _fileIO As FileSystemProxy 'Lazy initialized cache for the FileSystem. 18 | Private _network As Network 'Lazy initialized cache for the Network class. 19 | Private _registryInstance As RegistryProxy 'Lazy initialized cache for the Registry class 20 | 21 | Private Shared s_clock As Clock 'Lazy initialized cache for the Clock class. SHARED because Clock behaves as a readonly singleton class 22 | 23 | 'NOTE: The .Net design guidelines state that access to Instance members does not have to be thread-safe. Access to Shared members does have to be thread-safe. 24 | 'Since My.Computer creates the instance of Computer in a thread-safe way, access to the Computer will necessarily be thread-safe. 25 | 'There is nothing to prevent a user from passing our computer object across threads or creating their own instance and then getting into trouble. 26 | 'But that is completely consistent with the rest of the FX design. It is MY.* that is thread safe and leads to best practice access to these objects. 27 | 'If you dim them up yourself, you are responsible for managing the threading. 28 | 29 | ''' 30 | ''' Returns the Clock object which contains the LocalTime and GMTTime. 31 | ''' 32 | Public ReadOnly Property Clock() As Clock 33 | Get 34 | If s_clock IsNot Nothing Then Return s_clock 35 | s_clock = New Clock 36 | Return s_clock 37 | End Get 38 | End Property 39 | 40 | ''' 41 | ''' Gets the object representing the file system of the computer. 42 | ''' 43 | ''' A System.IO.FileSystem object. 44 | ''' The instance returned by this property is lazy initialized and cached. 45 | Public ReadOnly Property FileSystem() As FileSystemProxy 46 | Get 47 | If _fileIO Is Nothing Then 48 | _fileIO = New FileSystemProxy 49 | End If 50 | Return _fileIO 51 | End Get 52 | End Property 53 | 54 | ''' 55 | ''' Gets the object representing information about the computer's state 56 | ''' 57 | ''' A Microsoft.VisualBasic.MyServices.ComputerInfo object. 58 | ''' The instance returned by this property is lazy initialized and cached. 59 | Public ReadOnly Property Info() As ComputerInfo 60 | Get 61 | If _computerInfo Is Nothing Then 62 | _computerInfo = New ComputerInfo 63 | End If 64 | Return _computerInfo 65 | End Get 66 | End Property 67 | 68 | ''' 69 | ''' This property returns the Network object containing information about 70 | ''' the network the machine is part of. 71 | ''' 72 | ''' An instance of the Network.Network class. 73 | Public ReadOnly Property Network() As Network 74 | Get 75 | If _network IsNot Nothing Then Return _network 76 | _network = New Network 77 | Return _network 78 | End Get 79 | End Property 80 | 81 | ''' 82 | ''' This property wraps the System.Environment.MachineName property 83 | ''' in the .NET framework to return the name of the computer. 84 | ''' 85 | ''' A string containing the name of the computer. 86 | Public ReadOnly Property Name() As String 87 | Get 88 | Return System.Environment.MachineName 89 | End Get 90 | End Property 91 | 92 | ''' 93 | ''' Gets the Registry object, which can be used to read, set and 94 | ''' enumerate keys and values in the system registry. 95 | ''' 96 | ''' An instance of the RegistryProxy object 97 | Public ReadOnly Property Registry() As RegistryProxy 98 | Get 99 | If _registryInstance IsNot Nothing Then Return _registryInstance 100 | _registryInstance = New RegistryProxy 101 | Return _registryInstance 102 | End Get 103 | End Property 104 | 105 | End Class 106 | 107 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/Extension.vb: -------------------------------------------------------------------------------- 1 | Option Explicit On 2 | Option Strict On 3 | Option Infer On 4 | 5 | Imports System.Runtime.CompilerServices 6 | Imports System.Runtime.InteropServices 7 | 8 | Public Module Extension 9 | 10 | '' Inspired by https://mariusschulz.com/blog/detecting-the-operating-system-in-net-core 11 | '' Tweaked to be Extension Methods for the existing OperatingSystem class. 12 | 13 | ' 14 | 'Public Function IsWindows(os As OperatingSystem) As Boolean 15 | ' If os Is Nothing Then 16 | ' ' Just to remove the warning for not using the 'os' variable. 17 | ' End If 18 | ' Return RuntimeInformation.IsOSPlatform(OSPlatform.Windows) 19 | 'End Function 20 | 21 | ' 22 | 'Public Function IsLinux(os As OperatingSystem) As Boolean 23 | ' If os Is Nothing Then 24 | ' ' Just to remove the warning for not using the 'os' variable. 25 | ' End If 26 | ' Return RuntimeInformation.IsOSPlatform(OSPlatform.Linux) 27 | 'End Function 28 | 29 | ' 30 | 'Public Function IsOSX(os As OperatingSystem) As Boolean 31 | ' If os Is Nothing Then 32 | ' ' Just to remove the warning for not using the 'os' variable. 33 | ' End If 34 | ' Return RuntimeInformation.IsOSPlatform(OSPlatform.OSX) 35 | 'End Function 36 | 37 | End Module 38 | -------------------------------------------------------------------------------- /Community.VisualBasic/FileIO/MalformedLineException.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | Option Explicit On 4 | Option Strict On 5 | 6 | Imports System 7 | Imports System.ComponentModel 8 | Imports System.Globalization 9 | 10 | Namespace Global.Community.VisualBasic.FileIO 11 | 12 | ''' 13 | ''' Indicates a line cannot be parsed into fields 14 | ''' 15 | ''' 16 | 17 | Public Class MalformedLineException 18 | Inherits Exception 19 | 20 | ''' 21 | ''' Creates a new exception with no properties set 22 | ''' 23 | ''' 24 | Public Sub New() 25 | MyBase.New() 26 | End Sub 27 | 28 | ''' 29 | ''' Creates a new exception, setting Message and LineNumber 30 | ''' 31 | ''' The message for the exception 32 | ''' The number of the line that is malformed 33 | ''' 34 | Public Sub New(message As String, lineNumber As Long) 35 | MyBase.New(message) 36 | m_LineNumber = lineNumber 37 | End Sub 38 | 39 | ''' 40 | ''' Creates a new exception, setting Message 41 | ''' 42 | ''' The message for the exception 43 | ''' 44 | Public Sub New(message As String) 45 | MyBase.New(message) 46 | End Sub 47 | 48 | ''' 49 | ''' Creates a new exception, setting Message, LineNumber, and InnerException 50 | ''' 51 | ''' The message for the exception 52 | ''' The number of the line that is malformed 53 | ''' The inner exception for the exception 54 | ''' 55 | Public Sub New(message As String, lineNumber As Long, innerException As Exception) 56 | MyBase.New(message, innerException) 57 | m_LineNumber = lineNumber 58 | End Sub 59 | 60 | ''' 61 | ''' Creates a new exception, setting Message and InnerException 62 | ''' 63 | ''' The message for the exception 64 | ''' The inner exception for the exception 65 | ''' 66 | Public Sub New(message As String, innerException As Exception) 67 | MyBase.New(message, innerException) 68 | End Sub 69 | 70 | ''' 71 | ''' Constructor used for serialization 72 | ''' 73 | ''' 74 | ''' 75 | ''' 76 | 77 | Protected Sub New(info As System.Runtime.Serialization.SerializationInfo, context As System.Runtime.Serialization.StreamingContext) 78 | MyBase.New(info, context) 79 | 80 | If info IsNot Nothing Then ' Fix FxCop violation ValidateArgumentsOfPublicMethods. 81 | m_LineNumber = info.GetInt32(LINE_NUMBER_PROPERTY) 82 | Else 83 | m_LineNumber = -1 84 | End If 85 | End Sub 86 | 87 | ''' 88 | ''' The number of the offending line 89 | ''' 90 | ''' The line number 91 | ''' 92 | 93 | Public Property LineNumber() As Long 94 | Get 95 | Return m_LineNumber 96 | End Get 97 | Set(value As Long) 98 | m_LineNumber = value 99 | End Set 100 | End Property 101 | 102 | ''' 103 | ''' Supports serialization 104 | ''' 105 | ''' 106 | ''' 107 | ''' 108 | 109 | Public Overrides Sub GetObjectData(info As System.Runtime.Serialization.SerializationInfo, context As System.Runtime.Serialization.StreamingContext) 110 | If info IsNot Nothing Then ' Fix FxCop violation ValidateArgumentsOfPublicMethods. 111 | info.AddValue(LINE_NUMBER_PROPERTY, m_LineNumber, GetType(Long)) 112 | End If 113 | 114 | MyBase.GetObjectData(info, context) 115 | End Sub 116 | 117 | ''' 118 | ''' Appends extra data to string so that it's available when the exception is caught as an Exception 119 | ''' 120 | ''' The base ToString plus the Line Number 121 | ''' 122 | Public Overrides Function ToString() As String 123 | Return MyBase.ToString() & " " & SR.Format(SR.TextFieldParser_MalformedExtraData, LineNumber.ToString(CultureInfo.InvariantCulture)) 124 | End Function 125 | 126 | ' Holds the line number 127 | Private m_LineNumber As Long 128 | 129 | ' Name of property used for serialization 130 | Private Const LINE_NUMBER_PROPERTY As String = "LineNumber" 131 | 132 | End Class 133 | End Namespace 134 | -------------------------------------------------------------------------------- /Community.VisualBasic/Globals.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Imports System 5 | 6 | Namespace Global.Community.VisualBasic 7 | 8 | Public Enum VariantType 9 | Empty = 0 10 | Null = 1 11 | [Short] = 2 12 | [Integer] = 3 13 | [Single] = 4 14 | [Double] = 5 15 | Currency = 6 16 | [Date] = 7 17 | [String] = 8 18 | [Object] = 9 19 | [Error] = 10 20 | [Boolean] = 11 21 | [Variant] = 12 22 | [DataObject] = 13 23 | [Decimal] = 14 24 | [Byte] = 17 25 | [Char] = 18 26 | [Long] = 20 27 | UserDefinedType = 36 28 | Array = 8192 29 | End Enum 30 | 31 | Public Enum AppWinStyle As Short 32 | Hide = 0 33 | NormalFocus = 1 34 | MinimizedFocus = 2 35 | MaximizedFocus = 3 36 | NormalNoFocus = 4 37 | MinimizedNoFocus = 6 38 | End Enum 39 | 40 | Public Enum CallType 41 | Method = 1 42 | [Get] = 2 43 | [Let] = 4 44 | [Set] = 8 45 | End Enum 46 | 47 | Public Enum CompareMethod 48 | [Binary] = 0 49 | [Text] = 1 50 | End Enum 51 | 52 | Public Enum DateFormat 53 | GeneralDate = 0 54 | LongDate = 1 55 | ShortDate = 2 56 | LongTime = 3 57 | ShortTime = 4 58 | End Enum 59 | 60 | Public Enum FirstDayOfWeek 61 | System = 0 62 | Sunday = 1 63 | Monday = 2 64 | Tuesday = 3 65 | Wednesday = 4 66 | Thursday = 5 67 | Friday = 6 68 | Saturday = 7 69 | End Enum 70 | 71 | Public Enum FileAttribute 72 | [Normal] = 0 73 | [ReadOnly] = 1 74 | [Hidden] = 2 75 | [System] = 4 76 | [Volume] = 8 77 | [Directory] = 16 78 | [Archive] = 32 79 | End Enum 80 | 81 | Public Enum FirstWeekOfYear 82 | System = 0 83 | Jan1 = 1 84 | FirstFourDays = 2 85 | FirstFullWeek = 3 86 | End Enum 87 | 88 | Public Enum VbStrConv 89 | [None] = 0 90 | [Uppercase] = 1 91 | [Lowercase] = 2 92 | [ProperCase] = 3 93 | [Wide] = 4 94 | [Narrow] = 8 95 | [Katakana] = 16 96 | [Hiragana] = 32 97 | '[Unicode] = 64 'OBSOLETE 98 | '[FromUnicode] = 128 'OBSOLETE 99 | [SimplifiedChinese] = 256 100 | [TraditionalChinese] = 512 101 | [LinguisticCasing] = 1024 102 | End Enum 103 | 104 | Public Enum TriState 105 | [False] = 0 106 | [True] = -1 107 | [UseDefault] = -2 108 | End Enum 109 | 110 | Public Enum DateInterval 111 | [Year] = 0 112 | [Quarter] = 1 113 | [Month] = 2 114 | [DayOfYear] = 3 115 | [Day] = 4 116 | [WeekOfYear] = 5 117 | [Weekday] = 6 118 | [Hour] = 7 119 | [Minute] = 8 120 | [Second] = 9 121 | End Enum 122 | 123 | Public Enum DueDate 124 | EndOfPeriod = 0 125 | BegOfPeriod = 1 126 | End Enum 127 | 128 | Public Enum OpenMode 129 | [Input] = 1 130 | [Output] = 2 131 | [Random] = 4 132 | [Append] = 8 133 | [Binary] = 32 134 | End Enum 135 | 136 | Friend Enum OpenModeTypes 137 | [Input] = 1 138 | [Output] = 2 139 | [Random] = 4 140 | [Append] = 8 141 | [Binary] = 32 142 | [Any] = -1 143 | End Enum 144 | 145 | Public Enum OpenAccess 146 | [Default] = -1 147 | [Read] = System.IO.FileAccess.Read 148 | [ReadWrite] = System.IO.FileAccess.ReadWrite 149 | [Write] = System.IO.FileAccess.Write 150 | End Enum 151 | 152 | Public Enum OpenShare 153 | [Default] = -1 154 | [Shared] = System.IO.FileShare.ReadWrite 155 | [LockRead] = System.IO.FileShare.Write 156 | [LockReadWrite] = System.IO.FileShare.None 157 | [LockWrite] = System.IO.FileShare.Read 158 | End Enum 159 | 160 | 161 | Public Structure TabInfo 162 | Public Column As Short 163 | End Structure 164 | 165 | 166 | Public Structure SpcInfo 167 | Public Count As Short 168 | End Structure 169 | 170 | Public Enum MsgBoxResult 171 | Ok = 1 172 | Cancel = 2 173 | Abort = 3 174 | Retry = 4 175 | Ignore = 5 176 | Yes = 6 177 | No = 7 178 | End Enum 179 | 180 | 181 | Public Enum MsgBoxStyle 182 | 'You may BitOr one value from each group 183 | 'Button group: Lower 4 bits, &H00F 184 | OkOnly = &H0I 185 | OkCancel = &H1I 186 | AbortRetryIgnore = &H2I 187 | YesNoCancel = &H3I 188 | YesNo = &H4I 189 | RetryCancel = &H5I 190 | 191 | 'Icon Group: Middle 4 bits &H0F0 192 | Critical = &H10I 'Same as Windows.Forms.MessageBox.IconError 193 | Question = &H20I 'Same As Windows.MessageBox.IconQuestion 194 | Exclamation = &H30I 'Same As Windows.MessageBox.IconExclamation 195 | Information = &H40I 'Same As Windows.MessageBox.IconInformation 196 | 197 | 'Default Group: High 4 bits &HF00 198 | DefaultButton1 = 0 199 | DefaultButton2 = &H100I 200 | DefaultButton3 = &H200I 201 | 'UNSUPPORTED IN VB7 202 | 'DefaultButton4 = &H300I 203 | 204 | ApplicationModal = &H0I 205 | SystemModal = &H1000I 206 | 207 | MsgBoxHelp = &H4000I 208 | MsgBoxRight = &H80000I 209 | MsgBoxRtlReading = &H100000I 210 | MsgBoxSetForeground = &H10000I 211 | End Enum 212 | 213 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/Helpers/NativeTypes.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | Option Explicit On 4 | Option Strict On 5 | 6 | Imports System 7 | Imports System.Runtime.InteropServices 8 | 9 | Namespace Global.Community.VisualBasic.CompilerServices 10 | 11 | 12 | Friend NotInheritable Class NativeTypes 13 | 14 | Friend NotInheritable Class SystemTime 15 | Public wYear As Short 16 | Public wMonth As Short 17 | Public wDayOfWeek As Short 18 | Public wDay As Short 19 | Public wHour As Short 20 | Public wMinute As Short 21 | Public wSecond As Short 22 | Public wMilliseconds As Short 23 | 24 | Friend Sub New() 25 | End Sub 26 | End Class 27 | 28 | ''' 29 | ''' Flags for MoveFileEx. 30 | ''' See http://msdn.microsoft.com/library/default.asp?url=/library/en-us/fileio/fs/movefileex.asp 31 | ''' and public\sdk\inc\winbase.h. 32 | ''' 33 | 34 | Friend Enum MoveFileExFlags As Integer 35 | MOVEFILE_REPLACE_EXISTING = &H1 36 | MOVEFILE_COPY_ALLOWED = &H2 37 | MOVEFILE_DELAY_UNTIL_REBOOT = &H4 38 | MOVEFILE_WRITE_THROUGH = &H8 39 | End Enum 40 | 41 | Friend Const LCMAP_TRADITIONAL_CHINESE As Integer = &H4000000I 42 | Friend Const LCMAP_SIMPLIFIED_CHINESE As Integer = &H2000000I 43 | Friend Const LCMAP_UPPERCASE As Integer = &H200I 44 | Friend Const LCMAP_LOWERCASE As Integer = &H100I 45 | Friend Const LCMAP_FULLWIDTH As Integer = &H800000I 46 | Friend Const LCMAP_HALFWIDTH As Integer = &H400000I 47 | Friend Const LCMAP_KATAKANA As Integer = &H200000I 48 | Friend Const LCMAP_HIRAGANA As Integer = &H100000I 49 | 50 | ' Error code from public\sdk\inc\winerror.h 51 | Friend Const ERROR_FILE_NOT_FOUND As Integer = 2 52 | Friend Const ERROR_PATH_NOT_FOUND As Integer = 3 53 | Friend Const ERROR_ACCESS_DENIED As Integer = 5 54 | Friend Const ERROR_ALREADY_EXISTS As Integer = 183 55 | Friend Const ERROR_FILENAME_EXCED_RANGE As Integer = 206 56 | Friend Const ERROR_INVALID_DRIVE As Integer = 15 57 | Friend Const ERROR_INVALID_PARAMETER As Integer = 87 58 | Friend Const ERROR_SHARING_VIOLATION As Integer = 32 59 | Friend Const ERROR_FILE_EXISTS As Integer = 80 60 | Friend Const ERROR_OPERATION_ABORTED As Integer = 995 61 | Friend Const ERROR_CANCELLED As Integer = 1223 62 | 63 | ''' ;New 64 | ''' 65 | ''' FxCop violation: Avoid uninstantiated internal class. 66 | ''' Adding a private constructor to prevent the compiler from generating a default constructor. 67 | ''' 68 | Private Sub New() 69 | End Sub 70 | End Class 71 | 72 | End Namespace 73 | -------------------------------------------------------------------------------- /Community.VisualBasic/Helpers/SafeNativeMethods.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Imports System.Runtime.InteropServices 5 | Imports System.Runtime.Versioning 6 | 7 | Namespace Global.Community.VisualBasic.CompilerServices 8 | 9 | 10 | 11 | Friend NotInheritable Class SafeNativeMethods 12 | 13 | 14 | Friend Declare Sub GetLocalTime Lib "kernel32" (systime As NativeTypes.SystemTime) 15 | 16 | '''************************************************************************* 17 | ''' ;New 18 | ''' 19 | ''' FxCop violation: Avoid uninstantiated internal class. 20 | ''' Adding a private constructor to prevent the compiler from generating a default constructor. 21 | ''' 22 | Private Sub New() 23 | End Sub 24 | 25 | End Class 26 | 27 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/MyGroupCollectionAttribute.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Imports System 5 | Imports System.ComponentModel 6 | 7 | Namespace Global.Community.VisualBasic 8 | 9 | ''' 10 | ''' This attribute is put on an empty 'container class' that the compiler then fills with 11 | ''' properties that return instances of all the types found in the project which derive 12 | ''' from the TypeToCollect argument. 13 | ''' 14 | ''' This is how My.Forms is built, for instance. 15 | ''' 16 | ''' 17 | ''' WARNING: Do not rename this attribute or move it out of this module. Otherwise there 18 | ''' are compiler changes that will need to be made 19 | ''' 20 | 21 | 22 | Public NotInheritable Class MyGroupCollectionAttribute : Inherits Attribute 23 | 24 | ''' 25 | ''' 26 | ''' Compiler will generate accessors for classes that derived from this type 27 | ''' Name of the factory method to create the instances 28 | ''' Name of the method that will dispose of the instances 29 | ''' "Name of the My.* method to call to get the default instance for the types in the container 30 | Public Sub New(typeToCollect As String, createInstanceMethodName As String, 31 | disposeInstanceMethodName As String, defaultInstanceAlias As String) 32 | 33 | MyGroupName = typeToCollect 34 | CreateMethod = createInstanceMethodName 35 | DisposeMethod = disposeInstanceMethodName 36 | Me.DefaultInstanceAlias = defaultInstanceAlias 37 | 38 | End Sub 39 | 40 | ''' 41 | ''' The name of the base type we are trying to collect 42 | ''' 43 | Public ReadOnly Property MyGroupName() As String 44 | 45 | ''' 46 | ''' Name of the factory method to create the instances 47 | ''' 48 | Public ReadOnly Property CreateMethod() As String 49 | 50 | ''' 51 | ''' Name of the method that will dispose of the instances 52 | ''' 53 | Public ReadOnly Property DisposeMethod() As String 54 | 55 | ''' 56 | ''' Provides the name of the My.* methods to call to get the 'default instance' 57 | ''' 58 | Public ReadOnly Property DefaultInstanceAlias() As String 59 | 60 | End Class 61 | 62 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/MyServices/Internal/ContextValue.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | ' See the LICENSE file in the project root for more information. 4 | 5 | Option Explicit On 6 | Option Strict On 7 | 8 | Imports System.Threading 9 | 10 | Namespace Global.Community.VisualBasic.MyServices.Internal 11 | 12 | ''' 13 | ''' Stores an object in a context appropriate for the environment we are 14 | ''' running in (web/windows) 15 | ''' 16 | ''' 17 | ''' 18 | ''' "Thread appropriate" means that if we are running on ASP.Net the object will be stored in the 19 | ''' context of the current request (meaning the object is stored per request on the web). 20 | ''' Note that an instance of this class can only be associated 21 | ''' with the one item to be stored/retrieved at a time. 22 | ''' 23 | 24 | Public Class ContextValue(Of T) 25 | Public Sub New() 26 | _contextKey = System.Guid.NewGuid.ToString 27 | End Sub 28 | 29 | ''' 30 | ''' Get the object from the correct thread-appropriate location 31 | ''' 32 | Public Property Value() As T 'No SyncLocks required because we are operating upon instance data and the object is not shared across threads 33 | Get 34 | Dim dictionary As IDictionary = GetDictionary() 35 | Return DirectCast(dictionary(_contextKey), T) 'Note, IDictionary(key) can return Nothing and that's OK 36 | End Get 37 | Set(value As T) 38 | Dim dictionary As IDictionary = GetDictionary() 39 | dictionary(_contextKey) = value 40 | End Set 41 | End Property 42 | 43 | Private Shared Function GetDictionary() As IDictionary 44 | If s_threadLocal Is Nothing Then 45 | Interlocked.CompareExchange(s_threadLocal, New ThreadLocal(Of IDictionary)(Function() New Dictionary(Of String, T)), Nothing) 46 | End If 47 | Return s_threadLocal.Value 48 | End Function 49 | 50 | Private ReadOnly _contextKey As String 'An item is stored in the dictionary by a GUID which this string maintains 51 | 52 | Private Shared s_threadLocal As ThreadLocal(Of IDictionary) 53 | 54 | End Class 55 | 56 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/MyServices/SpecialDirectoriesProxy.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | ' See the LICENSE file in the project root for more information. 4 | 5 | Imports System.ComponentModel 6 | Imports Community.VisualBasic.FileIO 7 | 8 | Namespace Global.Community.VisualBasic.MyServices 9 | 10 | ''' 11 | ''' An extremely thin wrapper around Microsoft.VisualBasic.FileIO.SpecialDirectories to expose the type through My. 12 | ''' 13 | 14 | Public Class SpecialDirectoriesProxy 15 | 16 | Public ReadOnly Property MyDocuments() As String 17 | Get 18 | Return SpecialDirectories.MyDocuments 19 | End Get 20 | End Property 21 | 22 | Public ReadOnly Property MyMusic() As String 23 | Get 24 | Return SpecialDirectories.MyMusic 25 | End Get 26 | End Property 27 | 28 | Public ReadOnly Property MyPictures() As String 29 | Get 30 | Return SpecialDirectories.MyPictures 31 | End Get 32 | End Property 33 | 34 | Public ReadOnly Property Desktop() As String 35 | Get 36 | Return SpecialDirectories.Desktop 37 | End Get 38 | End Property 39 | 40 | Public ReadOnly Property Programs() As String 41 | Get 42 | Return SpecialDirectories.Programs 43 | End Get 44 | End Property 45 | 46 | Public ReadOnly Property ProgramFiles() As String 47 | Get 48 | Return SpecialDirectories.ProgramFiles 49 | End Get 50 | End Property 51 | 52 | Public ReadOnly Property Temp() As String 53 | Get 54 | Return SpecialDirectories.Temp 55 | End Get 56 | End Property 57 | 58 | Public ReadOnly Property CurrentUserApplicationData() As String 59 | Get 60 | Return SpecialDirectories.CurrentUserApplicationData 61 | End Get 62 | End Property 63 | 64 | Public ReadOnly Property AllUsersApplicationData() As String 65 | Get 66 | Return SpecialDirectories.AllUsersApplicationData 67 | End Get 68 | End Property 69 | 70 | ''' 71 | ''' Proxy class can only created by internal classes. 72 | ''' 73 | Friend Sub New() 74 | End Sub 75 | 76 | End Class 77 | 78 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/VBFixedArrayAttribute.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Imports System 5 | 6 | Imports Community.VisualBasic 7 | 8 | Namespace Global.Community.VisualBasic 9 | 10 | ' ------------------------------------------------------------------- 11 | ' VBFixedArray is used by the runtime to determine 12 | ' if the array should be written/read without the array descriptor. 13 | ' ------------------------------------------------------------------- 14 | 15 | Public NotInheritable Class VBFixedArrayAttribute 16 | Inherits Attribute 17 | 18 | Friend FirstBound As Integer 19 | Friend SecondBound As Integer 20 | 21 | Public ReadOnly Property Bounds() As Integer() 22 | Get 23 | If SecondBound = -1 Then 24 | Return New Integer() {FirstBound} 25 | Else 26 | Return New Integer() {FirstBound, SecondBound} 27 | End If 28 | End Get 29 | End Property 30 | 31 | Public ReadOnly Property Length() As Integer 32 | Get 33 | If SecondBound = -1 Then 34 | Return (FirstBound + 1) 35 | Else 36 | Return (FirstBound + 1) * (SecondBound + 1) 37 | End If 38 | End Get 39 | End Property 40 | 41 | Public Sub New(UpperBound1 As Integer) 42 | If UpperBound1 < 0 Then 43 | Throw New ArgumentException(SR.Invalid_VBFixedArray) 44 | End If 45 | 46 | FirstBound = UpperBound1 47 | SecondBound = -1 48 | 49 | End Sub 50 | 51 | Public Sub New(UpperBound1 As Integer, UpperBound2 As Integer) 52 | If UpperBound1 < 0 OrElse UpperBound2 < 0 Then 53 | Throw New ArgumentException(SR.Invalid_VBFixedArray) 54 | End If 55 | 56 | FirstBound = UpperBound1 57 | SecondBound = UpperBound2 58 | 59 | End Sub 60 | End Class 61 | 62 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/VBFixedStringAttribute.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Imports System 5 | 6 | Namespace Global.Community.VisualBasic 7 | 8 | ' ------------------------------------------------------------------- 9 | ' VBFixedString is used by the runtime to determine 10 | ' if the field should be written/read without the string length descriptor. 11 | ' ------------------------------------------------------------------- 12 | 13 | Public NotInheritable Class VBFixedStringAttribute 14 | Inherits Attribute 15 | 16 | Public ReadOnly Property Length() As Integer 17 | 18 | Public Sub New(Length As Integer) 19 | If (Length < 1 OrElse Length > Short.MaxValue) Then 20 | Throw New ArgumentException(SR.Invalid_VBFixedString) 21 | End If 22 | 23 | Me.Length = Length 24 | End Sub 25 | End Class 26 | 27 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/VBMath.vb: -------------------------------------------------------------------------------- 1 | ' Licensed to the .NET Foundation under one or more agreements. 2 | ' The .NET Foundation licenses this file to you under the MIT license. 3 | 4 | Imports System 5 | 6 | Imports Community.VisualBasic.CompilerServices 7 | 8 | Namespace Global.Community.VisualBasic 9 | 10 | Public Module VBMath 11 | 12 | ' Equivalent to calling VB6 rtRandomNext(1.0) 13 | Public Function Rnd() As Single 14 | Return Rnd(CSng(1)) 15 | End Function 16 | 17 | ' Equivalent to VB6 rtRandomNext function 18 | Public Function Rnd(Number As Single) As Single 19 | Dim oProj As ProjectData = ProjectData.GetProjectData() 20 | Dim rndSeed As Integer = oProj.m_rndSeed 21 | 22 | ' if parameter is zero, generate float from present seed 23 | If (Number <> 0.0) Then 24 | ' if parameter is negative, use to create new seed 25 | If (Number < 0.0) Then 26 | 'Original C++ code 27 | 'rndSeed = *(ULONG *) & fltVal; 28 | 'rndSeed = (rndSeed + (rndSeed >> 24)) & 0xffffffL; 29 | 30 | rndSeed = BitConverter.ToInt32(BitConverter.GetBytes(Number), 0) 31 | 32 | Dim i64 As Int64 = rndSeed 33 | i64 = (i64 And &HFFFFFFFFL) 34 | rndSeed = CInt((i64 + (i64 >> 24)) And &HFFFFFFI) 35 | End If 36 | 37 | ' if parameter is non-zero, generate a new seed 38 | rndSeed = CInt((CLng(rndSeed) * &H43FD43FDL + &HC39EC3L) And &HFFFFFFL) 39 | End If 40 | 41 | ' copy back seed value to per-project structure 42 | oProj.m_rndSeed = rndSeed 43 | 44 | ' normalize seed to floating value from 0.0 up to 1.0 45 | Return CSng(rndSeed) / CSng(16777216.0) 46 | End Function 47 | 48 | 'Equivalent to RandomizeTimer in the VB6 codebase 49 | Public Sub Randomize() 50 | Dim oProj As ProjectData = ProjectData.GetProjectData() 51 | Dim sngTimer As Single = GetTimer() 52 | Dim rndSeed As Int32 = oProj.m_rndSeed 53 | Dim lValue As Int32 54 | 55 | ' treat Single as a long Integer 56 | lValue = BitConverter.ToInt32(BitConverter.GetBytes(sngTimer), 0) 57 | 58 | ' xor the upper and lower words of the long and put in 59 | ' the middle two bytes 60 | lValue = ((lValue And &HFFFFI) Xor (lValue >> 16)) << 8 61 | 62 | ' replace the middle two bytes of the seed with lValue 63 | rndSeed = (rndSeed And &HFF0000FFI) Or lValue 64 | 65 | ' copy back seed value to per-project structure 66 | oProj.m_rndSeed = rndSeed 67 | End Sub 68 | 69 | 'Equivalent to RandomizeValue in the VB6 codebase 70 | Public Sub Randomize(Number As Double) 71 | Dim rndSeed As Integer 72 | Dim lValue As Integer 73 | Dim oProj As ProjectData 74 | 75 | oProj = ProjectData.GetProjectData() 76 | rndSeed = oProj.m_rndSeed 77 | 78 | ' for little-endian R8, the high-order Integer is second half 79 | If BitConverter.IsLittleEndian Then 80 | lValue = BitConverter.ToInt32(BitConverter.GetBytes(Number), 4) 81 | Else 82 | lValue = BitConverter.ToInt32(BitConverter.GetBytes(Number), 0) 83 | End If 84 | 85 | ' xor the upper and lower words of the Integer and put in 86 | ' the middle two bytes 87 | ' Original C++ line 88 | ' lValue = ((lValue & 0xffff) ^ (lValue >> 16)) << 8; 89 | lValue = ((lValue And &HFFFFI) Xor (lValue >> 16)) << 8 90 | 91 | ' replace the middle two bytes of the seed with lValue 92 | 'Original C++ line 93 | ' rndSeed = (rndSeed & 0xff0000ff) | lValue; 94 | rndSeed = (rndSeed And &HFF0000FFI) Or lValue 95 | 96 | ' copy back seed value to per-project structure 97 | oProj.m_rndSeed = rndSeed 98 | End Sub 99 | 100 | Private Function GetTimer() As Single 101 | Dim dt As Date 102 | 103 | dt = System.DateTime.Now 104 | Return CSng((60 * dt.Hour + dt.Minute) * 60 + dt.Second + (dt.Millisecond / 1000)) 105 | End Function 106 | 107 | End Module 108 | 109 | End Namespace -------------------------------------------------------------------------------- /Community.VisualBasic/_Stub.vb: -------------------------------------------------------------------------------- 1 | 'Namespace Global.Community.VisualBasic 2 | 3 | ' ' 4 | ' 'Public Module DoesntMatterWhatThisIsCalled 5 | 6 | ' ' Public Function Fix(value As Double) As Integer 7 | ' ' Return Math.Floor(value) 8 | ' ' End Function 9 | 10 | ' ' Public Function DateAdd(a As Date, b As Integer) As Date 11 | ' ' Return Date.MinValue 12 | ' ' End Function 13 | 14 | ' 'End Module 15 | 16 | 'End Namespace 17 | 18 | Option Explicit On 19 | Option Strict On 20 | Option Infer On 21 | 22 | Imports System.Runtime.Serialization 23 | Imports System.Runtime.CompilerServices 24 | Imports System.Runtime.InteropServices 25 | Imports System.Reflection 26 | 27 | Namespace Global.Community.VisualBasic 28 | 29 | ' What appears to be available... 30 | ' 31 | ' - Microsoft.VisualBasic.CompilerServices.DesignerGeneratedAttribute 32 | ' - Microsoft.VisualBasic.CompilerServices.IncompleteInitialization 33 | ' - Microsoft.VisualBasic.CompilerServices.LikeOperator 34 | ' - Microsoft.VisualBasic.CompilerServices.ObjectFlowControl 35 | ' - Microsoft.VisualBasic.CompilerServices.OptionCompareAttribute 36 | ' - Microsoft.VisualBasic.CompilerServices.OptionTextAttribute 37 | ' - Microsoft.VisualBasic.CompilerServices.StandardModuleAttribute 38 | ' - Microsoft.VisualBasic.CompilerServices.StaticLocalInitFlag 39 | ' - Microsoft.VisualBasic.HideModuleNameAttribute 40 | ' 41 | ' What appears to be (at least) partially available... 42 | ' 43 | ' - Microsoft.VisualBasic.CompilerServices.Conversions 44 | 45 | Friend NotInheritable Class Application 46 | 47 | Private Sub New() 48 | End Sub 49 | 50 | Public Shared ReadOnly Property UserAppDataPath As String 51 | Get 52 | If OperatingSystem.IsWindows Then 53 | 'Return System.Application.UserAppDataPath 54 | Dim a = New ApplicationServices.ConsoleApplicationBase 55 | Dim p = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) 56 | Return IO.Path.Combine(p, a.Info.CompanyName, a.Info.ProductName, $"{a.Info.Version.Major}.{a.Info.Version.Minor}.{a.Info.Version.Build}") 57 | Else 58 | Return IO.Path.GetDirectoryName(ExecutablePath) 59 | End If 60 | End Get 61 | End Property 62 | 63 | Public Shared ReadOnly Property ExecutablePath As String 64 | Get 65 | If OperatingSystem.IsWindows Then 66 | 'Return System.Application.ExecutablePath 67 | Return Process.GetCurrentProcess.MainModule.FileName 68 | Else 69 | 'Return AppDomain.CurrentDomain.BaseDirectory ' Recommended as "the right way"... but returns "blank" in WSL2??? 70 | Return Assembly.GetEntryAssembly.Location 71 | End If 72 | End Get 73 | End Property 74 | 75 | Public Shared ReadOnly Property CommonAppDataPath As String 76 | Get 77 | If OperatingSystem.IsWindows Then 78 | 'Return Application.CommonAppDataPath 79 | Dim a = New ApplicationServices.ConsoleApplicationBase 80 | Dim p = Environment.GetFolderPath(Environment.SpecialFolder.CommonApplicationData) 81 | Return IO.Path.Combine(p, a.Info.CompanyName, a.Info.ProductName, $"{a.Info.Version.Major}.{a.Info.Version.Minor}.{a.Info.Version.Build}") 82 | Else 83 | Return IO.Path.GetDirectoryName(ExecutablePath) 84 | End If 85 | End Get 86 | End Property 87 | 88 | End Class 89 | 90 | Friend Class SupportedOSPlatform : Inherits Attribute 91 | Sub New(value As String) 92 | If value IsNot Nothing Then 93 | End If 94 | End Sub 95 | End Class 96 | 97 | End Namespace 98 | 99 | Namespace Global.Community.Media 100 | 101 | Friend Class SoundPlayer 102 | 103 | Private ReadOnly m_filename As String 104 | Private ReadOnly m_stream As IO.Stream 105 | 106 | Sub New() 107 | 108 | End Sub 109 | 110 | Sub New(filename As String) 111 | m_filename = filename 112 | End Sub 113 | 114 | Sub New(stream As IO.Stream) 115 | m_stream = stream 116 | End Sub 117 | 118 | Public Sub [Stop]() 119 | 120 | End Sub 121 | 122 | Public Sub Play() 123 | If String.IsNullOrWhiteSpace(m_filename) AndAlso 124 | m_stream Is Nothing Then 125 | End If 126 | End Sub 127 | 128 | Public Sub PlaySync() 129 | 130 | End Sub 131 | 132 | Public Sub PlayLooping() 133 | 134 | End Sub 135 | 136 | End Class 137 | 138 | Public Class SystemSound 139 | 140 | Public Sub Play() 141 | 142 | End Sub 143 | 144 | End Class 145 | 146 | End Namespace 147 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) Cory Smith and Contributors 4 | Copyright (c) .NET Foundation and Contributors 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in all 14 | copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 | SOFTWARE. 23 | -------------------------------------------------------------------------------- /ProjectTypeTests/net4-console/App.config: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | 6 | -------------------------------------------------------------------------------- /ProjectTypeTests/net4-console/Module1.vb: -------------------------------------------------------------------------------- 1 | Module Module1 2 | 3 | Sub Main() 4 | 5 | End Sub 6 | 7 | End Module 8 | -------------------------------------------------------------------------------- /ProjectTypeTests/net4-console/My Project/Application.Designer.vb: -------------------------------------------------------------------------------- 1 | '------------------------------------------------------------------------------ 2 | ' 3 | ' This code was generated by a tool. 4 | ' Runtime Version:4.0.30319.42000 5 | ' 6 | ' Changes to this file may cause incorrect behavior and will be lost if 7 | ' the code is regenerated. 8 | ' 9 | '------------------------------------------------------------------------------ 10 | 11 | Option Strict On 12 | Option Explicit On 13 | 14 | -------------------------------------------------------------------------------- /ProjectTypeTests/net4-console/My Project/Application.myapp: -------------------------------------------------------------------------------- 1 |  2 | 3 | false 4 | false 5 | 0 6 | true 7 | 0 8 | 2 9 | true 10 | 11 | -------------------------------------------------------------------------------- /ProjectTypeTests/net4-console/My Project/AssemblyInfo.vb: -------------------------------------------------------------------------------- 1 | Imports System 2 | Imports System.Reflection 3 | Imports System.Runtime.InteropServices 4 | 5 | ' General Information about an assembly is controlled through the following 6 | ' set of attributes. Change these attribute values to modify the information 7 | ' associated with an assembly. 8 | 9 | ' Review the values of the assembly attributes 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 'The following GUID is for the ID of the typelib if this project is exposed to COM 21 | 22 | 23 | ' Version information for an assembly consists of the following four values: 24 | ' 25 | ' Major Version 26 | ' Minor Version 27 | ' Build Number 28 | ' Revision 29 | ' 30 | ' You can specify all the values or you can default the Build and Revision Numbers 31 | ' by using the '*' as shown below: 32 | ' 33 | 34 | 35 | 36 | -------------------------------------------------------------------------------- /ProjectTypeTests/net4-console/My Project/Resources.Designer.vb: -------------------------------------------------------------------------------- 1 | '------------------------------------------------------------------------------ 2 | ' 3 | ' This code was generated by a tool. 4 | ' Runtime Version:4.0.30319.42000 5 | ' 6 | ' Changes to this file may cause incorrect behavior and will be lost if 7 | ' the code is regenerated. 8 | ' 9 | '------------------------------------------------------------------------------ 10 | 11 | Option Strict On 12 | Option Explicit On 13 | 14 | 15 | Namespace My.Resources 16 | 17 | 'This class was auto-generated by the StronglyTypedResourceBuilder 18 | 'class via a tool like ResGen or Visual Studio. 19 | 'To add or remove a member, edit your .ResX file then rerun ResGen 20 | 'with the /str option, or rebuild your VS project. 21 | ''' 22 | ''' A strongly-typed resource class, for looking up localized strings, etc. 23 | ''' 24 | _ 28 | Friend Module Resources 29 | 30 | Private resourceMan As Global.System.Resources.ResourceManager 31 | 32 | Private resourceCulture As Global.System.Globalization.CultureInfo 33 | 34 | ''' 35 | ''' Returns the cached ResourceManager instance used by this class. 36 | ''' 37 | _ 38 | Friend ReadOnly Property ResourceManager() As Global.System.Resources.ResourceManager 39 | Get 40 | If Object.ReferenceEquals(resourceMan, Nothing) Then 41 | Dim temp As Global.System.Resources.ResourceManager = New Global.System.Resources.ResourceManager("ConsoleTestFramework.Resources", GetType(Resources).Assembly) 42 | resourceMan = temp 43 | End If 44 | Return resourceMan 45 | End Get 46 | End Property 47 | 48 | ''' 49 | ''' Overrides the current thread's CurrentUICulture property for all 50 | ''' resource lookups using this strongly typed resource class. 51 | ''' 52 | _ 53 | Friend Property Culture() As Global.System.Globalization.CultureInfo 54 | Get 55 | Return resourceCulture 56 | End Get 57 | Set(ByVal value As Global.System.Globalization.CultureInfo) 58 | resourceCulture = value 59 | End Set 60 | End Property 61 | End Module 62 | End Namespace 63 | -------------------------------------------------------------------------------- /ProjectTypeTests/net4-console/My Project/Resources.resx: -------------------------------------------------------------------------------- 1 |  2 | 3 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | text/microsoft-resx 107 | 108 | 109 | 2.0 110 | 111 | 112 | System.Resources.ResXResourceReader, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 113 | 114 | 115 | System.Resources.ResXResourceWriter, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 116 | 117 | -------------------------------------------------------------------------------- /ProjectTypeTests/net4-console/My Project/Settings.Designer.vb: -------------------------------------------------------------------------------- 1 | '------------------------------------------------------------------------------ 2 | ' 3 | ' This code was generated by a tool. 4 | ' Runtime Version:4.0.30319.42000 5 | ' 6 | ' Changes to this file may cause incorrect behavior and will be lost if 7 | ' the code is regenerated. 8 | ' 9 | '------------------------------------------------------------------------------ 10 | 11 | Option Strict On 12 | Option Explicit On 13 | 14 | 15 | Namespace My 16 | 17 | _ 20 | Partial Friend NotInheritable Class MySettings 21 | Inherits Global.System.Configuration.ApplicationSettingsBase 22 | 23 | Private Shared defaultInstance As MySettings = CType(Global.System.Configuration.ApplicationSettingsBase.Synchronized(New MySettings), MySettings) 24 | 25 | #Region "My.Settings Auto-Save Functionality" 26 | #If _MyType = "WindowsForms" Then 27 | Private Shared addedHandler As Boolean 28 | 29 | Private Shared addedHandlerLockObject As New Object 30 | 31 | _ 32 | Private Shared Sub AutoSaveSettings(ByVal sender As Global.System.Object, ByVal e As Global.System.EventArgs) 33 | If My.Application.SaveMySettingsOnExit Then 34 | My.Settings.Save() 35 | End If 36 | End Sub 37 | #End If 38 | #End Region 39 | 40 | Public Shared ReadOnly Property [Default]() As MySettings 41 | Get 42 | 43 | #If _MyType = "WindowsForms" Then 44 | If Not addedHandler Then 45 | SyncLock addedHandlerLockObject 46 | If Not addedHandler Then 47 | AddHandler My.Application.Shutdown, AddressOf AutoSaveSettings 48 | addedHandler = True 49 | End If 50 | End SyncLock 51 | End If 52 | #End If 53 | Return defaultInstance 54 | End Get 55 | End Property 56 | End Class 57 | End Namespace 58 | 59 | Namespace My 60 | 61 | _ 64 | Friend Module MySettingsProperty 65 | 66 | _ 67 | Friend ReadOnly Property Settings() As Global.ConsoleTestFramework.My.MySettings 68 | Get 69 | Return Global.ConsoleTestFramework.My.MySettings.Default 70 | End Get 71 | End Property 72 | End Module 73 | End Namespace 74 | -------------------------------------------------------------------------------- /ProjectTypeTests/net4-console/My Project/Settings.settings: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | 6 | 7 | 8 | -------------------------------------------------------------------------------- /ProjectTypeTests/net4-console/net4-console.vbproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | Debug 6 | AnyCPU 7 | {95EED873-FA2D-4A31-815A-15D74D6AEEA1} 8 | Exe 9 | ConsoleTestFramework.Module1 10 | ConsoleTestFramework 11 | ConsoleTestFramework 12 | 512 13 | Console 14 | v4.7.2 15 | true 16 | true 17 | 18 | 19 | AnyCPU 20 | true 21 | full 22 | true 23 | true 24 | bin\Debug\ 25 | ConsoleTestFramework.xml 26 | 42016,41999,42017,42018,42019,42032,42036,42020,42021,42022 27 | 28 | 29 | AnyCPU 30 | pdbonly 31 | false 32 | true 33 | true 34 | bin\Release\ 35 | ConsoleTestFramework.xml 36 | 42016,41999,42017,42018,42019,42032,42036,42020,42021,42022 37 | 38 | 39 | On 40 | 41 | 42 | Binary 43 | 44 | 45 | Off 46 | 47 | 48 | On 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | True 76 | Application.myapp 77 | 78 | 79 | True 80 | True 81 | Resources.resx 82 | 83 | 84 | True 85 | Settings.settings 86 | True 87 | 88 | 89 | 90 | 91 | VbMyResourcesResXFileCodeGenerator 92 | Resources.Designer.vb 93 | My.Resources 94 | Designer 95 | 96 | 97 | 98 | 99 | MyApplicationCodeGenerator 100 | Application.Designer.vb 101 | 102 | 103 | SettingsSingleFileGenerator 104 | My 105 | Settings.Designer.vb 106 | 107 | 108 | 109 | 110 | 111 | {7dd0482c-2d6e-47b0-ba0c-28d5589d70c7} 112 | netstandard2_0 113 | 114 | 115 | 116 | -------------------------------------------------------------------------------- /ProjectTypeTests/net5-console/My Project/launchSettings.json: -------------------------------------------------------------------------------- 1 | { 2 | "profiles": { 3 | "ConsoleTestApp": { 4 | "commandName": "Project", 5 | "commandLineArgs": "--testing 1 --what abc/xyz.txt" 6 | }, 7 | "WSL 2": { 8 | "commandName": "WSL2", 9 | "distributionName": "", 10 | "environmentVariables": { 11 | "PATH": "Yo!" 12 | } 13 | } 14 | } 15 | } -------------------------------------------------------------------------------- /ProjectTypeTests/net5-console/My.vb: -------------------------------------------------------------------------------- 1 | Option Explicit On 2 | Option Strict On 3 | Option Infer On 4 | 5 | Imports Community.VisualBasic 6 | Imports System.Text 7 | 8 | Namespace My 9 | 10 | 11 | Friend Module MyDotStuff 12 | 13 | 'Friend Property Application As New Devices.Application 14 | Friend Property Computer As New Devices.Computer 15 | Friend Property User As New Community.VisualBasic.ApplicationServices.User 16 | 17 | End Module 18 | 19 | End Namespace 20 | 21 | Namespace Global.Microsoft.VisualBasic.CompilerServices 22 | 23 | 24 | Friend NotInheritable Class StringType 25 | 26 | ' Prevent creation. 27 | Private Sub New() 28 | End Sub 29 | 30 | Friend Shared Sub MidStmtStr(ByRef sDest As String, StartPosition As Integer, MaxInsertLength As Integer, sInsert As String) 31 | Dim DestLength As Integer 32 | Dim InsertLength As Integer 33 | Dim EndSegmentLength As Integer 34 | 35 | If sDest Is Nothing Then 36 | 'DestLength = 0 37 | Else 38 | DestLength = sDest.Length 39 | End If 40 | 41 | If sInsert Is Nothing Then 42 | 'InsertLength = 0 43 | Else 44 | InsertLength = sInsert.Length 45 | End If 46 | 47 | 'Zero base the index 48 | StartPosition -= 1 49 | 50 | If StartPosition < 0 OrElse StartPosition >= DestLength Then 51 | Throw New ArgumentException(SR.Format(SR.Argument_InvalidValue1, "Start")) 52 | End If 53 | 54 | If MaxInsertLength < 0 Then 55 | Throw New ArgumentException(SR.Format(SR.Argument_InvalidValue1, "Length")) 56 | End If 57 | 58 | ' first, limit the length of the source string 59 | ' to lenChange 60 | 61 | If (InsertLength > MaxInsertLength) Then 62 | InsertLength = MaxInsertLength 63 | End If 64 | 65 | ' second, limit the length to the available space 66 | ' in the destination string 67 | 68 | If (InsertLength > DestLength - StartPosition) Then 69 | InsertLength = DestLength - StartPosition 70 | End If 71 | 72 | If InsertLength = 0 Then 73 | 'Destination string remains unchanged 74 | Exit Sub 75 | End If 76 | 77 | 'This looks a bit complex for removing and inserting strings 78 | 'but when manipulating long strings, it should provide 79 | 'better performance because of fewer memcpys 80 | 81 | Dim sb As StringBuilder 82 | 83 | sb = New StringBuilder(DestLength) 84 | 85 | If StartPosition > 0 Then 86 | 'Append first part of destination string 87 | sb.Append(sDest, 0, StartPosition) 88 | End If 89 | 90 | 'Append InsertString 91 | sb.Append(sInsert, 0, InsertLength) 92 | EndSegmentLength = DestLength - (StartPosition + InsertLength) 93 | 94 | If EndSegmentLength > 0 Then 95 | 'Append remainder of destination string 96 | sb.Append(sDest, StartPosition + InsertLength, EndSegmentLength) 97 | End If 98 | 99 | sDest = sb.ToString() 100 | End Sub 101 | 102 | End Class 103 | 104 | End Namespace -------------------------------------------------------------------------------- /ProjectTypeTests/net5-console/Program.vb: -------------------------------------------------------------------------------- 1 | Option Explicit On 2 | Option Strict On 3 | Option Infer On 4 | 5 | Imports mVB = Microsoft.VisualBasic 6 | Imports cVB = Community.VisualBasic 7 | Imports System.Runtime.InteropServices 8 | 9 | Module Program 10 | 11 | Sub Main(args As String()) 12 | 13 | Dim a1 = 1.1 14 | Dim a2 = CInt(Fix(a1)) 15 | 16 | Console.Clear() 17 | 18 | 'Console.WriteLine(My.Application.Info.DirectoryPath) 19 | 'Console.WriteLine() 20 | 21 | Console.WriteLine($"Computer Name: {My.Computer.Name}.") 22 | Console.WriteLine($"OS Name: {My.Computer.Info.OSFullName}.") 23 | Console.WriteLine($"OS Type: {My.Computer.Info.OSPlatform}.") 24 | Console.WriteLine($"OS Version: {My.Computer.Info.OSVersion}.") 25 | 26 | Dim v = mVB.Asc("a"c) 27 | 28 | Dim a3 = "This is a test" 29 | Dim l1 = Left(a3, 4) 30 | 31 | Mid(a3, 2, 1) = "X" 32 | 33 | Dim c = New ClassLibraryTest.Class1() 34 | c.Test() 35 | 36 | Dim cl = cVB.Command 37 | Dim cl1 = c.GetCommandLine 38 | 39 | 'Console.WriteLine(My.User.Name) 40 | 41 | 'Console.WriteLine($"Command Line: {cl}") 42 | 'Console.WriteLine($"Command Line: {cl1}") 43 | 44 | 'Environment.SetEnvironmentVariable("OURVARIABLE", "OURVALUE") 45 | 'For Each entry As DictionaryEntry In Environment.GetEnvironmentVariables() 46 | ' Console.WriteLine($"{entry.Key}={entry.Value}") 47 | 'Next 48 | 49 | 'Dim e1 = cVB.Environ("PATH") 50 | 'Dim e2 = c.GetEnviron("PATH") 51 | 'Console.WriteLine($"PATH={e1}") 52 | 'Console.WriteLine($"PATH={e2}") 53 | 54 | If OperatingSystem.IsWindows AndAlso 55 | Debugger.IsAttached Then 56 | Console.WriteLine() 57 | Console.WriteLine("Press enter to close.") 58 | Console.ReadLine() 59 | End If 60 | 61 | End Sub 62 | 63 | End Module 64 | -------------------------------------------------------------------------------- /ProjectTypeTests/net5-console/net5-console.vbproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | Exe 5 | ConsoleTestApp 6 | net5.0 7 | ConsoleTestTestPackage 8 | ConsoleTestAuthors 9 | ConsoleTestCompany 10 | ConsoleTestProduct 11 | ConsoleTest Description 12 | (c) 2099, ConsoleTest 13 | 1.2.4 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | -------------------------------------------------------------------------------- /ProjectTypeTests/net5-windows/ApplicationEvents.vb: -------------------------------------------------------------------------------- 1 | Imports Microsoft.VisualBasic.ApplicationServices 2 | 3 | Namespace My 4 | ' The following events are available for MyApplication: 5 | ' Startup: Raised when the application starts, before the startup form is created. 6 | ' Shutdown: Raised after all application forms are closed. This event is not raised if the application terminates abnormally. 7 | ' UnhandledException: Raised if the application encounters an unhandled exception. 8 | ' StartupNextInstance: Raised when launching a single-instance application and the application is already active. 9 | ' NetworkAvailabilityChanged: Raised when the network connection is connected or disconnected. 10 | 11 | ' **NEW** ApplyHighDpiMode: Raised when the application queries the HighDpiMode to set it for the application. 12 | 13 | ' Example: 14 | 15 | ' Private Sub MyApplication_ApplyHighDpiMode(sender As Object, e As ApplyHighDpiModeEventArgs) Handles Me.ApplyHighDpiMode 16 | ' e.HighDpiMode = HighDpiMode.PerMonitorV2 17 | ' End Sub 18 | 19 | Partial Friend Class MyApplication 20 | 21 | End Class 22 | End Namespace 23 | -------------------------------------------------------------------------------- /ProjectTypeTests/net5-windows/Form1.Designer.vb: -------------------------------------------------------------------------------- 1 |  _ 2 | Partial Class Form1 3 | Inherits System.Windows.Forms.Form 4 | 5 | 'Form overrides dispose to clean up the component list. 6 | _ 7 | Protected Overrides Sub Dispose(ByVal disposing As Boolean) 8 | Try 9 | If disposing AndAlso components IsNot Nothing Then 10 | components.Dispose() 11 | End If 12 | Finally 13 | MyBase.Dispose(disposing) 14 | End Try 15 | End Sub 16 | 17 | 'Required by the Windows Form Designer 18 | Private components As System.ComponentModel.IContainer 19 | 20 | 'NOTE: The following procedure is required by the Windows Form Designer 21 | 'It can be modified using the Windows Form Designer. 22 | 'Do not modify it using the code editor. 23 | _ 24 | Private Sub InitializeComponent() 25 | components = New System.ComponentModel.Container() 26 | Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font 27 | Me.ClientSize = New System.Drawing.Size(800, 450) 28 | Me.Text = "Form1" 29 | End Sub 30 | 31 | End Class 32 | -------------------------------------------------------------------------------- /ProjectTypeTests/net5-windows/Form1.vb: -------------------------------------------------------------------------------- 1 | Public Class Form1 2 | 3 | 4 | 5 | Shared Sub Test() 6 | 7 | 'Dim logWriter = My.Application.Log.DefaultFileLogWriter 8 | 'Dim logPath = logWriter.FullLogFileName 9 | 10 | 'MsgBox(My.Application.Info.DirectoryPath) 11 | 12 | If My.Application.CommandLineArgs?.Count > 0 Then 13 | 14 | Dim k = Keys.Shift 15 | 16 | End If 17 | 18 | 'My.Application.CommandLineArgs 19 | 'My.Application.Culture 20 | ' - My.Application.HighDpiMode 21 | 'My.Application.Info 22 | 'My.Application.Log 23 | ' - My.Application.MinimumSplashScreenDisplayTime 24 | ' - My.Application.OpenForms 25 | ' - My.Application.SaveMySettingsOnExit 26 | ' - My.Application.SplashScreen 27 | ' - My.Application.UICulture 28 | 'My.Computer.* 29 | 'My.Computer.Network 30 | ' - My.Forms 31 | 'My.User.IsAuthenticated 32 | 'My.User.Name 33 | ' - My.WebServices 34 | 35 | End Sub 36 | 37 | Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load 38 | Test() 39 | End Sub 40 | 41 | End Class 42 | -------------------------------------------------------------------------------- /ProjectTypeTests/net5-windows/My Project/Application.Designer.HighDpi.vb: -------------------------------------------------------------------------------- 1 | Option Strict On 2 | Option Explicit On 3 | 4 | 'This constant indicates whether the Application Framework is in use. 5 | #Const APPLICATION_FRAMEWORK = True 6 | 7 | #If APPLICATION_FRAMEWORK Then 8 | 9 | #If NET5_0 And Not NET6_0 Then 10 | 11 | Imports System.Collections.ObjectModel 12 | 13 | Namespace My 14 | 15 | Partial Friend Class MyApplication 16 | 17 | Public Event ApplyHighDpiMode(sender As Object, e As ApplyHighDpiModeEventArgs) 18 | 19 | Private _highDpiMode As HighDpiMode? 20 | 21 | Friend Shadows Property HighDpiMode As HighDpiMode 22 | Get 23 | Return If( 24 | _highDpiMode Is Nothing, 25 | Application.HighDpiMode, 26 | _highDpiMode.Value) 27 | End Get 28 | Set(value As HighDpiMode) 29 | _highDpiMode = value 30 | End Set 31 | End Property 32 | 33 | ' IMPORTANT: 34 | ' If this method causes an compilation error after you've unchecked 'Application Framework' 35 | ' in the project properties, go to the top of this file and change the value to 'False' in this line: 36 | ' #Const APPLICATION_FRAMEWORK = False 37 | 38 | ' For more about using WinForms without the Application Framework 39 | ' see: https://aka.ms/visualbasic-appframework-net5 40 | Protected Overrides Function OnInitialize(commandLineArgs As ReadOnlyCollection(Of String)) As Boolean 41 | Dim eventArgs = New ApplyHighDpiModeEventArgs( 42 | If( 43 | _highDpiMode Is Nothing, 44 | HighDpiMode.SystemAware, 45 | _highDpiMode.Value)) 46 | 47 | RaiseEvent ApplyHighDpiMode(Me, eventArgs) 48 | 49 | Windows.Forms.Application.SetHighDpiMode(eventArgs.HighDpiMode) 50 | 51 | Return MyBase.OnInitialize(commandLineArgs) 52 | End Function 53 | End Class 54 | 55 | Public Class ApplyHighDpiModeEventArgs 56 | Inherits EventArgs 57 | 58 | Public Sub New(highDpiMode As HighDpiMode) 59 | Me.HighDpiMode = highDpiMode 60 | End Sub 61 | 62 | Public Property HighDpiMode As HighDpiMode 63 | 64 | End Class 65 | 66 | End Namespace 67 | 68 | #End If ' #If NET5_0 And Not NET6_0 69 | #End If ' #If APPLICATION_FRAMEWORK 70 | -------------------------------------------------------------------------------- /ProjectTypeTests/net5-windows/My Project/Application.Designer.vb: -------------------------------------------------------------------------------- 1 | '------------------------------------------------------------------------------ 2 | ' 3 | ' This code was generated by a tool. 4 | ' Runtime Version:4.0.30319.42000 5 | ' 6 | ' Changes to this file may cause incorrect behavior and will be lost if 7 | ' the code is regenerated. 8 | ' 9 | '------------------------------------------------------------------------------ 10 | 11 | Option Strict On 12 | Option Explicit On 13 | 14 | 15 | Namespace My 16 | 17 | 'NOTE: This file is auto-generated; do not modify it directly. To make changes, 18 | ' or if you encounter build errors in this file, go to the Project Designer 19 | ' (go to Project Properties or double-click the My Project node in 20 | ' Solution Explorer), and make changes on the Application tab. 21 | ' 22 | Partial Friend Class MyApplication 23 | 24 | _ 25 | Public Sub New() 26 | MyBase.New(Global.Microsoft.VisualBasic.ApplicationServices.AuthenticationMode.Windows) 27 | Me.IsSingleInstance = false 28 | Me.EnableVisualStyles = true 29 | Me.SaveMySettingsOnExit = true 30 | Me.ShutDownStyle = Global.Microsoft.VisualBasic.ApplicationServices.ShutdownMode.AfterMainFormCloses 31 | End Sub 32 | 33 | _ 34 | Protected Overrides Sub OnCreateMainForm() 35 | Me.MainForm = Global.WinFormsTestApp.Form1 36 | End Sub 37 | End Class 38 | End Namespace 39 | -------------------------------------------------------------------------------- /ProjectTypeTests/net5-windows/My Project/Application.myapp: -------------------------------------------------------------------------------- 1 |  2 | 3 | true 4 | Form1 5 | false 6 | 0 7 | true 8 | 0 9 | true 10 | -------------------------------------------------------------------------------- /ProjectTypeTests/net5-windows/net5-windows.vbproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | WinExe 5 | net5.0-windows 6 | WinFormsTestApp 7 | Sub Main 8 | true 9 | WindowsForms 10 | WinFormsTestPackage 11 | WinformsTestAuthors 12 | WinformsTestCompany 13 | WinFormsTestProduct 14 | WinFormsTest Description 15 | (c) 2099, WinFormsTest 16 | 1.2.3 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | True 28 | True 29 | Application.myapp 30 | 31 | 32 | 33 | 34 | 35 | MyApplicationCodeGenerator 36 | Application.Designer.vb 37 | 38 | 39 | 40 | -------------------------------------------------------------------------------- /ProjectTypeTests/netstandard2_0/Class1.Late.vb: -------------------------------------------------------------------------------- 1 | Option Explicit Off 2 | Option Strict Off 3 | Option Infer Off 4 | 5 | Imports cVB = Community.VisualBasic 6 | 7 | Partial Public Class Class1 8 | 9 | Private Sub FileGet(filenum As Integer, fs As FileStructure, record As Integer) 10 | cVB.FileGet(1, fs, 1) 11 | End Sub 12 | 13 | 14 | End Class 15 | -------------------------------------------------------------------------------- /ProjectTypeTests/netstandard2_0/My.vb: -------------------------------------------------------------------------------- 1 | Option Explicit On 2 | Option Strict On 3 | Option Infer On 4 | 5 | Imports Community.VisualBasic 6 | Imports System.Text 7 | 8 | Namespace My 9 | 10 | 11 | 12 | Friend Module MyProject 13 | 14 | 15 | Friend ReadOnly Property Computer() As Devices.Computer 16 | 17 | Get 18 | Return m_computerObjectProvider.GetInstance() 19 | End Get 20 | End Property 21 | 22 | Private ReadOnly m_computerObjectProvider As New ThreadSafeObjectProvider(Of Devices.Computer) 23 | 24 | 25 | Friend ReadOnly Property Application() As ApplicationServices.ConsoleApplicationBase 26 | 27 | Get 28 | Return m_appObjectProvider.GetInstance() 29 | End Get 30 | End Property 31 | Private ReadOnly m_appObjectProvider As New ThreadSafeObjectProvider(Of ApplicationServices.ConsoleApplicationBase) 32 | 33 | 34 | Friend ReadOnly Property User() As ApplicationServices.User 35 | 36 | Get 37 | Return m_userObjectProvider.GetInstance() 38 | End Get 39 | End Property 40 | Private ReadOnly m_userObjectProvider As New ThreadSafeObjectProvider(Of ApplicationServices.User) 41 | 42 | 43 | 44 | Friend NotInheritable Class ThreadSafeObjectProvider(Of T As New) 45 | Friend ReadOnly Property GetInstance() As T 46 | 47 | Get 48 | Dim Value As T = m_context.Value 49 | If Value Is Nothing Then 50 | Value = New T 51 | m_context.Value() = Value 52 | End If 53 | Return Value 54 | End Get 55 | End Property 56 | 57 | 58 | 59 | Public Sub New() 60 | MyBase.New() 61 | End Sub 62 | 63 | Private ReadOnly m_context As New MyServices.Internal.ContextValue(Of T) 64 | 65 | End Class 66 | 67 | End Module 68 | 69 | End Namespace 70 | 71 | Namespace Global.Microsoft.VisualBasic.CompilerServices 72 | 73 | 74 | Friend NotInheritable Class StringType 75 | 76 | ' Prevent creation. 77 | Private Sub New() 78 | End Sub 79 | 80 | Friend Shared Sub MidStmtStr(ByRef sDest As String, StartPosition As Integer, MaxInsertLength As Integer, sInsert As String) 81 | Dim DestLength As Integer 82 | Dim InsertLength As Integer 83 | Dim EndSegmentLength As Integer 84 | 85 | If sDest Is Nothing Then 86 | 'DestLength = 0 87 | Else 88 | DestLength = sDest.Length 89 | End If 90 | 91 | If sInsert Is Nothing Then 92 | 'InsertLength = 0 93 | Else 94 | InsertLength = sInsert.Length 95 | End If 96 | 97 | 'Zero base the index 98 | StartPosition -= 1 99 | 100 | If StartPosition < 0 OrElse StartPosition >= DestLength Then 101 | Throw New ArgumentException(SR.Format(SR.Argument_InvalidValue1, "Start")) 102 | End If 103 | 104 | If MaxInsertLength < 0 Then 105 | Throw New ArgumentException(SR.Format(SR.Argument_InvalidValue1, "Length")) 106 | End If 107 | 108 | ' first, limit the length of the source string 109 | ' to lenChange 110 | 111 | If (InsertLength > MaxInsertLength) Then 112 | InsertLength = MaxInsertLength 113 | End If 114 | 115 | ' second, limit the length to the available space 116 | ' in the destination string 117 | 118 | If (InsertLength > DestLength - StartPosition) Then 119 | InsertLength = DestLength - StartPosition 120 | End If 121 | 122 | If InsertLength = 0 Then 123 | 'Destination string remains unchanged 124 | Exit Sub 125 | End If 126 | 127 | 'This looks a bit complex for removing and inserting strings 128 | 'but when manipulating long strings, it should provide 129 | 'better performance because of fewer memcpys 130 | 131 | Dim sb As StringBuilder 132 | 133 | sb = New StringBuilder(DestLength) 134 | 135 | If StartPosition > 0 Then 136 | 'Append first part of destination string 137 | sb.Append(sDest, 0, StartPosition) 138 | End If 139 | 140 | 'Append InsertString 141 | sb.Append(sInsert, 0, InsertLength) 142 | EndSegmentLength = DestLength - (StartPosition + InsertLength) 143 | 144 | If EndSegmentLength > 0 Then 145 | 'Append remainder of destination string 146 | sb.Append(sDest, StartPosition + InsertLength, EndSegmentLength) 147 | End If 148 | 149 | sDest = sb.ToString() 150 | End Sub 151 | 152 | End Class 153 | 154 | End Namespace -------------------------------------------------------------------------------- /ProjectTypeTests/netstandard2_0/netstandard2_0.vbproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | ClassLibraryTest 5 | netstandard2.0 6 | ClassLibraryPackage 7 | ClassLibraryAuthors 8 | ClassLibraryCompany 9 | ClassLibraryProduct 10 | ClassLibrary Description 11 | (c) 2099, ClassLibrary 12 | 1.2.5 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Community.VisualBasic 2 | 3 | A very **experimental** alternate to the official [Microsoft.VisualBasic](https://github.com/dotnet/runtime/tree/master/src/libraries/Microsoft.VisualBasic.Core) runtime initially created to evaluate the support of the many ease-of-use features that makes Visual Basic, well, Visual Basic targetting .NET development for non-WinForms projects - especially *netstandard2.0*, *netstandard2.1* and, to some degree, .NET Console applications where cross-platform (Debian Linux / RaspPi) capability is desired. 4 | 5 | Much of the common functionality one would *expect* there to exist as part of Visual Basic is **missing** if you desire to build a reusable library targeting *netstandard 2.x* forcing you have to potentially rewrite a lot of code and missing out on a much of what makes VB approachable/usable. A lot of this isn't necessarily tied to WinForms and it would be nice to have regardless of building a netstandard library, console application (Windows or Linux) or WinForms. 6 | 7 | ## Why? 8 | 9 | ~~"We are not accepting feature contributions to Microsoft.VisualBasic.Core. The library is effectively archived.~~ 10 | 11 | ~~The library and supporting language features are mature and no longer evolving, and the risk of code change likely exceeds the benefit. We will consider changes that address significant bugs or regressions, or changes that are necessary to continue shipping the binaries. Other changes will be rejected."~~ 12 | 13 | Unlike the project(s) that this is based upon, contributions are encouraged! This isn't meant to be a knock on what Microsoft is or is not doing; to the contrary. I envision this as an opportunity for the Visual Basic community to accept ownership in their own future. I understand that Microsoft has limited resources (contrary to what commentors may think) and, ultimately, I believe strongly that the Visual Basic runtime is a great place for us to explore what the future of Visual Basic might mean (beyond core language structure). 14 | 15 | ## Not a Fork 16 | 17 | As you may have noticed, this project is not a direct fork of [Microsoft.VisualBasic](https://github.com/dotnet/runtime/tree/master/src/libraries/Microsoft.VisualBasic.Core); this is on purpose. This project is going to utilize the latest tools available to improve the code base as time progresses - meaning that some of the code will be "cleaned up" based on the suggestions provided directly in Visual Studio 2022 (and beyond). Additionally, this project may eventually be split apart in order to better faciliate nuget packaging, cross-platform targeting, etc. Trying to somehow maintain this codebase with the original source seems, at least to me, be impossible if these sorts of changes are desired in the long term. Additionally, a different namespace across the project is needed in order to publish this as a nuget package as the namespace has to be something that isn't *reserved* - something else that I think pretty much breaks the possibility of having a fork maintained. 18 | 19 | ## Goal 20 | 21 | The overall goal, at this stage, is to create a pretty complete implementation of the original [Microsoft.VisualBasic](https://github.com/dotnet/runtime/tree/master/src/libraries/Microsoft.VisualBasic.Core) namespace that works in .netstandard 2.x and, as much as possible, within a Console application running on Debian Linux. I make sure to use the term *namespace* as *assembly*/*project* are probably a bit misleading given that functionality for this *namespace* appears to be implemented in at least three different projects (roslyn, dotnet and winforms). Where possible, will try to implement everything that isn't on the following list: 22 | 23 | - My.Computer.Keyboard.* 24 | - My.Computer.Mouse.* 25 | - My.Computer.Screen.* 26 | - My.Computer.Clipboard.* 27 | - My.Computer.Registry.* 28 | - My.Forms 29 | - MsgBox() 30 | 31 | The above list is what I am currently aware of (off the top of my head) regarding functionality that is either very Windows specific (or more appropriately, WinForms specific). Will evaluate implementing the above functionality where possible as we progress forward. 32 | 33 | ## Ideas / Thoughts for moving forward... 34 | 35 | - Be able to create a new *netstandard2.0* project. 36 | - Easily build using Visual Studio 2022 (17.4+). 37 | - Easily leverage in any .NET project... including targeting the Blazor platform. 38 | - It is a stated goal from the beginning that the project not be 100% compatible with .NET WinForms VisualBasic library as some things will have to give considering we are attempting to reach cross-platform capability; with that said, where possible compatibility will be strived for and maintained. 39 | - In addition to throwing a New PlatformNotSupportedException, will leverage *obsolete* attributes for functionality that will not work so that the consumer of the package will know quickly that something will most likely fail. 40 | - Review all code for functionality on, at minimum, Windows and Debian Linux - with primary evaluation of Linux debugging taking place directly in Visual Studio thanks to WSL2. 41 | - During this process, refactoring the code (where possible - without breaking functionality) so that default Visual Studio settings code analysis warnings are fixed. 42 | - Additional functionality may be added, TBD at a later date. 43 | 44 | ## Discord 45 | 46 | Please feel to join us over on Discord: 47 | 48 | - [Discord Invite](https://discord.gg/Y8EH5fF6WG) 49 | 50 | ## Future 51 | 52 | Once this project is at the "a solid state" stage regarding **existing functionality**, we will be considering new functionality to take things into the future. So if you have ideas that you think might be considered, please start the conversation in the discussions. 53 | 54 | --------------------------------------------------------------------------------