modloparser.bas

一个把VB原代码转换为VC原代码的软件代码。

End Function

' --- Check if letter is an equal char --- '
Public Function IsEqual(ELetter As String) As Boolean
    If ELetter = "=" Then IsEqual = True
End Function

' --- Check if letter is an asterisk char --- '
Public Function IsAsterisk(ALetter As String) As Boolean
    If ALetter = "*" Then IsAsterisk = True
End Function

' --- Check if letter is an dot char --- '
Public Function IsDot(PLetter As String) As Boolean
    If PLetter = "." Then IsDot = True
End Function

' --- Check if letter is an minus char --- '
Public Function IsMinus(MLetter As String) As Boolean
    If MLetter = "-" Then IsMinus = True
End Function

' --- Check if letter is an comma char --- '
Public Function IsComma(CLetter As String) As Boolean
    If CLetter = "," Then IsComma = True
End Function

' --- Check if letter is an tilde char --- '
Public Function IsArobas(PLetter As String) As Boolean
    If PLetter = "@" Then IsArobas = True
End Function

' --- Check if letter is a space in an argument --- '
Public Function IsBlankArg(BLetter As String, InString As Integer) As Boolean
    If InString = 0 Then If BLetter = " " Or BLetter = "(" Or BLetter = ")" Then IsBlankArg = True
End Function

' --- Check if an element can be translated into a simple type --- '
' Can return:
' VAR_NULL
' VAR_LONG
' VAR_SINGLE
' VAR_DOUBLE
' VAR_INSIDELONG
' VAR_INSIDEDOUBLE
' VAR_STRING
' VAR_BOOLEAN
Public Function IsSimpleElement(ElToCheck As String, CheckInsideStrings As Boolean) As Long
    Dim BolSign As Integer
    Dim TestSign As String
    Dim TestDouble As Long
    Dim PosDot As Long
    Dim LeftDblPart As String
    Dim RightDblPart As String
    Dim SingleDoubleForce As Integer
    Dim SimpleInside As Long
    NumberSuffix = 0
    SimpleHexType = 0
    IsSimpleElement = VAR_NULL      ' Default type
    SingleDoubleForce = 0
    
    ' Remove single/double suffixes (if any)
    If IsExclamation(Right(ElToCheck, 1)) Then
        ElToCheck = Mid(ElToCheck, 1, Len(ElToCheck) - 1)
        NumberSuffix = 1
        ' Single number
        SingleDoubleForce = 1
    End If
    If IsDiese(Right(ElToCheck, 1)) Then
        ElToCheck = Mid(ElToCheck, 1, Len(ElToCheck) - 1)
        NumberSuffix = 1
        ' Double number
        SingleDoubleForce = 2
    End If
    
    ' Remove extra minus chars
    TestSign = ElToCheck
    BolSign = 0
    Do While IsMinus(left(TestSign, 1))
        If IsMinus(left(TestSign, 1)) Then
            BolSign = BolSign Xor 1
            TestSign = Mid(TestSign, 2)
        End If
    Loop
    If BolSign <> 0 Then TestSign = "-" & TestSign
    ElToCheck = TestSign
    
    ' Hexadecimal
    If UCase(left(ElToCheck, 2)) = "&H" And Right(ElToCheck, 1) = "&" Then
        IsSimpleElement = VAR_LONG
        SimpleHexType = 1
        Exit Function
    End If
    If UCase(left(ElToCheck, 2)) = "&H" And Right(ElToCheck, 1) <> "&" Then
        IsSimpleElement = VAR_LONG
        SimpleHexType = 2
        Exit Function
    End If
    
    ' Is it an integer ?
    If IsNumeric(ElToCheck) Then
        Select Case SingleDoubleForce
            Case 0
                IsSimpleElement = VAR_LONG
            Case 1
                IsSimpleElement = VAR_SINGLE
            Case 2
                IsSimpleElement = VAR_DOUBLE
        End Select
        Exit Function
    End If
    
    If (IsStringDelim(left(ElToCheck, 1)) And IsStringDelim(Right(ElToCheck, 1))) Then
        If CheckInsideStrings = True Then
            ' Check if there's a simple type inside the quotes
            FoundBooleanInside = False
            SimpleInside = IsSimpleElement(Mid(ElToCheck, 2, Len(ElToCheck) - 2), False)
            Select Case SimpleInside
                Case VAR_LONG
                    FoundBooleanInside = False
                    IsSimpleElement = VAR_INSIDELONG
                    Exit Function
                Case VAR_SINGLE
                    FoundBooleanInside = False
                    ' (Don't report single numbers yet)
                    IsSimpleElement = VAR_INSIDEDOUBLE
                    Exit Function
                Case VAR_DOUBLE
                    FoundBooleanInside = False
                    IsSimpleElement = VAR_INSIDEDOUBLE
                    Exit Function
                Case VAR_BOOLEAN
                    ' Notify that we found a boolean inside the quotes
                    FoundBooleanInside = True
                    IsSimpleElement = VAR_STRING
                    Exit Function
                Case Else
                    FoundBooleanInside = False
                    IsSimpleElement = VAR_STRING
                    Exit Function
            End Select
        Else
            IsSimpleElement = VAR_STRING
            Exit Function
        End If
    End If
    
    ' Is it a boolean ?
    If lstrcmpi(ElToCheck, "TRUE") = 0 Then
        BoolValue = BOL_TRUE
        IsSimpleElement = VAR_BOOLEAN
        Exit Function
    End If
    If lstrcmpi(ElToCheck, "FALSE") = 0 Then
        BoolValue = BOL_FALSE
        IsSimpleElement = VAR_BOOLEAN
        Exit Function
    End If
    
    ' Is it a decimal number ?
    PosDot = InStr(1, ElToCheck, ".")
    If PosDot <> 0 Then
        TestDouble = 1
        If IsMinus(left(ElToCheck, 1)) Then TestDouble = 2
        LeftDblPart = Mid(ElToCheck, 1, PosDot - 1)
        RightDblPart = Mid(ElToCheck, PosDot + 1)
        If IsNumeric(LeftDblPart) And IsNumeric(RightDblPart) Then
            Select Case SingleDoubleForce
                Case 0
                    IsSimpleElement = VAR_DOUBLE
                Case 1
                    IsSimpleElement = VAR_SINGLE
                Case 2
                    IsSimpleElement = VAR_DOUBLE
            End Select
            Exit Function
        End If
    End If
