AI 助理
备案控制台
开发者社区 云计算 文章 正文

vb写的一个小解释器（暂定命名s++） 功能还很弱很弱

2022-12-29 98
版权
版权声明：
本文内容由阿里云实名注册用户自发贡献，版权归原作者所有，阿里云开发者社区不拥有其著作权，亦不承担相应法律责任。具体规则请查看《 阿里云开发者社区用户服务协议》和 《阿里云开发者社区知识产权保护指引》。如果您发现本社区中有涉嫌抄袭的内容，填写 侵权投诉表单进行举报，一经查实，本社区将立刻删除涉嫌侵权内容。
简介： vb写的一个小解释器（暂定命名s++） 功能还很弱很弱

代码打包下载：GitHub - sysdzw/SLanguage: vb开发的脚本语言，暂命名为s++语言，哈哈

有些地区github无法访问，可以复制下面代码，然后添加按钮Command1，文本框txtSource和txtOutput（设置多行模式）。

'------------------------------------------------'
' Author    : sysdzw                             '
' E-mail    : sysdzw@163.com                     '
' Bolg      : http://hi.baidu.com/sysdzw         '
' QQ        : 171977759                          '
' Date      : 2010-4-6                           '
'------------------------------------------------'
Option Explicit
Dim reg As Object
Dim matchs As Object, match As Object
Dim reg2 As Object
Dim matchs2 As Object, match2 As Object
Dim regForTest As Object
Dim dic As Object
Dim sc As Object
Dim strSource$, vSource, i%
Dim rVar$, rValuePattern$, rVarKeyWord$, rString$, rNumber$, rLoop$
Dim lngCurrentLine As Integer
'the code line's type
Private Enum ECodeType
    eCTSetValue
    eCTOutPut
    eCTOutPutEx
    eCTIF
    eCTELSE
    eCTEND
    eCTFOR
    eCTGOTO
    eCTGOTOLine
    eCTUnknow
End Enum
'the variable's type
Private Enum EVariableType
    eVTString
    eVTNumber
    eVTBool
    eVTDate
    eVTTime
End Enum
Private Sub Form_Load()
    Set sc = CreateObject("ScriptControl")
    sc.Language = "VBScript"
    Set reg = CreateObject("vbscript.regexp")
    reg.Global = True
    reg.IgnoreCase = True
    Set reg2 = CreateObject("vbscript.regexp")
    reg2.Global = True
    reg2.IgnoreCase = True
    Set regForTest = CreateObject("vbscript.regexp")
    regForTest.Global = True
    regForTest.IgnoreCase = True
    Set dic = CreateObject("Scripting.Dictionary")
    rVar = "[a-zA-Z_/u4e00-/u9fa5][/da-zA-Z_/u4e00-/u9fa5]*?"
    rString = """[/s/S]*?"""
    rNumber = "/d+/.?/d*"
    rValuePattern = "(" & rNumber & "|" & rString & "|" & rVar & ")"
    rLoop = "[a-zA-z/Z_]+?/d*"
    rVarKeyWord = "(puts|print|printf)"
