modmain.bas

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

                Do While left(CurrentModuleName, 3) = "\.."
                    CurrentModuleName = Mid(CurrentModuleName, 4)
                Loop
                CurrentModuleHandle = OpenFileR(CurrentModuleName)
                If CurrentModuleHandle = -1 Then
                    ' Try to open module located in another directory
                    If Right(ProjectDirectory, 1) = "\" Then
                        CurrentModuleName = Mid(ProjectDirectory, 1, Len(ProjectDirectory) - 1) & CurrentModuleName
                    Else
                        CurrentModuleName = ProjectDirectory & CurrentModuleName
                    End If
                    CurrentModuleHandle = OpenFileR(CurrentModuleName)
                    If CurrentModuleHandle = -1 Then
                        CurrentModuleName = OriginalModuleName
                        CurrentModuleHandle = OpenFileR(CurrentModuleName)
                    End If
                End If
                OutModuleName = CurrentModuleName
                AddVBModule OutModuleName
                OutModuleName = ReplaceFileExtension(OutModuleName, "cpp")
            Else
                CurrentModuleHandle = OpenFileR(ProjectDirectory & CurrentModuleName)
                OutModuleName = ProjectDirectory & CurrentModuleName
                AddVBModule OutModuleName
                OutModuleName = ReplaceFileExtension(OutModuleName, "cpp")
            End If
            If CurrentModuleHandle = -1 Then
                WriteText "*** Fatal error: can't load module: " & ModulesArray(i) & ".\n"
                GoTo StopAll
            End If
            CurrentModuleMem = LoadFileIntoMemory(CurrentModuleHandle)
            CurrentModuleString = String(FileLength, " ")
            CopyMemory ByVal CurrentModuleString, ByVal CurrentModuleMem, FileLength
            CurrentModuleArray() = Split(CurrentModuleString, vbNewLine)
            If left(UCase(Replace(CurrentModuleArray(0), " ", "")), 17) <> "ATTRIBUTEVB_NAME=" Then
                WriteText "\n*** Fatal error: not a Visual Basic module.\n"
                CloseInFile
                GoTo StopAll
            End If
            AddModule OutModuleName
            ' Specify no file erasing
            If ModulesArrayConversion(i) = True Then
                OutModuleHandle = OpenFileW(OutModuleName)
                If OutModuleHandle = -1 Then
                    WriteText "\n*** Fatal error: can't open output file.\n"
                    CloseInFile
                    GoTo StopAll
                End If
            End If
            CurrentModLine = 0
            Nested = 0
            WriteText "Analysing " & ModulesArray(i) & "...\n"
            BrokeLine = ""
            For j = 1 To UBound(CurrentModuleArray()) Step 1
                StatsLines = StatsLines + 1
                CurrentModLine = CurrentModLine + 1
                CurrentModuleLine = Trim(CurrentModuleArray(j))
                OutModuleString = BrokeLine & Trim(CurrentModuleLine)
                If lstrlen(OutModuleString) <> 0 Then
                    If IsUnderLine(Right(OutModuleString, 1)) Then
                        BrokeLine = Mid(OutModuleString, 1, Len(OutModuleString) - 1)
                        GoTo PassLine1
                    End If
                    BrokeLine = ""
                    If IsComment(left(OutModuleString, 1)) = False Then
                        PushLine OutModuleString
ProceedLine1:           StripBlank
                        GetEntity
                        ' Conditional compilations commands
                        If IsDiese(CurrentChar) Then
                            ReadChar
                            StripBlank
                            GetEntity
                        End If
                        StaticLine = False
                        ' Heading keywords
CheckHeadingPass1:      Select Case UCase(CurrentEntity)
                            Case "GLOBAL"
                                StripBlank
                                GetEntity
                                GoTo CheckHeadingPass1
                            Case "PUBLIC"
                                StripBlank
                                GetEntity
                                GoTo CheckHeadingPass1
                            Case "PRIVATE"
                                StripBlank
                                GetEntity
                                GoTo CheckHeadingPass1
                            Case "STATIC"
                                StripBlank
                                GetEntity
                                StaticLine = True
                        End Select
                        Select Case UCase(CurrentEntity)
                            Case "OPTION"
                                StripBlank
                                GetEntity
                                Select Case UCase(CurrentEntity)
                                    Case "EXPLICIT"
                                        GoTo PassLine1
                                    Case "PRIVATE"
                                        ' This one should have no effect
                                        GoTo PassLine1
                                    Case "COMPARE"
                                        StripBlank
                                        GetEntity
                                        Select Case UCase(CurrentEntity)
                                            Case "BINARY"
                                                CurrentCompare = vbBinaryCompare
                                                GoTo PassLine1
                                            Case "TEXT"
                                                CurrentCompare = vbTextCompare
                                                GoTo PassLine1
                                        End Select
                                    Case Else
                                        If StopAtError = True Then
                                            Panic "*** Error: OPTION statement not recognized at line: " & CurrentModLine & ".\n"
                                            WriteText "*** " & CurrentModuleLine & "\n"
                                            GoTo StopAll
                                        Else
                                            DisplayError "OPTION statement not recognized"
                                            GoTo PassLine1
                                        End If
                                End Select
                            Case "CONST"
