xhmscript.cls

本人早先用vb写的脚本解释器,功能不是很多,支持分支循环的嵌套.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "XHMScriptM"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Dim lines As Integer
Dim xx As Integer
Dim yy As Integer
Dim ti As Boolean
Dim anas() As String
Dim anas2() As String
Dim loops As Integer
Dim ifs As Integer
Dim funcs() As String
Dim funcnames() As String
Dim funclen() As Integer
Dim dcfile As New DelCopyFile

Sub fz(GS As String, index As Integer)
    bb(index).数据 = ana.变量翻译(bb(), GS)
End Sub


Sub 如果(ifss As Integer)
Dim runs As Boolean
Dim ifs2 As Integer
ifs2 = ifss
    If anas2(2) = "=" Then
        If ana.比较脚本分析(anas2(1), anas2(3), bb()) = 0 Then
            runs = True
        End If
    End If
    If anas2(2) = "<>" Then
        If ana.比较脚本分析(anas2(1), anas2(3), bb()) <> 0 Then
            runs = True
        End If
    End If
    If anas2(2) = ">=" Then
        If ana.比较脚本分析(anas2(1), anas2(3), bb()) >= 0 Then
            runs = True
        End If
    End If
    If anas2(2) = "<=" Then
        If ana.比较脚本分析(anas2(1), anas2(3), bb()) <= 0 Then
            runs = True
        End If
    End If
    If anas2(2) = ">" Then
        If ana.比较脚本分析(anas2(1), anas2(3), bb()) > 0 Then
            runs = True
        End If
    End If
    If anas2(2) = "<" Then
        If ana.比较脚本分析(anas2(1), anas2(3), bb()) < 0 Then
            runs = True
        End If
    End If
    lines = lines + 1
    ifs = ifs + 1
            
    If runs Then
    Do While lines <= UBound(anas())
    If anas(lines) <> "" Then
        anas2() = Split(anas(lines), " ")
        If anas2(0) = "Set" Then
            For i = 0 To UBound(bb())
                If bb(i).名称 = anas2(1) Then
                    fz anas2(3), CInt(i)
                End If
            Next
        End If
        If anas2(0) = "While" Then
            循环 loops
        End If
        If anas2(0) = "If" Then
            如果 ifs
        End If
        If anas2(0) = "EndIf" Then
            ifs = ifs - 1
        If ifs = ifs2 Then
            runs = True
            Exit Sub
        End If
        End If
        多媒体脚本分析 anas2()
    End If
    DoEvents
    lines = lines + 1
    Loop
    ElseIf Not runs Then
    
    Do While lines <= UBound(anas())
    If anas(lines) <> "" Then
        anas2() = Split(anas(lines), " ")
        If anas2(0) = "If" Then
            ifs = ifss + 1
        End If
        If anas2(0) = "EndIf" Then
            ifs = ifs - 1
        If ifs = ifs2 Then
            Exit Sub
        End If
        End If
    End If
    DoEvents
    lines = lines + 1
    Loop

    End If
End Sub

Sub 循环(loopss As Integer)
Dim runs As Boolean
Dim loops2 As Integer
Dim start As Integer
start = lines
loops2 = loopss
loops3:
    If anas2(2) = "=" Then
        If ana.比较脚本分析(anas2(1), anas2(3), bb()) = 0 Then
            runs = True
        Else
            runs = False
        End If
    End If
    If anas2(2) = "<>" Then
        If ana.比较脚本分析(anas2(1), anas2(3), bb()) <> 0 Then
            runs = True
        Else
            runs = False
        End If
    End If
    If anas2(2) = ">=" Then
        If ana.比较脚本分析(anas2(1), anas2(3), bb()) >= 0 Then
            runs = True
        Else
            runs = False
        End If
    End If
    If anas2(2) = "<=" Then
        If ana.比较脚本分析(anas2(1), anas2(3), bb()) <= 0 Then
            runs = True
        Else
            runs = False
        End If
    End If
    If anas2(2) = ">" Then
        If ana.比较脚本分析(anas2(1), anas2(3), bb()) > 0 Then
            runs = True
        Else
            runs = False
        End If
    End If
    If anas2(2) = "<" Then
        If ana.比较脚本分析(anas2(1), anas2(3), bb()) < 0 Then
            runs = True
        Else
            runs = False
        End If
    End If
    lines = lines + 1
    loops = loops + 1
            
    
    If runs Then
    Do While lines <= UBound(anas())
    If anas(lines) <> "" Then
        anas2() = Split(anas(lines), " ")
        If anas2(0) = "Set" Then
            For i = 0 To UBound(bb())
                If bb(i).名称 = anas2(1) Then
                    fz anas2(3), CInt(i)
                End If
            Next
        End If
        If anas2(0) = "While" And start <> lines Then
            loops = loops + 1
            循环 loops
        End If
        If anas2(0) = "While" And start = lines Then
            GoTo loops3
        End If
        If anas2(0) = "If" Then
            如果 ifs
        End If
        If anas2(0) = "Loop" Then
            loops = loops - 1
        If loops = loops2 Then
            ends = lines
            lines = start - 1
            runs = True
        End If
        End If
        多媒体脚本分析 anas2()
    End If
    DoEvents
    lines = lines + 1
    Loop
    ElseIf Not runs Then
    
    Do While lines <= UBound(anas())
    If anas(lines) <> "" Then
        anas2() = Split(anas(lines), " ")
        If anas2(0) = "While" Then
            loops = loopss + 1
        End If
        If anas2(0) = "Loop" Then
            loops = loops - 1
        If loops = loops2 Then
            Exit Sub
        End If
        End If
    End If
    DoEvents
    lines = lines + 1
    Loop

    End If

