frmcompiler.frm

用VB实现的编译器的源代码

VERSION 5.00
Begin VB.Form frmCompiler 
   BorderStyle     =   3  'Fester Dialog
   ClientHeight    =   2550
   ClientLeft      =   45
   ClientTop       =   45
   ClientWidth     =   6990
   ControlBox      =   0   'False
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmCompiler.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2550
   ScaleWidth      =   6990
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'Bildschirmmitte
   Begin VB.Timer tmrTimer 
      Interval        =   1000
      Left            =   480
      Top             =   360
   End
   Begin VB.Label lblStatus 
      BackStyle       =   0  'Transparent
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   6
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   150
      Left            =   0
      TabIndex        =   5
      Top             =   2400
      Width           =   6930
   End
   Begin VB.Image imgArrow 
      Height          =   240
      Left            =   1320
      Picture         =   "frmCompiler.frx":058A
      Top             =   1440
      Width           =   240
   End
   Begin VB.Image imgConstants 
      Height          =   240
      Left            =   1320
      Picture         =   "frmCompiler.frx":0F8C
      Top             =   1800
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Image imgSplit 
      Height          =   240
      Left            =   1320
      Picture         =   "frmCompiler.frx":1516
      Top             =   1440
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Label lblLink 
      AutoSize        =   -1  'True
      Caption         =   "Starting the linker and generating the bytecode..."
      Height          =   195
      Left            =   1680
      TabIndex        =   4
      Top             =   2160
      Width           =   3600
   End
   Begin VB.Label lblConstants 
      AutoSize        =   -1  'True
      Caption         =   "Applying B++ guidelines..."
      Height          =   195
      Left            =   1680
      TabIndex        =   3
      Top             =   1800
      Width           =   1920
   End
   Begin VB.Label lblSplit 
      AutoSize        =   -1  'True
      Caption         =   "Splitting up the program lines..."
      Height          =   195
      Left            =   1680
      TabIndex        =   2
      Top             =   1440
      Width           =   2265
   End
   Begin VB.Label lblInfo 
      Caption         =   $"frmCompiler.frx":1AA0
      Height          =   855
      Index           =   1
      Left            =   1320
      TabIndex        =   1
      Top             =   480
      Width           =   5535
   End
   Begin VB.Label lblInfo 
      AutoSize        =   -1  'True
      Caption         =   "Compiling..."
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Index           =   0
      Left            =   1320
      TabIndex        =   0
      Top             =   120
      Width           =   960
   End
   Begin VB.Image imgHand 
      Height          =   720
      Left            =   360
      Picture         =   "frmCompiler.frx":1BC2
      Top             =   960
      Visible         =   0   'False
      Width           =   720
   End
   Begin VB.Image imgIcon 
      Height          =   720
      Left            =   360
      Picture         =   "frmCompiler.frx":73A4
      Top             =   840
      Width           =   720
   End
End
Attribute VB_Name = "frmCompiler"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Lines(256000)
Dim DontDelete As Boolean
Dim LinesCount As Integer
Dim SrcPath As String

Private Sub Sleep(dwSeconds As Double)
    p = Timer
    Do Until Timer - p >= dwSeconds
        DoEvents
    Loop
End Sub

Private Sub Form_Load()
    DontDelete = False
End Sub

Private Sub lblInfo_Click(Index As Integer)
    DontDelete = True
    lblInfo(Index).ForeColor = vbRed
End Sub

