commandline.vb

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

        Try
            strLines = IO.File.ReadAllLines(Filename)
        Catch ex As IO.IOException
            Compiler.Report.ShowMessage(Messages.VBNC2007, Filename)
            Return False
        End Try

        'Read the file, line by line.
        For Each strLine As String In strLines
            If strLine.StartsWith("#") = False Then 'Skip comment lines
                lstArgs.AddRange(Helper.ParseLine(strLine))    'Add the parsed elements of the line
            End If
        Next

        'Create a string array from the arraylist
        Dim strArgs(lstArgs.Count - 1) As String
        lstArgs.CopyTo(strArgs, 0)
        'Parse the arguments
        Return ParseInternal(strArgs)
    End Function

    ''' <summary>
    ''' Add all the files corresponding to the specified pattern in the specified
    ''' directory to the list of code files, recursively.
    ''' </summary>
    Private Function AddFilesInDir(ByVal dir As String, ByVal relativepath As String, ByVal pattern As String) As Boolean
        Dim strFiles() As String
        Dim result As Boolean = True

        strFiles = IO.Directory.GetFiles(dir, pattern)
        For Each strFile As String In strFiles
            m_lstFileNames.Add(New CodeFile(strFile, relativepath, Me.Compiler))
        Next
        result = True
        strFiles = IO.Directory.GetDirectories(dir)
        For Each strDir As String In strFiles
            result = AddFilesInDir(strDir, IO.Path.Combine(relativepath, System.IO.Path.GetFileName(strDir)), pattern) AndAlso result
        Next
        'whoami()
        Return result
    End Function

    Private Function SetOption(ByVal strName As String, ByVal strValue As String) As Boolean
        Dim result As Boolean = True
        Select Case LCase(strName)
            ' - OUTPUT FILE -
            Case "out"
                m_strOut = strValue
            Case "target", "t"
                Select Case LCase(strValue)
                    Case "exe"
                        m_strTarget = Targets.Console
                    Case "winexe"
                        m_strTarget = Targets.Winexe
                    Case "library"
                        m_strTarget = Targets.Library
                    Case "module"
                        m_strTarget = Targets.Module
                    Case Else
                        Compiler.Report.SaveMessage(Messages.VBNC2019, "target", strValue)
                        result = False
                End Select
                ' - INPUT FILES -
            Case "addmodule"
                m_lstModules.AddRange(Split(strValue, ","))
            Case "recurse"
                'Add the files
                Dim strPath As String = System.IO.Path.GetDirectoryName(strValue)
                Dim strRelativePath As String = strPath
                Dim strFileName As String
                If strPath <> "" Then
                    strFileName = strValue.Substring(strPath.Length + 1)
                Else
                    strPath = IO.Directory.GetCurrentDirectory()
                    strFileName = strValue
                End If
                result = AddFilesInDir(strPath, strRelativePath, strFileName) AndAlso result
            Case "reference", "r"
                m_lstReferences.AddRange(Split(strValue, ","))
                ' - RESOURCES -
            Case "linkresource", "linkres"
                result = m_lstLinkResources.Add(strValue) AndAlso result
            Case "resource", "res"
                result = m_lstResources.Add(strValue) AndAlso result
            Case "win32icon"
                m_strWin32Icon = strValue
            Case "win32resource"
                m_strWin32Resource = strValue
                ' - CODE GENERATION -
            Case "optimize+", "optimize"
                m_bOptimize = True
            Case "optimize-"
                m_bOptimize = False
            Case "removeintchecks+", "removeintchecks"
                m_bRemoveIntChecks = True
            Case "removeintchecks-"
                m_bRemoveIntChecks = False
            Case "debug+"
                m_eDebugInfo = DebugTypes.Full
            Case "debug-"
                m_eDebugInfo = DebugTypes.None
            Case "debug"
                Select Case LCase(strValue)
                    Case "full"
                        m_eDebugInfo = DebugTypes.Full
                    Case "pdbonly"
                        m_eDebugInfo = DebugTypes.PDB
                    Case ""
                        m_eDebugInfo = DebugTypes.Full
                    Case Else
                        'TODO: AddError 2014 (saved).
                        Compiler.Report.SaveMessage(Messages.VBNC2019, strName, strValue)
                        result = False
                End Select
                ' - ERRORS AND WARNINGS -
            Case "nowarn"
                m_bNoWarn = True
            Case "warnaserror+", "warnaserror"
                m_bWarnAsError = True
            Case "warnaserror-"
                m_bWarnAsError = False
                ' - LANGUAGE -
            Case "define", "d"
                Dim strDefines() As String = Split(strValue, ",")
                For Each str As String In strDefines
                    If str.Contains("=") = False Then str = str & "=True"
                    Dim strSplit() As String = Split(str, "=")
                    If strSplit.GetUpperBound(0) <> 1 Then
                        Compiler.Report.ShowMessage(Messages.VBNC90017, str)
                        result = False
                    Else
                        m_lstDefine.Add(New Define(strSplit(0), strSplit(1)))
                    End If
                Next
            Case "imports"
                Dim imps As String()
                imps = strValue.Split(","c)
                For Each str As String In imps
                    If str <> "" Then
                        result = vbnc.Parser.ParseImportsStatement(m_lstImports, str) AndAlso result
                    End If
                Next
            Case "optionexplicit+", "optionexplicit"
                m_eOptionExplicit = OptionExplicitTypes.On
            Case "optionexplicit-"
                m_eOptionExplicit = OptionExplicitTypes.Off
            Case "optionstrict+", "optionstrict"
                m_eOptionStrict = OptionStrictTypes.On
            Case "optionstrict-"
                Console.WriteLine("Warning: Option Strict Off will probably fail.")
                m_eOptionStrict = OptionStrictTypes.Off
            Case "rootnamespace"
                m_strRootNamespace = strValue
            Case "optioncompare"
                Select Case LCase(strValue)
                    Case "text"
                        m_eOptionCompare = OptionCompareTypes.Text
                    Case "binary"
                        m_eOptionCompare = OptionCompareTypes.Binary
                    Case Else
                        result = False
                        'TODO: AddError 2014 (saved).
                        Compiler.Report.SaveMessage(Messages.VBNC2019, strName, strValue)
                End Select
                ' - MISCELLANEOUS -
            Case "help", "?"
                m_bHelp = True
            Case "nologo"
                m_bNoLogo = True
            Case "quiet"
                m_bQuiet = True
            Case "verbose", "verbose+"
                m_bVerbose = True
            Case "verbose-"
                m_bVerbose = False
            Case "noconfig"
                m_bNoConfig = True
                ' - ADVANCED -
            Case "baseaddress"
                m_strBaseAddress = strValue
            Case "bugreport"
                m_strBugReport = strValue
            Case "codepage"
                If strValue = "" Then
                    Compiler.Report.ShowMessage(Messages.VBNC2006, "codepage", "<number>")
                    result = False
                Else
                    Try
                        m_Encoding = System.Text.Encoding.GetEncoding(Integer.Parse(strValue, Globalization.NumberStyles.AllowLeadingWhite Or Globalization.NumberStyles.AllowLeadingSign, System.Globalization.CultureInfo.InvariantCulture))
                    Catch
                        Compiler.Report.ShowMessage(Messages.VBNC2016, strValue)
                        result = False
                    End Try
                End If
            Case "delaysign+"
                m_bDelaySign = True
            Case "delaysign-"
                m_bDelaySign = False
            Case "keycontainer"
                m_strKeyContainer = strValue
            Case "keyfile"
                Dim paths() As String
                paths = Me.GetFullPaths(strValue)
                If paths IsNot Nothing AndAlso paths.Length = 1 Then
                    m_strKeyFile = paths(0)
                Else
                    Helper.AddError("""")
                End If
            Case "libpath"
                m_lstLibPath.AddRange(Split(strValue, ","))
            Case "main"
                m_strMain = strValue
            Case "netcf"
                m_bNetCF = True
                result = False
                Compiler.Report.ShowMessage(Messages.VBNC90016, ".NET Compact Framework")
            Case "sdkpath"
                m_strSDKPath = strValue
            Case "utf8output+", "utf8output"
                m_bUTF8Output = True
            Case "utf8output-"
                m_bUTF8Output = False
#If DEBUG Then
            Case "dump"
                m_bDumping = True
                m_StopAfter = strValue
#End If
            Case "novbruntimeref"
                m_NoVBRuntimeRef = True
            Case "errorreport"
                Helper.NotImplementedYet(strName)
            Case "vbversion"
                Select Case strValue
                    Case "7"
                        m_VBVersion = VBVersions.V7
                    Case "7.1"
                        m_VBVersion = VBVersions.V7_1
                    Case "8"
                        m_VBVersion = VBVersions.V8
                    Case Else
                        Helper.AddWarning("Unknown vb version: " & strValue & ", will use default vbversion (8)")
                End Select
            Case Else
                'result = False 'OK since this is only a warning.
                Compiler.Report.SaveMessage(Messages.VBNC2009, strName)
        End Select
        Return result
    End Function

    Private Function AddFile(ByVal File As String) As Boolean
        Dim result As Boolean = True

        Dim strFile As String
        Dim strFiles As String()

        strFiles = GetFullPaths(File)

        If strFiles Is Nothing OrElse strFiles.Length = 0 Then
            If IsPattern(File) = False Then
                result = Compiler.Report.SaveMessage(Messages.VBNC2001, File) AndAlso result
            End If
            Return result
        End If

        For Each strFile In strFiles
            m_lstFileNames.Add(New CodeFile(strFile, System.IO.Path.GetDirectoryName(File), Me.Compiler))
        Next

        Return result
    End Function

    ''' <summary>
    ''' Parses the commandline
    ''' Returns false if no commandline found, or if there was an error parsing the commandline.
    ''' Messages here are saved, since they have to be shown after the logo is shown, but the 
    ''' showing of the logo can be cancelled on the commandline, so the entire commandline
    ''' has to the parsed before any messages are shown.
    ''' </summary>
    Private Function ParseInternal(ByVal Args() As String) As Boolean
        Dim result As Boolean = True
        m_lstAllArgs.AddRange(Args)
        For Each s As String In Args
            If s.StartsWith("@") Then
                Dim strResponseFile As String = s.Substring(1)
                '#If DEBUG Then
                'Hack for the testing to work in VS since the current directory is set to where the compiler
                'is, not where the test is.
                If strResponseFile.EndsWith("debug.rsp") AndAlso System.Diagnostics.Debugger.IsAttached Then
                    strResponseFile = IO.Path.GetFullPath(strResponseFile)
                    For Each str As String In IO.File.ReadAllLines(strResponseFile)
                        For Each arg As String In Helper.ParseLine(str)
                            If arg.StartsWith("@") Then
                                Environment.CurrentDirectory = IO.Path.GetDirectoryName(arg.Substring(1))
                                Exit For
                            ElseIf arg.IndexOfAny(IO.Path.GetInvalidFileNameChars) = -1 AndAlso IO.File.Exists(arg) Then
                                Environment.CurrentDirectory = IO.Path.GetDirectoryName(arg)
                                Exit For
                            End If
                        Next
                    Next
                End If
                '#End If
                result = ParseResponseFile(strResponseFile) AndAlso result
                Continue For
            End If

            Dim isOption As Boolean

            isOption = s.StartsWith("-"c)
            If isOption = False AndAlso s.StartsWith("/"c) Then
                Dim idxSecond As Integer = s.IndexOf("/"c, 2)
                Dim idxColon As Integer = s.IndexOf(":"c, 2)

                isOption = idxColon >= 0 OrElse idxSecond = -1
            End If

            If isOption Then
                Dim strName As String = "", strValue As String = ""
                'Find the colon which separates the values
                Dim iColon As Integer = InStr(2, s, ":", CompareMethod.Binary)
                'If found, split it in a name and value pair
                If iColon > 0 Then
                    strName = s.Substring(1, iColon - 2)
                    strValue = s.Substring(strName.Length + 2)
                Else
                    'if not, the whole string is the name
                    strName = s.Substring(1)
                End If
                'find the option
                result = SetOption(strName, strValue) AndAlso result
                Continue For
            End If

            AddFile(s)
        Next

        Return result
    End Function

    ''' <summary>
    ''' Shows an error if the filename(s) cannot be found.
    ''' If it returns an empty array something went wrong 
    ''' (the error message has already been shown).
    ''' </summary>
    ''' <param name="FileName">Can be a complete filename or a pattern.</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function GetFullPaths(ByVal FileName As String) As String()
        Dim strPath As String = System.IO.Path.GetDirectoryName(FileName)
        Dim strFileName As String

        If strPath <> "" Then
            strFileName = FileName.Substring(strPath.Length + 1)
        Else
            strFileName = FileName
        End If

        Dim tmpPath As String
        If strPath = "" Then
            strPath = IO.Path.GetDirectoryName(IO.Path.GetFullPath(FileName))
        End If
        tmpPath = IO.Path.GetFullPath(strPath)

        If IO.Directory.Exists(tmpPath) = False Then Return Nothing

        If IsPattern(FileName) Then
            Return IO.Directory.GetFiles(tmpPath, strFileName)
        Else
            Dim file As String = IO.Path.Combine(tmpPath, strFileName)
            If IO.File.Exists(file) Then
                Return New String() {file}
            Else
                Return Nothing
            End If
        End If
    End Function

    Shared Function IsPattern(ByVal Filename As String) As Boolean
        Return Filename.IndexOfAny(PATTERNCHARS) >= 0
    End Function

    ''' <summary>
    ''' Returns a collection of all the arguments parsed (included in 
    ''' response files).
    ''' </summary>
    ReadOnly Property AllArguments() As Specialized.StringCollection
        Get
            Return m_lstAllArgs
        End Get
    End Property

#If DEBUG Then
    Sub Dump()
        Compiler.Report.WriteLine("Commandline dump:")
        Compiler.Report.WriteLine(" FileNames:")
        For Each file As CodeFile In m_lstFileNames
            Compiler.Report.WriteLine("  " & file.FileName)
        Next
        Compiler.Report.WriteLine(" Arguments:")
        For Each s As String In m_lstAllArgs
            Compiler.Report.WriteLine("  " & s)
        Next
        Compiler.Report.WriteLine("End of commandline dump.")
    End Sub
#End If
End Class


Partial Public Class CommandLine
    Public Enum VBVersions
        V7
        V7_1
        V8
    End Enum
End Class