End Sub

Sub 分析脚本(脚本 As String, 资源路径 As String)
路径 = 资源路径
On Error GoTo Err
    loops = 0
    ifs = 0
    lines = 0
    anas = Split(脚本, vbCrLf)
    Do While lines <= UBound(anas())
        anas2() = Split(anas(lines), " ")
        If UBound(anas2()) >= 0 Then
        If anas2(0) = "Public" Then
            xx = xx + 1
        End If
        End If
        lines = lines + 1
    Loop
    lines = 0
    ReDim bb(xx) As 变量表
    xx = 0
    Do While lines <= UBound(anas())
        anas2() = Split(anas(lines), " ")
        If UBound(anas2()) >= 0 Then
        If anas2(0) = "Public" Then
            bb(xx).名称 = anas2(1)
            bb(xx).数据 = anas2(2)
            xx = xx + 1
        End If
        End If
        lines = lines + 1
    Loop
    lines = 0
    Do While lines <= UBound(anas())
    If anas(lines) <> "" Then
        anas2() = Split(anas(lines), " ")
        If anas2(0) = "Set" Then
            For i = 0 To UBound(bb())
                If bb(i).名称 = anas2(1) Then
                    fz anas2(3), CInt(i)
                End If
            Next
        End If
        If anas2(0) = "While" Then
            循环 loops
        End If
        If anas2(0) = "If" Then
            如果 ifs
        End If
        多媒体脚本分析 anas2()
    End If
    DoEvents
    lines = lines + 1
    Loop

    Exit Sub
Err:
    MsgBox "错误在" & lines
End Sub

Function 获得结果(变量名称 As String) As String
    For i = 0 To UBound(bb())
        If bb(i).名称 = 变量名称 Then
            获得结果 = bb(i).数据
        End If
    Next
End Function