Private Sub tmrTimer_Timer()
    tmrTimer.Enabled = False
    D = Split(Command, " ")
    Destination = CStr(D(0))
    If Destination = "/help" Or Destination = "/?" Or Destination = "?" Then
        MsgBox "Compiler <Destination File> <Source Code>"
        End
    End If
    Source = CStr(D(1))
    Dim Repl(32768) As String
    Dim By(32768) As String
    Dim Replacements As Integer
    Dim TheLine As String
    Sleep 0.4
    SrcPath = Left(Source, InStrRev(Source, "\") - 1)
    Open Source For Input As #1
    Open "C:\compile_inc.log" For Output As #2
        Do Until EOF(1)
            Line Input #1, RawLine
            lblStatus.Caption = "RawLine": lblStatus.Refresh
            If Len(RawLine) > Len("include") Then
                If Left(RawLine, Len("include")) = "include" Then
                    INCNAME$ = Mid(RawLine, 9)
                    INCNAME = Replace(INCNAME, "(srcpath)", SrcPath)
                    If Not Mid(INCNAME, 2, 1) = ":" Then
                        INCNAME = App.Path & "\" & INCNAME
                    End If
                    Open INCNAME For Input As #3
                        Do Until EOF(3)
                            Line Input #3, SoftLine
                            Print #2, SoftLine
                        Loop
                    Close #3
                Else
                    Print #2, RawLine
                End If
            Else
                Print #2, RawLine
            End If
        Loop
    Close #2
    Close #1
    Open "C:\compile_inc.log" For Input As #1
    Open "C:\compile_split.log" For Output As #2
        Do Until EOF(1)
            Line Input #1, RawLine
            lblStatus.Caption = RawLine: lblStatus.Refresh
            TheLine = TheLine & Trim(Replace(RawLine, ";;", vbCrLf))
            CrackUp = Split(TheLine, "//")
            If UBound(CrackUp) > 0 Then TheLine = CStr(CrackUp(0))
            TheLine = Trim(TheLine)
            If Len(TheLine) > 1 Then
                If Right(TheLine, 2) = "::" Then
                    TheLine = Left(TheLine, Len(TheLine) - 2)
                Else
                    Print #2, TheLine
                    TheLine = ""
                End If
            Else
                If Len(TheLine) > 0 Then Print #2, TheLine
                TheLine = ""
            End If
        Loop
    Close #2
    Close #1
    
    imgSplit.Visible = True
    imgArrow.Top = Me.lblConstants.Top
    Sleep 0.3
    
    Open "C:\compile_split.log" For Input As #1
    Open "C:\compile_guidelines.log" For Output As #2
        Do Until EOF(1)
            Line Input #1, RawLine
            lblStatus.Caption = "RawLine": lblStatus.Refresh
            RawLine = Replace(RawLine, "[", "[ ")
            RawLine = Replace(RawLine, "]", " ]")
            TheLine = Trim(RawLine)
            If Not TheLine = "" Then
                If Len(TheLine) > Len("definition") Then
                    If Left(TheLine, Len("definition=")) = "definition=" Then
                        DE = Mid(TheLine, Len("definition=") + 1)
                        Constant = Left(DE, InStr(DE, " ") - 1)
                        Substitute = Mid(DE, InStr(DE, " ") + 1)
                        Repl(Replacements) = Constant
                        By(Replacements) = Substitute
                        Replacements = Replacements + 1
                    Else
                        For f = 0 To Replacements - 1
                            TheLine = Replace(TheLine, Repl(f), By(f))
                        Next f
                        Print #2, TheLine
                    End If
                Else
                    For f = 0 To Replacements - 1
                        TheLine = Trim(TheLine)
                        TheLine = Replace(TheLine, Repl(f), By(f))
                    Next f
                    Print #2, TheLine
                End If
            End If
        Loop
    Close #2
    Close #1
    
    Open "C:\compile_guidelines.log" For Input As #1
        Do Until EOF(1)
            Line Input #1, PLINE
            lblStatus.Caption = PLINE: lblStatus.Refresh
            Lines(LinesCount) = Trim(PLINE)
            LinesCount = LinesCount + 1
        Loop
    Close #1
    
    Open "C:\compile_finish.log" For Output As #1
        toImplement$ = ""
        For f = 0 To LinesCount - 1
            If Lines(f) Like "implement*" Then
                toImplement = Mid(Lines(f), 11)
            ElseIf Lines(f) Like "end class" Then
                toImplement = ""
                Print #1, "end class"
            ElseIf Lines(f) Like "<definitions>" Then
                If Not toImplement = "" Then
                    Print #1, GetDefinitions(toImplement)
                Else
                    Print #1, "<definitions>"
                End If
            ElseIf Lines(f) Like "<methods>" Then
                If Not toImplement = "" Then
                    Print #1, GetMethods(toImplement)
                Else
                    Print #1, "<methods>"
                End If
            Else
                Print #1, Lines(f)
            End If
        Next f
    Close #1
    
    FileCopy "C:\compile_finish.log", "C:\compile_implement.log"
    Open "C:\compile_implement.log" For Input As #1
    Open "C:\compile_finish.log" For Output As #2
        Do Until EOF(1)
            Line Input #1, TheLine
            If Left(TheLine, 1) = ":" Then
                Pty = Left(TheLine, InStr(TheLine, "=") - 1)
                Pty = Trim(Mid(Pty, 2))
                Vle = Mid(TheLine, InStr(TheLine, "=") + 1)
                Vle = Trim(Vle)
                TheLine = "set " & Pty & " " & Vle
            End If
            Print #2, TheLine
        Loop
    Close #2
    Close #1
    
    imgConstants.Visible = True
    imgArrow.Top = Me.lblLink.Top
    imgHand.Visible = True

    FileCopy "C:\compile_finish.log", "C:\DebugCode.BIS"
    Shell App.Path & "\Linker.EXE " & Destination & " C:\DebugCode.BIS", vbNormalFocus
    Sleep 5
    If DontDelete = False Then
        Kill "C:\compile_implement.log"
        Kill "C:\compile_split.log"
        Kill "C:\compile_inc.log"
        Kill "C:\compile_guidelines.log"
        Kill "C:\compile_finish.log"
    End If
    End
End Sub

Private Function GetDefinitions(Classname As String) As String
    Dim Output As String
    Dim AlreadyInClass As Boolean
    Dim AddMode As Boolean
    AddMode = False: AlreadyInClass = False
    For f = 0 To LinesCount - 1
        If Lines(f) = "class " & Classname Then AlreadyInClass = True
        If Lines(f) = "end class" Then AlreadyInClass = False
        If Lines(f) = "<definitions>" And AlreadyInClass = True Then AddMode = True
        If Lines(f) = "<methods>" Then AddMode = False
        If AlreadyInClass = False Then AddMode = False
        If AddMode = True Then
            If Not Output = "" Then Output = Output & vbCrLf
            Output = Output & Lines(f)
        End If
    Next f
    GetDefinitions = Output
End Function

Private Function GetMethods(Classname As String) As String
    Dim Output As String
    Dim AlreadyInClass As Boolean
    Dim AddMode As Boolean
    AddMode = False: AlreadyInClass = False
    For f = 0 To LinesCount - 1
        If Lines(f) = "class " & Classname Then AlreadyInClass = True
        If Lines(f) = "end class" Then AlreadyInClass = False
        If Lines(f) = "<methods>" And AlreadyInClass = True Then AddMode = True
        If AlreadyInClass = False Then AddMode = False
        If AddMode = True Then
            If Not Output = "" Then Output = Output & vbCrLf
            Output = Output & Lines(f)
        End If
    Next f
    GetMethods = Output
End Function