End Function

' --- Retrieve a complete expression till EOL --- '
Public Sub GetExpression()
    CurrentExpr = ""
    Do While IsEOL(CurrentChar) = False
        CurrentExpr = CurrentExpr & CurrentChar
        ReadChar
    Loop
End Sub

' --- Retrieve a line and stop at a special keyword --- '
Public Function GetExpressionHunt(StopWord As String) As Boolean
    Dim InString As Integer
    CurrentExpr = ""
    GetExpressionHunt = False
    Do While IsEOL(CurrentChar) = False
        CurrentExpr = CurrentExpr & CurrentChar
        ' Enable/Disable keyword checking
        ' (we don't exclude closing quote but this should be no problem
        ' as we don't actually search for quotes).
        If IsStringDelim(CurrentChar) Then InString = InString Xor 1
        If InString = 0 Then
            If UCase(Right(CurrentExpr, Len(StopWord))) = UCase(StopWord) Then
                CurrentExpr = Mid(CurrentExpr, 1, Len(CurrentExpr) - Len(StopWord))
                GetExpressionHunt = True
                Exit Do
            End If
        End If
        ReadChar
    Loop
End Function

' --- Retrieve a line and stop at two special keywords --- '
Public Function GetExpressionDoubleHunt(StopWord1 As String, StopWord2 As String) As Boolean
    Dim InString As Integer
    Dim BracketNum As Long
    CurrentExpr = ""
    GetExpressionDoubleHunt = False
    Do While IsEOL(CurrentChar) = False
        CurrentExpr = CurrentExpr & CurrentChar
        ' Enable/Disable keyword checking
        ' (we don't exclude closing quote but this should be no problem
        ' as we don't actually search for quotes).
        If IsStringDelim(CurrentChar) Then InString = InString Xor 1
        If IsOpenBracket(CurrentChar) Then BracketNum = BracketNum + 1
        If InString = 0 Then
            If BracketNum = 0 Then
                If UCase(Right(CurrentExpr, Len(StopWord1))) = UCase(StopWord1) Then
                    CurrentExpr = Mid(CurrentExpr, 1, Len(CurrentExpr) - Len(StopWord1))
                    GetExpressionDoubleHunt = True
                    Exit Do
                End If
                If UCase(Right(CurrentExpr, Len(StopWord2))) = UCase(StopWord2) Then
                    CurrentExpr = Mid(CurrentExpr, 1, Len(CurrentExpr) - Len(StopWord2))
                    GetExpressionDoubleHunt = True
                    Exit Do
                End If
            End If
        End If
        If IsCloseBracket(CurrentChar) Then BracketNum = BracketNum - 1
        ReadChar
    Loop