StoreNextConstant:              ConvertLocalResult = StoreConstant
                                If lstrlen(ConvertLocalResult) <> 0 Then
                                    If StopAtError = True Then
                                        Panic "*** Error: " & ConvertLocalResult & " at line: " & CurrentModLine & ".\n"
                                        WriteText "*** " & CurrentModuleLine & "\n"
                                        GoTo StopAll
                                    Else
                                        DisplayError ConvertLocalResult
                                        GoTo PassLine1
                                    End If
                                End If
                                If IsEOL(CurrentChar) = False Then
                                    ' Another constant ?
                                    StripBlank
                                    If IsComma(CurrentChar) Then
                                        ReadChar
                                        GoTo StoreNextConstant
                                    End If
                                End If
                            Case "TYPE"
                                If InTypeDef = True Then
                                    ConvertLocalResult = StoreVariable(True, False)
                                    If lstrlen(ConvertLocalResult) <> 0 Then
                                        If StopAtError = True Then
                                            Panic "*** Error: " & ConvertLocalResult & " at line: " & CurrentModLine & ".\n"
                                            WriteText "*** " & CurrentModuleLine & "\n"
                                            GoTo StopAll
                                        Else
                                            DisplayError ConvertLocalResult
                                            GoTo PassLine1
                                        End If
                                    End If
                                Else
                                    ConvertLocalResult = StoreUserType
                                    If lstrlen(ConvertLocalResult) <> 0 Then
                                        If StopAtError = True Then
                                            Panic "*** Error: " & ConvertLocalResult & " at line: " & CurrentModLine & ".\n"
                                            WriteText "*** " & CurrentModuleLine & "\n"
                                            GoTo StopAll
                                        Else
                                            DisplayError ConvertLocalResult
                                            GoTo PassLine1
                                        End If
                                    End If
                                End If
                            Case "ENUM"
                                If InEnumDef = True Then
                                    If StopAtError = True Then
                                        Panic "*** Error: nested enumeration not allowed at line: " & CurrentModLine & ".\n"
                                        WriteText "*** " & CurrentModuleLine & "\n"
                                        GoTo StopAll
                                    Else
                                        DisplayError "nested enumeration not allowed"
                                        GoTo PassLine1
                                    End If
                                Else
                                    ConvertLocalResult = StoreUserEnum
                                    If lstrlen(ConvertLocalResult) <> 0 Then
                                        If StopAtError = True Then
                                            Panic "*** Error: " & ConvertLocalResult & " at line: " & CurrentModLine & ".\n"
                                            WriteText "*** " & CurrentModuleLine & "\n"
                                            GoTo StopAll
                                        Else
                                            DisplayError ConvertLocalResult
                                            GoTo PassLine1
                                        End If
                                    End If
                                End If
                            Case "FUNCTION"
                                ConvertLocalResult = StoreFunction(False, "")
                                If lstrlen(ConvertLocalResult) <> 0 Then
                                    If StopAtError = True Then
                                        Panic "*** Error: " & ConvertLocalResult & " at line: " & CurrentModLine & ".\n"
                                        WriteText "*** " & CurrentModuleLine & "\n"
                                        GoTo StopAll
                                    Else
                                        DisplayError ConvertLocalResult
                                        GoTo PassLine1
                                    End If
                                End If
                            Case "SUB"
                                ConvertLocalResult = StoreSub(False, "")
                                If lstrlen(ConvertLocalResult) <> 0 Then
                                    If StopAtError = True Then
                                        Panic "*** Error: " & ConvertLocalResult & " at line: " & CurrentModLine & ".\n"
                                        WriteText "*** " & CurrentModuleLine & "\n"
                                        GoTo StopAll
                                    Else
                                        DisplayError ConvertLocalResult
                                        GoTo PassLine1
                                    End If
                                End If
                            ' APIs Declaration
                            Case "DECLARE"
                                StripBlank
                                GetEntity
                                Select Case UCase(CurrentEntity)
                                    Case "SUB"
                                        StripBlank
                                        GetEntity
                                        SavedEntity = CurrentEntity
                                        StripBlank