modloparser.bas

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

    ReDim VariablesIndexU(0)
    ReDim VariablesIndexV(0)
    ReDim VariablesIndexW(0)
    ReDim VariablesIndexX(0)
    ReDim VariablesIndexY(0)
    ReDim VariablesIndexZ(0)
    ReDim VariablesIndexElse(0)
    ReDim VariablesTypes(0)
    ReDim VariablesDeclare(0)
    ReDim VariablesRoot(0)
    ReDim VariablesArg(0)
    ReDim VariablesUser(0)
    ReDim VariablesLocalFunction(0)
    ReDim VariablesSizedString(0)
    ReDim VariablesArr(0)
    ReDim ConstantsA(0)
    ReDim ConstantsB(0)
    ReDim ConstantsC(0)
    ReDim ConstantsD(0)
    ReDim ConstantsE(0)
    ReDim ConstantsF(0)
    ReDim ConstantsG(0)
    ReDim ConstantsH(0)
    ReDim ConstantsI(0)
    ReDim ConstantsJ(0)
    ReDim ConstantsK(0)
    ReDim ConstantsL(0)
    ReDim ConstantsM(0)
    ReDim ConstantsN(0)
    ReDim ConstantsO(0)
    ReDim ConstantsP(0)
    ReDim ConstantsQ(0)
    ReDim ConstantsR(0)
    ReDim ConstantsS(0)
    ReDim ConstantsT(0)
    ReDim ConstantsU(0)
    ReDim ConstantsV(0)
    ReDim ConstantsW(0)
    ReDim ConstantsX(0)
    ReDim ConstantsY(0)
    ReDim ConstantsZ(0)
    ReDim ConstantsElse(0)
    ReDim ConstantsIndexA(0)
    ReDim ConstantsIndexB(0)
    ReDim ConstantsIndexC(0)
    ReDim ConstantsIndexD(0)
    ReDim ConstantsIndexE(0)
    ReDim ConstantsIndexF(0)
    ReDim ConstantsIndexG(0)
    ReDim ConstantsIndexH(0)
    ReDim ConstantsIndexI(0)
    ReDim ConstantsIndexJ(0)
    ReDim ConstantsIndexK(0)
    ReDim ConstantsIndexL(0)
    ReDim ConstantsIndexM(0)
    ReDim ConstantsIndexN(0)
    ReDim ConstantsIndexO(0)
    ReDim ConstantsIndexP(0)
    ReDim ConstantsIndexQ(0)
    ReDim ConstantsIndexR(0)
    ReDim ConstantsIndexS(0)
    ReDim ConstantsIndexT(0)
    ReDim ConstantsIndexU(0)
    ReDim ConstantsIndexV(0)
    ReDim ConstantsIndexW(0)
    ReDim ConstantsIndexX(0)
    ReDim ConstantsIndexY(0)
    ReDim ConstantsIndexZ(0)
    ReDim ConstantsIndexElse(0)
    ReDim ConstantsValues(0)
    ReDim ConstantsTypes(0)
    ReDim ConstantsEnum(0)
    ReDim FunctionsA(0)
    ReDim FunctionsB(0)
    ReDim FunctionsC(0)
    ReDim FunctionsD(0)
    ReDim FunctionsE(0)
    ReDim FunctionsF(0)
    ReDim FunctionsG(0)
    ReDim FunctionsH(0)
    ReDim FunctionsI(0)
    ReDim FunctionsJ(0)
    ReDim FunctionsK(0)
    ReDim FunctionsL(0)
    ReDim FunctionsM(0)
    ReDim FunctionsN(0)
    ReDim FunctionsO(0)
    ReDim FunctionsP(0)
    ReDim FunctionsQ(0)
    ReDim FunctionsR(0)
    ReDim FunctionsS(0)
    ReDim FunctionsT(0)
    ReDim FunctionsU(0)
    ReDim FunctionsV(0)
    ReDim FunctionsW(0)
    ReDim FunctionsX(0)
    ReDim FunctionsY(0)
    ReDim FunctionsZ(0)
    ReDim FunctionsElse(0)
    ReDim FunctionsIndexA(0)
    ReDim FunctionsIndexB(0)
    ReDim FunctionsIndexC(0)
    ReDim FunctionsIndexD(0)
    ReDim FunctionsIndexE(0)
    ReDim FunctionsIndexF(0)
    ReDim FunctionsIndexG(0)
    ReDim FunctionsIndexH(0)
    ReDim FunctionsIndexI(0)
    ReDim FunctionsIndexJ(0)
    ReDim FunctionsIndexK(0)
    ReDim FunctionsIndexL(0)
    ReDim FunctionsIndexM(0)
    ReDim FunctionsIndexN(0)
    ReDim FunctionsIndexO(0)
    ReDim FunctionsIndexP(0)
    ReDim FunctionsIndexQ(0)
    ReDim FunctionsIndexR(0)
    ReDim FunctionsIndexS(0)
    ReDim FunctionsIndexT(0)
    ReDim FunctionsIndexU(0)
    ReDim FunctionsIndexV(0)
    ReDim FunctionsIndexW(0)
    ReDim FunctionsIndexX(0)
    ReDim FunctionsIndexY(0)
    ReDim FunctionsIndexZ(0)
    ReDim FunctionsIndexElse(0)
    ReDim FunctionsDeclare(0)
    ReDim FunctionsReturnType(0)
    ReDim FunctionsSuffix(0)
    ReDim ProtoTypes(0)
    ReDim ProtoTypesValid(0)
    ReDim IncludeModules(0)
    ReDim IncludeVBModules(0)
    ReDim UserTypes(0)
    ReDim UserTypesDeclare(0)
    ReDim UserEnums(0)
    ReDim UserEnumsDeclare(0)
    ReDim FunctionsArgumentsTypes(0)
    ReDim FunctionsArgumentsTypesLit(0)
    ReDim FunctionsArgumentsByRef(0)
    ReDim FunctionsVarArr(0)
    ReDim FunctionsLiteralReturn(0)
    ReDim FunctionsOptionalTokens(0)
    ReDim FunctionsDeclared(0)
    ReDim FunctionsFoot(0)
    ReDim VariableArrays(0)
    ReDim VariableArraysType(0)
    ReDim VariableArraysCustType(0)
    ReDim VariableArraysNested(0)
    ReDim VariablesUndefArr(0)
    ReDim ExternDll(0)
    ReDim OldSelectCase(0)
    ReDim OldSelectCaseVar(0)
    ReDim OldWithVar(0)
    ReDim OldGoSubLabel(0)
    ReDim VarToFree(0)