End Function

' --- Retrieve an expression until a special keyword --- '
Public Function GetExpressionDeclare(StopWord As String) As Boolean
    CurrentExpr = ""
    GetExpressionDeclare = False
    Do While IsOpenBracket(CurrentChar) = False
        CurrentExpr = CurrentExpr & CurrentChar
        If UCase(Right(CurrentExpr, Len(StopWord))) = UCase(StopWord) Then
            CurrentExpr = Mid(CurrentExpr, 1, Len(CurrentExpr) - Len(StopWord))
            GetExpressionDeclare = True
            Exit Do
        End If
        ReadChar
    Loop
End Function

' --- Retrieve an expression inside brackets and check for brackets balance --- '
Public Function GetExpressionInBrackets() As Boolean
    Dim BracketsBlnc As Long
    CurrentExpr = ""
    GetExpressionInBrackets = True
    Do While BracketsBlnc <> -1
        If IsOpenBracket(CurrentChar) = True Then BracketsBlnc = BracketsBlnc + 1
        If IsCloseBracket(CurrentChar) = True Then
            BracketsBlnc = BracketsBlnc - 1
            ' Do not store closing bracket
            If BracketsBlnc = -1 Then Exit Do
        End If
        CurrentExpr = CurrentExpr & CurrentChar
        ReadChar
        If IsEOL(CurrentChar) = True Then
            GetExpressionInBrackets = False
            Exit Do
        End If
    Loop
End Function

' --- Check if a constant, variable, user type, enum or function exists --- '
Public Function SymbolExist(Symb As String) As Boolean
    If (IsVariable(Symb, 0, VARSEARCH_NOCOHERENCY) <> -1) Or (IsConstant(Symb) <> -1) Or (IsFunction(Symb) <> -1) Or (IsUserType(Symb) <> -1) Or (IsUserEnum(Symb) <> -1) Then SymbolExist = True
End Function

' --- Check if a given variable already exists --- '
' (Returns index of variable if found)
Public Function IsVariable(Symb As String, StartPos As Long, CheckCoherency As Long) As Long
    Dim Db As Long
    Dim Variableentry As String
    Dim VariableIdx As Long
    Dim SymbLetter As String
    IsVariable = -1
    If Symb = "" Then Exit Function
    SymbLetter = UCase(left(Symb, 1))
    Select Case SymbLetter
        Case "A"
            For Db = StartPos To UBound(VariablesA()) Step 1
                Variableentry = VariablesA(Db)
                If Variableentry <> "" Then
                    If Variableentry = Symb Then
                        VariableIdx = VariablesIndexA(Db)
                        Select Case CheckCoherency
                            Case VARSEARCH_LOCALGLOBAL
                                If VariablesLocalFunction(VariableIdx) = "" Then
                                    IsVariable = VariableIdx
                                    Exit Function
                                End If
                                If VariablesLocalFunction(VariableIdx) = CurrentNested Then
                                    IsVariable = VariableIdx
                                    Exit Function
                                End If
                            Case VARSEARCH_LOCALONLY
                                If VariablesLocalFunction(VariableIdx) = CurrentNested Then
                                    IsVariable = VariableIdx
                                    Exit Function
                                End If
                            Case VARSEARCH_NOCOHERENCY
                                IsVariable = VariableIdx
                                Exit Function
                        End Select
                    End If
                End If
            Next
        Case "B"