Sub 多媒体脚本分析(anas2() As String)
    If anas2(0) = "SurfaceN" Then
        If 窗口化 Then
            dd2.设定对象数量 CInt(翻译变量2(anas2(1), bb()))
        Else
            dd.设定对象数量 0, CInt(翻译变量2(anas2(1), bb()))
        End If
    End If
    If anas2(0) = "LoadPic" Then
        If dcfile.ReportFileStatus(路径 & anas2(2)) Then
        If 窗口化 Then
            dd2.读入T表面 CInt(翻译变量2(anas2(1), bb())), 路径 & anas2(2), &HFF, D3DFMT_A8R8G8B8
        Else
            dd.读入T表面 CInt(翻译变量2(anas2(1), bb())), 路径 & anas2(2), &HFF, D3DFMT_A8R8G8B8
        End If
        Else
        If 窗口化 Then
            dd2.读入T表面 CInt(翻译变量2(anas2(1), bb())), anas2(2), &HFF, D3DFMT_A8R8G8B8
        Else
            dd.读入T表面 CInt(翻译变量2(anas2(1), bb())), anas2(2), &HFF, D3DFMT_A8R8G8B8
        End If
            
        End If
    End If

    If anas2(0) = "Draw" Then
    Dim p1 As Point
    Dim p2 As Point
    Dim p3 As Point
    Dim p4 As Point
    p1.x = Val(翻译变量2(anas2(5), bb()))
    p1.y = Val(翻译变量2(anas2(6), bb())) + Val(翻译变量2(anas2(4), bb()))
    p2.x = Val(翻译变量2(anas2(5), bb()))
    p2.y = Val(翻译变量2(anas2(6), bb()))
    p3.x = Val(翻译变量2(anas2(5), bb())) + Val(翻译变量2(anas2(3), bb()))
    p3.y = Val(翻译变量2(anas2(6), bb())) + Val(翻译变量2(anas2(4), bb()))
    p4.x = Val(翻译变量2(anas2(5), bb())) + Val(翻译变量2(anas2(3), bb()))
    p4.y = Val(翻译变量2(anas2(6), bb()))
    
        If 窗口化 Then
            dd2.绘制T表面 0, 0, 1, 1, p1, p2, p3, p4, CInt(翻译变量2(anas2(1), bb())), Val(翻译变量2(anas2(2), bb())), Val(翻译变量2(anas2(2), bb())), Val(翻译变量2(anas2(2), bb())), Val(翻译变量2(anas2(2), bb()))
        Else
            dd.绘制T表面 0, 0, 1, 1, p1, p2, p3, p4, CInt(翻译变量2(anas2(1), bb())), Val(翻译变量2(anas2(2), bb())), Val(翻译变量2(anas2(2), bb())), Val(翻译变量2(anas2(2), bb())), Val(翻译变量2(anas2(2), bb()))
        End If
    End If
    If anas2(0) = "DrawText" Then
    Dim r1 As RECT
    r1.Left = Val(翻译变量2(anas2(5), bb()))
    r1.Top = Val(翻译变量2(anas2(6), bb()))
    r1.Right = r1.Left + 500
    r1.bottom = r1.Top + 500
        If 窗口化 Then
            dd2.设置字体 anas2(1), Val(翻译变量2(anas2(2), bb())), False, False
            dd2.写字 翻译变量2(anas2(3), bb()), r1, Val(翻译变量2(anas2(4), bb()))
        Else
            dd.设置字体 anas2(1), Val(翻译变量2(anas2(2), bb())), False, False
            dd.写字 翻译变量2(anas2(3), bb()), r1, Val(翻译变量2(anas2(4), bb()))
        End If
    End If
    If anas2(0) = "BeginScene" Then
        If 窗口化 Then
            dd2.开始页面
        Else
            dd.开始页面
        End If
    End If
    If anas2(0) = "EndScene" Then
        If 窗口化 Then
            dd2.翻页
        Else
            dd.翻页
        End If
    End If
    If anas2(0) = "PlayMovie" Then
    If dcfile.ReportFileStatus(路径 & anas2(1)) Then
        dsh.文件名 = 路径 & anas2(1)
    Else
        dsh.文件名 = anas2(1)
    End If
        dsh.播放 当前窗口2, 宽2, 高2
        Do While dsh.获得播放时间 < dsh.获得总时间
        DoEvents
        Loop
        dsh.停止
    End If
    If anas2(0) = "PlaySound" Then
    If dcfile.ReportFileStatus(路径 & anas2(1)) Then
        ds.播放音效 路径 & anas2(1), Val(翻译变量2(anas2(2), bb()))
    Else
        ds.播放音效 anas2(1), Val(翻译变量2(anas2(2), bb()))
    End If
        ds.设置音量 Val(翻译变量2(anas2(3), bb())), Val(翻译变量2(anas2(2), bb()))
    End If
    If anas2(0) = "PlayMusic" Then
        If dcfile.ReportFileStatus(路径 & anas2(1)) Then
        dm.播放音乐文件 路径 & anas2(1), Val(翻译变量2(anas2(2), bb())), 当前窗口
        Else
        dm.播放音乐文件 anas2(1), Val(翻译变量2(anas2(2), bb())), 当前窗口
        End If
    End If
    If anas2(0) = "StopMusic" Then
        dm.停止当前音乐
    End If
    If anas2(0) = "GetMouseInf" Then
        di.鼠标控制
        For i = 0 To UBound(bb)
            If bb(i).名称 = anas2(1) Then
                fz CStr(di.x), CInt(i)
            End If
            If bb(i).名称 = anas2(2) Then
                fz CStr(di.y), CInt(i)
            End If
            If bb(i).名称 = anas2(3) Then
                fz CStr(di.b1), CInt(i)
            End If
            If bb(i).名称 = anas2(4) Then
                fz CStr(di.b2), CInt(i)
            End If
            If bb(i).名称 = anas2(5) Then
                fz CStr(di.b3), CInt(i)
            End If
        Next
    End If
    If anas2(0) = "Timer" Then
        For i = 0 To UBound(bb)
            If bb(i).名称 = anas2(1) Then
                fz Timer, CInt(i)
            End If
        Next
        
    End If
    If anas2(0) = "GetKeyInf" Then
        If keys(Val(anas2(1))) Then
            For j = 0 To UBound(bb)
                If bb(j).名称 = anas2(2) Then
                    bb(j).数据 = "1"
                End If
            Next
        End If
    End If
    If anas2(0) = "SetMouse" Then
        di.设置鼠标位置 Val(翻译变量2(anas2(1), bb())), Val(翻译变量2(anas2(2), bb()))
    End If
End Sub

Sub 初始化图形(窗口 As Long, 宽 As Integer, 高 As Integer, 是否窗口 As Boolean)
    dx.开始DirectX8
    If 是否窗口 Then
    dx2.开始DirectX8
    dx2.开始2D对象 窗口
    Else
    dx.开始2D对象 宽, 高, D3DFMT_A8R8G8B8, 窗口
    End If
    窗口化 = 是否窗口
    当前窗口2 = 窗口
    宽2 = 宽
    高2 = 高
End Sub

Sub 初始化声音音乐(窗口 As Long)
    dx.开始声音对象 窗口
    dx.开始音乐对象
    ds.设置通道数量 10
    当前窗口 = 窗口
End Sub

Sub 初始化鼠标(窗口 As Long)
    dx.开始输入设备
    di.设置鼠标 窗口, True
End Sub

Sub 键盘操作入口(keycode As Long)
    keys(keycode) = 1
End Sub

Sub 键盘消除入口(keycode As Long)
    keys(keycode) = 0
End Sub