End Sub

' --- Define the current line to read --- '
Public Sub PushLine(LnToRead As String)
    CurrentReadLine = LnToRead  ' Load line accumulator
    CurrentPosLine = 1
    ReadChar                    ' Fill the char accumulator
End Sub

' --- Read a char from the current line --- '
Public Sub ReadChar()
    CurrentChar = Mid(CurrentReadLine, CurrentPosLine, 1)
    CurrentPosLine = CurrentPosLine + 1
End Sub

' --- Pass the blank chars --- '
Public Sub StripBlank()
    Do While IsBlank(CurrentChar)
        ReadChar
    Loop
End Sub

' --- Check if letter is a digit --- '
Public Function IsDigit(DLetter As String) As Boolean
    If DLetter >= "0" And DLetter <= "9" Then IsDigit = True
End Function

' --- Check if letter is alpha --- '
Public Function IsAlpha(ALetter As String) As Boolean
    If UCase(ALetter) >= "A" And UCase(ALetter) <= "Z" Then IsAlpha = True
End Function

' --- Check if letter is a space --- '
Public Function IsBlank(BLetter As String) As Boolean
    If BLetter = " " Then IsBlank = True
End Function

' --- Check if letter is a colon --- '
Public Function IsColon(DLetter As String) As Boolean
    If DLetter = ":" Then IsColon = True
End Function

' --- Check if letter is an open bracket --- '
Public Function IsOpenBracket(OLetter As String) As Boolean
    If OLetter = "(" Then IsOpenBracket = True
End Function

' --- Check if letter is a "diese" --- '
Public Function IsDiese(DLetter As String) As Boolean
    If DLetter = "#" Then IsDiese = True
