modruntime.bas

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

                End If
            End If
            Set Q = getObject(ObjectID)
            Set ExecutionalStack(ESStackPointer) = CurrentLocal
            ESStackPointer = ESStackPointer + 1
            Q.ExecuteVoid PropertyID$, _
                getValueFromExpression(Statement, 1), _
                getValueFromExpression(Statement, 2), _
                getValueFromExpression(Statement, 3), _
                getValueFromExpression(Statement, 4), _
                getValueFromExpression(Statement, 5), _
                getValueFromExpression(Statement, 6), _
                getValueFromExpression(Statement, 7), _
                getValueFromExpression(Statement, 8)
            ESStackPointer = ESStackPointer - 1
            Set CurrentLocal = ExecutionalStack(ESStackPointer)

        Case "messageBox"
            PublicVars("MsgBoxReturn") = MsgBox( _
                getValueFromExpression(Statement, 1), _
                getValueFromExpression(Statement, 2), _
                getValueFromExpression(Statement, 3))

        Case "if"
            Condition1 = getValueFromExpression(Statement, 1)
            Condition2 = getValueFromExpression(Statement, 2)
            Operator = Statement
            Operator = Mid(Operator, InStr(Operator, "] |") + 3)
            Operator = Left(Operator, InStr(Operator, "| [") - 1)
            Operator = Trim(Operator)
            isTrue = False

            Select Case Operator
                Case "="
                    If Condition1 = Condition2 Then isTrue = True
                Case "<"
                    If Condition1 < Condition2 Then isTrue = True
                Case ">"
                    If Condition1 > Condition2 Then isTrue = True
                Case ">="
                    If Condition1 >= Condition2 Then isTrue = True
                Case "<="
                    If Condition1 <= Condition2 Then isTrue = True
                Case "=>"
                    If Condition1 >= Condition2 Then isTrue = True
                Case "=<"
                    If Condition1 <= Condition2 Then isTrue = True
                Case "like"
                    If Condition1 Like Condition2 Then isTrue = True
            End Select
            
            ToDebug "IF Request: " & Condition1 & " " & Operator & _
                Condition2 & " is " & isTrue
            LastIf = isTrue
            If LastIf = False Then SkipALine = True
            
        Case "else"
            If LastIf = True Then SkipALine = True
    
        Case "return"
            FunctionReturn = getValueFromExpression(Statement, 1)
                
        Case "softThreading"
            If D(1) = "on" Then
                HSMode = True
            Else
                HSMode = False
            End If
        
        Case "segment"
            PublicVars("Misc") = Mid(getValueFromExpression(Statement, 1), getValueFromExpression(Statement, 2), getValueFromExpression(Statement, 3))
        
        Case "from"
            PublicVars("Misc") = Mid(getValueFromExpression(Statement, 1), getValueFromExpression(Statement, 2))
        
        Case "len"
            PublicVars("Misc") = Len(getValueFromExpression(Statement, 1))
        
        Case "instr"
            ToDebug "-->Instr Command"
            PublicVars("Misc") = InStr(CInt(getValueFromExpression(Statement, 3)), _
                                    CStr(getValueFromExpression(Statement, 1)), _
                                    CStr(getValueFromExpression(Statement, 2)))
            ToDebug "-->Instr Successful"
            
        Case "replace"
            PublicVars("Misc") = Replace(getValueFromExpression(Statement, 1), _
                                    getValueFromExpression(Statement, 2), _
                                    getValueFromExpression(Statement, 3))
        
        Case "leave"
            If DebugMode = True Then
                Result = MsgBox("Do you want to clean up the debug information?", vbYesNo, "Question")
                If Result = vbYes Then Kill "C:\DEBUG.LOG"
            End If
            End
            
        Case "readASCIIToMisc"
            k = FreeFile
            PublicVars("Misc") = ""
            Open getValueFromExpression(Statement, 1) For Input As #k
                Do Until EOF(k)
                    Line Input #k, TMPLINE$
                    PublicVars("Misc") = PublicVars("Misc") & TMPLINE$ & vbCrLf
                Loop
            Close #k
        
        Case "setOutput"
            k = Val(getValueFromExpression(Statement, 1))
            Open getValueFromExpression(Statement, 2) For Output As #k
            
        Case "write"
            k = Val(getValueFromExpression(Statement, 1))
            Print #k, getValueFromExpression(Statment, 2);
            
        Case "closeFile"
            k = Val(getValueFromExpression(Statement, 1))
            Close #k
            
        Case "setInput"
            k = Val(getValueFromExpression(Statement, 1))
            Open getValueFromExpression(Statement, 2) For Input As #k
    
        Case "setAppend"
            k = Val(getValueFromExpression(Statement, 1))
            Open getValueFromExpression(Statement, 2) For Append As #k
            
        Case "readLine"
            k = Val(getValueFromExpression(Statement, 1))
            Line Input #k, TMPSTR
            PublicVars("Misc") = TMPSTR
            
        Case "eof"
            k = Val(getValueFromExpression(Statement, 1))
            PublicVars("Misc") = EOF(k)
            
        Case "lof"
            k = Val(getValueFromExpression(Statement, 1))
            PublicVars("Misc") = LOF(k)
                    
        Case "selectLogoScreen"
            ToDebug "--> Dim TargetControl, TargetCls, StrArr()"
            Dim TargetControl As PictureBox
            Dim TargetCls As Class
            Dim StrArr() As String
            ToDebug "--> Split " & D(1)
            StrArr = Split(CStr(D(1)), ".")
            ToDebug "--> Replacing 'this'"
            If StrArr(0) = "this" Then StrArr(0) = ReferenceObject.name
            ToDebug "--> Setting target class"
            Set TargetCls = getObject(StrArr(0))
            ToDebug "--> Setting target control"
            Set TargetControl = getControl(TargetCls, StrArr(1))
            ToDebug "--> Initializing"
            Turtle.Init TargetControl, CInt(TargetControl.ScaleWidth), CInt(TargetControl.ScaleHeight), vbWhite
            ToDebug "--> Done"
            Turtle.Show
            Turtle.PenDown
        
        Case "turtlePrint"
            Turtle.WriteString getValueFromExpression(Statement, 1), _
                               getValueFromExpression(Statement, 2), _
                               getValueFromExpression(Statement, 3)
        
        Case "turtleOn"
            Turtle.PenDown
            
        Case "turtleOff"
            Turtle.PenUp
            
        Case "tcls"
            Turtle.Bild.Cls
        
        Case "getTX"
            PublicVars("Misc") = Turtle.getX
        
        Case "getTY"
            PublicVars("Misc") = Turtle.getY
        
        Case "turtleColor"
            Turtle.SetColor getValueFromExpression(Statement, 1)
            
        Case "turtleSleep"
            Turtle.Schlafe getValueFromExpression(Statement, 1)
            
        Case "tHide"
            Turtle.Hide
            
        Case "tShow"
            Turtle.Show
            
        Case "tmove"
            Turtle.Move getValueFromExpression(Statement, 1)
            
        Case "tturn"
            Turtle.Turn getValueFromExpression(Statement, 1)
            
        Case "tmoveTo"
            Turtle.MoveTo getValueFromExpression(Statement, 1), _
                        getValueFromExpression(Statement, 2)
                        
        Case "tturnTo"
            Turtle.TurnTo getValueFromExpression(Statement, 1)
            
        Case "actionHandler"
            ActionDestination$ = getValueFromExpression(Statement, 1)
            If ActionDestination = "this" Then ActionDestination = ReferenceObject.name
            Set ReferenceObject.ThisClassesForm.Owner = _
                getObject(ActionDestination)
                
        Case "schedule"
            PublicVars(CStr(D(2))) = frmScheduler.AddThread( _
                getValueFromExpression(Statement), CInt(D(1)))
                
        Case "stop"
            frmScheduler.StopThread CInt(PublicVars(D(1)))
            
        Case "start"
            frmScheduler.StartThread CInt(PublicVars(D(1)))
        
        Case "createSocket"
            ReDim Preserve AllSockets(SocketsCount + 1)
            Set AllSockets(SocketsCount) = New TCPSocket
            AllSockets(SocketsCount).SetMode StreamMode
            AllSockets(SocketsCount).name = CStr(D(1))
            CurrentLocal.Variables.Item(D(1)) = SocketsCount
            SocketsCount = SocketsCount + 1
            
        Case "connect"
            AllSockets(getValueFromExpression(Statement, 1)).Connect _
                getValueFromExpression(Statement, 2), _
                getValueFromExpression(Statement, 3)
        
        Case "close"
            AllSockets(getValueFromExpression(Statement, 1)).Disconnect
            
        Case "assignSocketTalk"
            AllSockets(getValueFromExpression(Statement, 1)).SetEventClass ( _
                getValueFromExpression(Statement, 2))
            AllSockets(getValueFromExpression(Statement, 1)).SetMode EventMode

        Case "suppressSocketTalk"
            AllSockets(getValueFromExpression(Statement, 1)).SetMode StreamMode
        
        Case "serveOn"
            AllSockets(getValueFromExpression(Statement, 1)).Listen _
                getValueFromExpression(Statement, 2)
        
        Case "streamRead"
            PublicVars("Misc") = AllSockets(getValueFromExpression(Statement, 1)).ReadStringBuffer
            
        Case "streamWrite"
            AllSockets(getValueFromExpression(Statement, 1)).WriteStringBuffer _
                getValueFromExpression(Statement, 2)
                
        Case "streamPeek"
            PublicVars("Misc") = AllSockets(getValueFromExpression(Statement, 1)).PeekStringBuffer
            
        Case "clientRequest"
            PublicVars("Misc") = AllSockets(getValueFromExpression(Statement, 1)).GetLastRequest
            
        Case "clientAccept"
            AllSockets(getValueFromExpression(Statement, 1)).AcceptRequest _
                getValueFromExpression(Statement, 2)
                
        Case "socketName"
            AllSockets(getValueFromExpression(Statement, 1)).name = _
                getValueFromExpression(Statement, 2)
                
        Case ">>>"
            Interprete getValueFromExpression(Statement, 1), ReferenceObject
            
        Case "delegate"
            NormalVariable = D(1)
            Direction = D(2)
            AValue$ = getValueFromExpression(Statement, 1)
            If Direction = "<<" Then
                ReferenceObject.Variables.Item(D(1)) = ReferenceObject.Variables.Item(AValue)
            Else
                ReferenceObject.Variables.Item(AValue) = ReferenceObject.Variables.Item(D(1))
            End If
            
        Case "console"
            ConOperator = D(1)
            ConValue = D(2)
            If ConValue = "show" Then
                frmConsole.Show
                frmConsole.Caption = getValueFromExpression(Statement, 1)
            ElseIf ConValue = "clear" Then
                frmConsole.Wipe
            Else
                If ConOperator = "<<" Then   ' Write (cout)
                    frmConsole.PutLine getValueFromExpression(Statement, 1)
                Else                         ' Read  (cin)
                    ReferenceObject.Variables.Item(ConValue) = _
                        frmConsole.GetLine
                End If
            End If
            
        Case "clean"
            ReferenceObject.Variables.Remove D(1)
            
        Case Else
            Interprete "> " & Statement, ReferenceObject
    End Select
End Sub

Public Function getObjectName(FullString) As String
    p = Split(FullString, ".")
    getObjectName = CStr(p(0))
End Function

Public Function getPropertyName(FullString) As String
    p = Split(FullString, ".")
    getPropertyName = CStr(p(1))
End Function

Public Function getControlPropertyName(FullString) As String
    p = Split(FullString, ".")
    getControlPropertyName = CStr(p(2))
End Function