End Sub
Private Sub Command1_Click()
    Dim strLineCode$
    Dim strVarName$, strVarValue$
    Dim sBefore$, sAfter$
    Dim intCodeLineType As Integer
    Dim strCondition As String
    Dim blnCondition As Boolean
    If txtOutput.Text <> "" And Right(txtOutput.Text, 2) <> vbCrLf Then txtOutput.Text = txtOutput.Text & vbCrLf
    txtOutput.SelStart = Len(txtOutput.Text)
    txtOutput.SelText = ">Start run program" & vbCrLf
    strSource = txtSource.Text
    vSource = Split(strSource, vbCrLf)
    dic.removeall
    lngCurrentLine = 0
    Do
        strLineCode = Trim(vSource(lngCurrentLine))
        If strLineCode <> "" Then
            intCodeLineType = getType(strLineCode)
            Select Case intCodeLineType
                Case eCTSetValue
                    reg.Pattern = "^(" & rVar & ")/s*?/=(.*)$"
                    Set matchs = reg.Execute(strLineCode)
                    sBefore = matchs(0).SubMatches(0)
                    sAfter = matchs(0).SubMatches(1)
                    If regTest(sAfter, "^" & rNumber & "$") Then
                        dic(sBefore) = eVTNumber & sAfter
                    ElseIf regTest(sAfter, "^" & rString & "$") Then
                        dic(sBefore) = eVTString & Mid(sAfter, 2, Len(sAfter) - 2)
                    ElseIf regTest(sAfter, "^" & rVar & "$") Then
                        If Not dic.Exists(sAfter) Then
                            dic(sAfter) = eVTString
                            dic(sBefore) = eVTString
                        Else
                            dic(sBefore) = dic(sAfter)
                        End If
                    Else 'is a expression
                        dic(sBefore) = getExpressionResult(sAfter)
                    End If
                Case eCTOutPut
                    reg.Pattern = "^" & rVarKeyWord & "/s+?" & rValuePattern & "$"
                    Set matchs = reg.Execute(strLineCode)
                    txtOutput.SelText = getTrueValue(matchs(0).SubMatches(1)) & vbCrLf
                Case eCTOutPutEx
                    reg.Pattern = "^" & rVarKeyWord & "/s+?(.*?)$"
                    Set matchs = reg.Execute(strLineCode)
                    txtOutput.SelText = Mid(getExpressionResult(matchs(0).SubMatches(1)), 2) & vbCrLf
                Case eCTIF
                    reg.Pattern = "^/s*?if(.+)$"
                    Set matchs = reg.Execute(strLineCode)
                    strCondition = matchs(0).SubMatches(0)
                    reg.Pattern = "^/s*?" & rValuePattern & "/s*?(<>|>/=|</=|/=|>|<)/s*?" & rValuePattern & "/s*?$"
                    Set matchs = reg.Execute(strCondition)
                    sBefore = getTrueValue(matchs(0).SubMatches(0))
                    sAfter = getTrueValue(matchs(0).SubMatches(2))
                    If Left(sBefore, 1) = eVTNumber Or Left(sAfter, 1) = eVTNumber Then
                        sBefore = Mid(sBefore, 2)
                        sAfter = Mid(sAfter, 2)
                        Select Case matchs(0).SubMatches(1)
                            Case "<>": blnCondition = (Val(sBefore) <> Val(sAfter))
                            Case ">=": blnCondition = (Val(sBefore) >= Val(sAfter))
                            Case "<=": blnCondition = (Val(sBefore) <= Val(sAfter))
                            Case ">": blnCondition = (Val(sBefore) > Val(sAfter))
                            Case "<": blnCondition = (Val(sBefore) < Val(sAfter))
                            Case "=":  blnCondition = (Val(sBefore) = Val(sAfter))
                        End Select
                    Else
                        Select Case matchs(0).SubMatches(1)
                            Case "<>": blnCondition = (sBefore <> sAfter)
                            Case ">=": blnCondition = (sBefore >= sAfter)
                            Case "<=": blnCondition = (sBefore <= sAfter)
                            Case ">": blnCondition = (sBefore > sAfter)
                            Case "<": blnCondition = (sBefore < sAfter)
                            Case "=":  blnCondition = (sBefore = sAfter)
                        End Select
                    End If
                    If Not blnCondition Then
                        lngCurrentLine = getTheElseLine(lngCurrentLine)
                    End If
                Case eCTELSE
                    lngCurrentLine = getTheElseLine(lngCurrentLine, "end")
                Case eCTGOTO
                    reg.Pattern = "^/s*?goto/s*?(" & rLoop & ")/s*$"
                    Set matchs = reg.Execute(strLineCode)
                    lngCurrentLine = getTheGotoLine(matchs(0).SubMatches(0) & ":")
                Case eCTFOR
                Case eCTUnknow
                    txtOutput.SelText = "Error at Line " & lngCurrentLine + 1 & ": """ & strLineCode & """" & vbCrLf
                    txtOutput.SelText = ">Exit code: -1" & vbCrLf
                    Exit Sub
            End Select
        End If
        lngCurrentLine = lngCurrentLine + 1
        If lngCurrentLine > UBound(vSource) Then Exit Do
    Loop
    txtOutput.SelText = ">Exit code: 0" & vbCrLf
End Sub
'get the line code's type
Private Function getType(ByVal strLineCode$) As ECodeType
    Dim vTmp
    If regTest(strLineCode, "^" & rVar & "/s*?/=/s*?.*$") Then
        getType = eCTSetValue
        Exit Function
    End If
    If regTest(strLineCode, "^/s*?if/s*?.*$") Then
        getType = eCTIF
        Exit Function
    End If
    If regTest(strLineCode, "^/s*?for/s*?.*$") Then
        getType = eCTFOR
        Exit Function
    End If
    If regTest(strLineCode, "^/s*?else/s*?.*$") Then
        getType = eCTELSE
        Exit Function
    End If
    If regTest(strLineCode, "^/s*?end/s*?.*$") Then
        getType = eCTEND
        Exit Function
    End If
    If regTest(strLineCode, "^/s*?goto/s*?.*$") Then
        getType = eCTGOTO
        Exit Function
    End If
    If regTest(strLineCode, "^/s*?" & rLoop & "/:/s*$") Then
        getType = eCTGOTOLine
        Exit Function
    End If
    If regTest(strLineCode, "^" & rVarKeyWord & "/s+?.+?$") Then
        If regTest(strLineCode & " + ", "^" & rVarKeyWord & "/s+?" & "(.+?)/s+?/+/s+?") Then
            getType = eCTOutPutEx
            Exit Function
        End If
        If regTest(strLineCode, "^" & rVarKeyWord & "/s+?" & rValuePattern & "$") Then
            getType = eCTOutPut
        End If
        getType = eCTOutPut
        Exit Function
    End If
    getType = eCTUnknow
End Function
'the para has 3 kinds
'1.num 2.string 3.var
Private Function getTrueValue(sValue$) As String
    If regTest(sValue, "^" & rNumber & "$") Then
        getTrueValue = eVTNumber & sValue
    ElseIf regTest(sValue, "^" & rString & "$") Then
        getTrueValue = eVTString & Mid(sValue, 2, Len(sValue) - 2)
    ElseIf regTest(sValue, "^" & rVar & "$") Then
        If Not dic.Exists(sValue) Then
            dic(sValue) = eVTString
            getTrueValue = eVTString
        Else
            getTrueValue = dic(sValue)
        End If
    End If
End Function
'the agrs is a expression
Private Function getExpressionResult(strExp As String) As String
    Dim strTmp$, i%, isNumExp As Boolean
    Dim strResult$, strTrueExp$, strExpTmp$
    strTmp = Replace(strExp, "(", "")
    strTmp = Replace(strTmp, ")", "")
    reg.Pattern = "(.+?)/s*?[/+/-/*/]/s*?"
    Set matchs = reg.Execute(strTmp & "+")
    reg2.Pattern = "(.+?)/s*?[/+/-/*/]/s*?"
    Set matchs2 = reg2.Execute(strExp & "+")
    isNumExp = True
    For i = 0 To matchs.Count - 1
        strExpTmp = Trim(matchs(i).SubMatches(0))
        If regTest(strExpTmp, "^" & rNumber & "$") Then
            strTrueExp = strTrueExp & matchs2(i)
        ElseIf regTest(strExpTmp, "^" & rString & "$") Then
            strTrueExp = strTrueExp & matchs2(i)
            isNumExp = False
        ElseIf regTest(strExpTmp, "^" & rVar & "$") Then
            If Not dic.Exists(strExpTmp) Then
                dic(strExpTmp) = eVTString
            Else
                If Left(dic(strExpTmp), 1) <> eVTNumber Then isNumExp = False
                strTrueExp = strTrueExp & Replace(matchs2(i), strExpTmp, Mid(dic(strExpTmp), 2))
            End If
        End If
    Next
    If isNumExp Then
        If Right(strTrueExp, 1) = "+" Then strTrueExp = Left(strTrueExp, Len(strTrueExp) - 1)
        getExpressionResult = eVTNumber & WZcalc(strTrueExp)
    Else
        reg.Pattern = "(.+?)/s*?/+/s*?"
        Set matchs = reg.Execute(strExp & "+")
        For i = 0 To matchs.Count - 1
            strExpTmp = Trim(matchs(i).SubMatches(0))
            If regTest(strExpTmp, "^" & rNumber & "$") Then
                strResult = strResult & strExpTmp
            ElseIf regTest(strExpTmp, "^" & rString & "$") Then
                strResult = strResult & Mid(strExpTmp, 2, Len(strExpTmp) - 2)
            ElseIf regTest(strExpTmp, "^" & rVar & "$") Then
                If Not dic.Exists(strExpTmp) Then
                    dic(strExpTmp) = eVTString
                Else
                    strResult = strResult & Mid(dic(strExpTmp), 2)
                End If
            End If
        Next
        getExpressionResult = eVTString & strResult
    End If
End Function
'get the "else" line,if it hadn't "else" it'll return the "end" line.
'if the para "strKey" is "end",this means it'll find the "end" line.
Private Function getTheElseLine(intCurIfLine As Integer, Optional strKey = "else") As Integer
    Dim v, i%
    Dim isIFClosed() As Boolean
    Dim intCurrentIF As Integer
    v = Split(txtSource.Text, vbCrLf)
    i = intCurIfLine + 1
    intCurrentIF = 0
    ReDim Preserve isIFClosed(intCurrentIF)
    isIFClosed(intCurrentIF) = False
    Do
        If regTest(v(i), "^/s*?if/s*?.*$") Then
            ReDim Preserve isIFClosed(UBound(isIFClosed) + 1)
            intCurrentIF = UBound(isIFClosed)
            isIFClosed(intCurrentIF) = False
        ElseIf regTest(v(i), "^/s*?else/s*$") Then
            If intCurrentIF = 0 Then
                getTheElseLine = i
                If strKey = "else" Then Exit Function
            End If
        ElseIf regTest(v(i), "^/s*?end/s*$") Then
            If intCurrentIF = 0 Then
                getTheElseLine = i
                Exit Function
            Else
                isIFClosed(intCurrentIF) = True
                Do
                    intCurrentIF = intCurrentIF - 1
                    If isIFClosed(intCurrentIF) = False Then Exit Do
                Loop
            End If
        End If
        i = i + 1
        If i > UBound(v) Then Exit Do
    Loop
End Function
'get the "goto" line
Private Function getTheGotoLine(strGotoTag As String) As Integer
    Dim v, i%
    Dim intLen As Integer
    intLen = Len(strGotoTag)
    v = Split(txtSource.Text, vbCrLf)
    For i = 0 To UBound(v)
        If Left(v(i), intLen) = strGotoTag Then
            getTheGotoLine = i
            Exit Function
        End If
    Next
End Function
'test the string is mathed the pattern
Private Function regTest(ByVal sData$, sPattern$) As Boolean
    regForTest.Pattern = sPattern
    regTest = regForTest.Test(sData)
End Function
Public Function WZcalc(Tmpstr$) As Double
   WZcalc = sc.Eval(Tmpstr)
End Function
Private Sub Form_Resize()
    If Me.WindowState = 1 Then Exit Sub
    txtSource.Height = (Me.ScaleHeight - txtSource.Top) * 0.65
    txtSource.Width = Me.ScaleWidth - 45
    Label1.Top = txtSource.Top + txtSource.Height + 45
    txtOutput.Move 0, Label1.Top + Label1.Height + 45, Me.ScaleWidth - 45, Me.ScaleHeight - Label1.Top - Label1.Height - 90
End Sub
Private Sub txtSource_GotFocus()
    Dim C As Object
    On Error Resume Next
    For Each C In Me.Controls
        C.TabStop = False
    Next
End Sub
Private Sub txtSource_LostFocus()
    Dim C As Object
    On Error Resume Next
    For Each C In Me.Controls
        C.TabStop = True
    Next
End Sub
Private Sub Command2_Click()
    MsgBox getTheElseLine(1)
End Sub
Private Sub Command3_Click()
    Dim v, i%, t$
    Dim isIFClosed() As Boolean
    Dim intCurrentIF As Integer
    v = Split(txtSource.Text, vbCrLf)
    i = 2
    intCurrentIF = 0
    ReDim Preserve isIFClosed(intCurrentIF)
    isIFClosed(intCurrentIF) = False
    Do
        If InStr(v(i), "if") > 0 Then
            ReDim Preserve isIFClosed(UBound(isIFClosed) + 1)
            intCurrentIF = UBound(isIFClosed)
            isIFClosed(intCurrentIF) = False
        ElseIf InStr(v(i), "else") > 0 Then
            If intCurrentIF = 0 Then
                MsgBox "else at line: " & i + 1
            End If
        ElseIf InStr(v(i), "end") > 0 Then
            If intCurrentIF = 0 Then
                MsgBox "end at line: " & i + 1
            Else
                isIFClosed(intCurrentIF) = True
                Do
                    intCurrentIF = intCurrentIF - 1
                    If isIFClosed(intCurrentIF) = False Then Exit Do
                Loop
            End If
        End If
        i = i + 1
        If i > UBound(v) Then Exit Do
    Loop
End Sub

一、交换两个变量的范例

image.png

二、if语句嵌套结合goto的范例1

image.png

三、if语句嵌套结合goto的范例2

image.png

四、多层if嵌套测试

image.png

五、99乘法表演示

image.png


sysdzw
目录
相关文章
数据知道
|
2月前
|
IDE 开发工具 Python
python3代码编程规范（命名、空格、注释、代码布局、编程建议等）
该文章详细介绍了Python3的编程规范，包括命名、空格使用、注释、代码布局等方面的最佳实践，帮助提升代码的可读性和一致性。
数据知道
45 0
小Lee
|
4月前
|
开发者 Python
Python中注释用途
【7月更文挑战第28天】
小Lee
51 6
游客o2eg5xknvn5tq
|
C语言
使用Visual studio 2013 创建C语言Helloworld程序
使用Visual studio 2013 创建C语言Helloworld程序
游客o2eg5xknvn5tq
225 0
使用Visual studio 2013 创建C语言Helloworld程序
摘星月为妆。
|
存储 JSON Unix
30.从入门到精通：Python3 命名空间和作用域 命名空间 作用域 Python3 标准库概览 操作系统接口 文件通配符 命令行参数 错误输出重定向和程序终止 字符串正则匹配 访问 互联网 日期和
30.从入门到精通：Python3 命名空间和作用域 命名空间 作用域 Python3 标准库概览 操作系统接口 文件通配符 命令行参数 错误输出重定向和程序终止 字符串正则匹配 访问 互联网 日期和
摘星月为妆。
145 0
全能杰哥
|
Python
猪行天下之Python基础——2.2 标识符，基础函数，行与缩进，空语句
内容简述： 1、标识符 2、print()打印输出函数 3、input()输入函数 4、dir()函数 5、help()函数 6、type()函数 & isinstance()函数 7、行与缩进 8、pass空语句
全能杰哥
137 0
码农技术君
VB编程：FileLen函数获取文件的大小
VB编程：FileLen函数获取文件的大小
码农技术君
304 0
大松哥
|
JavaScript Java Python
（一）python初识、变量、注释、模块使用
python初识 　　移步老男孩武sir文章（python2）：http://www.cnblogs.com/wupeiqi/articles/5433925.html        武功sir文章列表（python2）：http://www.cnblogs.com/wupeiqi/articles/5433893.html        Centos6升级python2至python3：http://www.cnblogs.com/lyy-totoro/p/5603102.html 简单笔记如下： 　　python的特点 　　　　可以写网页，也可以写后台功能。
大松哥
1254 0
优惠券活动
|
IDE Java 开发工具
Python入门(二)——IDE选择PyCharm，输入和输出，基础规范，数据类型和变量,常量，字符串和编码，格式化
Python入门(二)——IDE选择PyCharm，输入和输出，基础规范，数据类型和变量,常量，字符串和编码，格式化 我们从今天就开始正式的学习PY交易了，PY交易还行，我们有基础之后学习起来倒不是说那么的被动，我学习的是Python2.
优惠券活动
3029 0
技术小甜
|
索引
VC2015编写的DLL给其他语言调用
技术小甜
1529 0
异步社区
|
自然语言处理 Python
《Python参考手册（第4版•修订版）》——第2章 词法约定和语法 2.1 行结构和缩进
异步社区
1917 0