End Function

' --- Check if letter is an exclamation --- '
Public Function IsExclamation(DLetter As String) As Boolean
    If DLetter = "!" Then IsExclamation = True
End Function

' --- Check if letter is a dollar --- '
Public Function IsDollar(DLetter As String) As Boolean
    If DLetter = "$" Then IsDollar = True
End Function

' --- Check if letter is a suffix --- '
Public Function IsSuffix(DLetter As String) As Boolean
    If IsDiese(DLetter) Or IsExclamation(DLetter) Or IsAmpersand(DLetter) Or IsDollar(DLetter) Then IsSuffix = True
End Function

' --- Check if letter is a closing bracket --- '
Public Function IsCloseBracket(CLetter As String) As Boolean
    If CLetter = ")" Then IsCloseBracket = True
End Function

' --- Check if letter is a comment char --- '
Public Function IsComment(CLetter As String) As Boolean
    If CLetter = "'" Then IsComment = True
End Function

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

' --- Check if letter is a string delimiter char --- '
Public Function IsStringDelim(CLetter As String) As Boolean
    If CLetter = Chr(34) Then IsStringDelim = True
End Function

' --- Check if letter is an end of line marker --- '
Public Function IsEOL(EOLetter As String) As Boolean
    If EOLetter = "" Then
        IsEOL = True
        Exit Function
    End If
    If Asc(EOLetter) = 13 Or Asc(EOLetter) = 0 Then IsEOL = True
End Function

' --- Retrieve the current entity --- '
Public Sub GetEntity()
    CurrentEntity = ""
    Do While IsConstVar(CurrentChar)
        CurrentEntity = CurrentEntity & CurrentChar
        ReadChar
    Loop
End Sub

' --- Retrieve the current string --- '
Public Sub GetLitString()
    CurrentEntity = ""
    If IsStringDelim(CurrentChar) Then
        ReadChar
        Do While Not IsStringDelim(CurrentChar)
            CurrentEntity = CurrentEntity & CurrentChar
            ReadChar
        Loop
    End If
End Sub

' --- Push parser variables --- '
Public Sub PushContext()
    SaveCurrentReadLine = CurrentReadLine
    SaveCurrentChar = CurrentChar
    SaveCurrentEntity = CurrentEntity
    SaveCurrentPosLine = CurrentPosLine
End Sub

' --- Pop parser variables --- '
Public Sub PopContext()
    CurrentPosLine = SaveCurrentPosLine
    CurrentEntity = SaveCurrentEntity
    CurrentChar = SaveCurrentChar
    CurrentReadLine = SaveCurrentReadLine
End Sub

' --- Retablish parentheses balance in an expression --- '
Public Function CorrectParentheses(Expr As String) As String
    Dim i As Long
    Dim OpBrack As Long
    Dim ClBrack As Long
    Dim InString As Long
    Dim CurChar As String
    For i = 1 To lstrlen(Expr) Step 1
        CurChar = Mid(Expr, i, 1)
        If IsStringDelim(CurChar) Then InString = InString Xor 1
        If InString = 0 Then
            If IsOpenBracket(CurChar) Then OpBrack = OpBrack + 1
            If IsCloseBracket(CurChar) Then ClBrack = ClBrack + 1
        End If
    Next
    If OpBrack <= ClBrack Then
        CorrectParentheses = Expr
        Exit Function
    End If
    CorrectParentheses = Expr & String(OpBrack - ClBrack, ")")
End Function

' --- Check if letter is valid for a compares --- '
Public Function IsCompare(COLetter As String) As Boolean
    If COLetter = "=" Or COLetter = ">" Or COLetter = "<" Then IsCompare = True
End Function

' --- Check if letter is valid for a variable/constant name --- '
Public Function IsConstVar(VCLetter As String) As Boolean
    If IsArobas(VCLetter) Or IsAlpha(VCLetter) Or IsDot(VCLetter) Or IsUnderLine(VCLetter) Or IsDigit(VCLetter) Then IsConstVar = True
End Function

' --- Check if letter is an underline char --- '
Public Function IsUnderLine(ULetter As String) As Boolean
    If ULetter = "_" Then IsUnderLine = True