⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 parse_template.bas

📁 s@T卡脚本解析标准范例
💻 BAS
📖 第 1 页 / 共 2 页
字号:
Attribute VB_Name = "Parse_Template"
Public Function ProcessTemplateSetVar(ByVal CurrentDeckNo As Integer, _
                                ByRef CurrentScriptIndex As Integer, ByRef script() As String)
'eg of line to be parsed
'<setvar name="c1" value="aaa" sat-do-clr="false">
'<setvar name="d1" value="bbb" sat-do-clr="true">
'<setvar name="e1" value="ccc" sat-do-clr="false">
'</setvar>
                                
Dim Name As String
Dim value As String
Dim satdoclr As String
Dim initvar As String

    While InStr(1, script(CurrentScriptIndex), "</setvar>", vbTextCompare) = 0
        satdoclr = "false" 'default
        
        i = InStr(1, script(CurrentScriptIndex), "name", vbTextCompare)
        If i > 0 Then
            Name = ""
            i = i + 6
            Name = Name & Mid(script(CurrentScriptIndex), i, 2)
        End If
        i = InStr(1, script(CurrentScriptIndex), "value", vbTextCompare)
        If i > 0 Then
            value = ""
            i = i + 7
            While Mid(script(CurrentScriptIndex), i, 1) <> """"
                value = value & Mid(script(CurrentScriptIndex), i, 1)
                i = i + 1
            Wend
        End If
        i = InStr(1, script(CurrentScriptIndex), "sat-do-clr", vbTextCompare)
        If i > 0 Then
            satdoclr = ""
            i = i + 12
            While Mid(script(CurrentScriptIndex), i, 1) <> """"
                satdoclr = satdoclr & Mid(script(CurrentScriptIndex), i, 1)
                i = i + 1
            Wend
        End If
    
        'check if value is a variable reference or inline value element
        If Mid(value, 1, 1) <> "$" Then
            'this is an inline value element
            initvar = initvar & Name & "0A" & Right("0" & Hex(Len(value)), 2) & ToHex(value)
        Else
            'this is a variable reference
            initvar = initvar & Name & "08" & "01" & Right(value, 2)
        End If
        
        'set variables list to be clear in current deck
        If satdoclr = "true" Then
            If thisSATEnv.DeckInfo(CurrentDeckNo).VarRefListTag <> "&H09" Then thisSATEnv.DeckInfo(CurrentDeckNo).VarRefListTag = "&H09"
            i = 0
            If Not ((Not thisSATEnv.DeckInfo(CurrentDeckNo).varid) = True) Then i = UBound(thisSATEnv.DeckInfo(CurrentDeckNo).varid) + 1
            ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).varid(i)
            thisSATEnv.DeckInfo(CurrentDeckNo).varid(i) = "&H" & Name
        End If
                
        CurrentScriptIndex = CurrentScriptIndex + 1
    Wend
    
    'calculate the length for the variable reference section
    Dim templength As Integer
    templength = Len(initvar) / 2
    If templength > 255 Then '[256-65535]
        '3 byte representation
        decklength = decklength + 3
        ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).VarRefListLength(2)
        thisSATEnv.DeckInfo(CurrentDeckNo).VarRefListLength(0) = "&H82" 'fixed
        thisSATEnv.DeckInfo(CurrentDeckNo).VarRefListLength(1) = "&H" & Left("0" & Hex(templength), 2)
        thisSATEnv.DeckInfo(CurrentDeckNo).VarRefListLength(2) = "&H" & Right("0" & Hex(templength), 2)
        initvar = "20" & "82" & Left("0" & Hex(templength), 2) & Right("0" & Hex(templength), 2) & initvar
    Else
        If templength > 127 And templength <= 255 Then '[128-255]
            '2 byte representation
            decklength = decklength + 2
            ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).VarRefListLength(1)
            thisSATEnv.DeckInfo(CurrentDeckNo).VarRefListLength(0) = "&H81" 'fixed
            thisSATEnv.DeckInfo(CurrentDeckNo).VarRefListLength(1) = "&H" & Mid(Hex(templength), 1, 2)
            initvar = "20" & "81" & Mid(Hex(templength), 1, 2) & initvar
        Else
            If templength < 128 Then
                '1 byte representation
                decklength = decklength + 1
                ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).VarRefListLength(0)
                thisSATEnv.DeckInfo(CurrentDeckNo).VarRefListLength(0) = "&H" & Right("0" & Hex(templength), 2)
                initvar = "20" & Right("0" & Hex(templength), 2) & initvar
            End If
        End If
    End If
    
    'put into template bytecode array
    Dim j As Integer
    i = 1
    If Not ((Not thisSATEnv.DeckInfo(CurrentDeckNo).TemplateByteCode) = True) Then _
        j = UBound(thisSATEnv.DeckInfo(CurrentDeckNo).TemplateByteCode) + 1
    While i < Len(initvar)
        ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).TemplateByteCode(j)
        thisSATEnv.DeckInfo(CurrentDeckNo).TemplateByteCode(j) = "&H" & Mid(initvar, i, 2)
        j = j + 1
        i = i + 2
    Wend
    
    thisSATEnv.DeckInfo(CurrentDeckNo).TemplateTag = &H7
    templength = UBound(thisSATEnv.DeckInfo(CurrentDeckNo).TemplateByteCode) + 1
    If templength > 255 Then
        ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(2)
        thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(0) = &H82
        thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(1) = "&H" & Left("0" & Hex(templength), 2)
        thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(2) = "&H" & Right("0" & Hex(templength), 2)
    Else
        If templength > 127 And templength <= 255 Then
            ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(1)
            thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(0) = &H81
            thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(1) = "&H" & Mid(Hex(templength), 1, 2)
        Else
            If templength < 128 Then
                ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(0)
                thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(0) = "&H" & Right("0" & Hex(templength), 2)
            End If
        End If
    End If
    
    
    initvar = "[Deck" & CurrentDeckNo & " Template] ---> " & "[Set Variable] ---> " & initvar
    i = 0
    If Not ((Not output) = True) Then i = UBound(output) + 1
    ReDim Preserve output(i)
    output(i) = initvar
                            
End Function

Public Function ProcessTemplateExtract(ByVal CurrentDeckNo As Integer, _
                        ByRef CurrentScriptIndex As Integer, ByRef script() As String) As Integer

'eg of line to parsed
'<extract destvar="c1" sourcevar="b1" startindex="01" length="10">
                        
Dim destvar As String
Dim sourcevar As String
Dim startindex As Integer
Dim length As Integer
Dim extract As String

    i = InStr(1, script(CurrentScriptIndex), "destvar", vbTextCompare)
    If i > 0 Then
        i = i + 9
        destvar = Mid(script(CurrentScriptIndex), i, 2)
    End If
    i = InStr(1, script(CurrentScriptIndex), "sourcevar", vbTextCompare)
    If i > 0 Then
        i = i + 11
        sourcevar = Mid(script(CurrentScriptIndex), i, 2)
    End If
    i = InStr(1, script(CurrentScriptIndex), "startindex", vbTextCompare)
    If i > 0 Then
        i = i + 12
        startindex = Mid(script(CurrentScriptIndex), i, 2)
    End If
    i = InStr(1, script(CurrentScriptIndex), "length", vbTextCompare)
    If i > 0 Then
        i = i + 8
        length = Mid(script(CurrentScriptIndex), i, 2)
    End If
    
    extract = "25" & "04" & destvar & sourcevar & Right("0" & Hex(startindex), 2) & Right("0" & Hex(length), 2)

    'put into bytecode array
    Dim j As Integer
    i = 1
    If Not ((Not thisSATEnv.DeckInfo(CurrentDeckNo).TemplateByteCode) = True) _
        Then j = UBound(thisSATEnv.DeckInfo(CurrentDeckNo).TemplateByteCode) + 1
    While i < Len(extract)
        ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).TemplateByteCode(j)
        thisSATEnv.DeckInfo(CurrentDeckNo).TemplateByteCode(j) = "&H" & Mid(extract, i, 2)
        j = j + 1
        i = i + 2
    Wend
    
    Dim templength As Integer
    thisSATEnv.DeckInfo(CurrentDeckNo).TemplateTag = &H7
    templength = UBound(thisSATEnv.DeckInfo(CurrentDeckNo).TemplateByteCode) + 1
    If templength > 255 Then
        ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(2)
        thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(0) = &H82
        thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(1) = "&H" & Left("0" & Hex(templength), 2)
        thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(2) = "&H" & Right("0" & Hex(templength), 2)
    Else
        If templength > 127 And templength <= 255 Then
            ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(1)
            thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(0) = &H81
            thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(1) = "&H" & Mid(Hex(templength), 1, 2)
        Else
            If templength < 128 Then
                ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(0)
                thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(0) = "&H" & Right("0" & Hex(templength), 2)
            End If
        End If
    End If
    
    
    extract = "[Deck" & CurrentDeckNo & " Template] ---> " & "[Extract] ---> " & extract
    i = 0
    If Not ((Not output) = True) Then i = UBound(output) + 1
    ReDim Preserve output(i)
    output(i) = extract

End Function

Public Function ProcessTemplateGetEnv(ByVal CurrentDeckNo As Integer, _
                        ByVal CurrentScriptIndex As Integer, ByRef script() As String) As Integer
                        
'eg of line to be parsed
'<getenv destid="" envid="">

Dim destid As String
Dim envid As String
Dim getenv As String

    i = InStr(1, script(CurrentScriptIndex), "destid", vbTextCompare)
    If i > 0 Then
        i = i + 8
        destid = Mid(script(CurrentScriptIndex), i, 2)
    End If
    i = InStr(1, script(CurrentScriptIndex), "envid", vbTextCompare)
    If i > 0 Then
        i = i + 7
        envid = Mid(script(CurrentScriptIndex), i, 2)
    End If
                        
    getenv = "22" & "02" & destid & envid

    'put into bytecode array
    Dim j As Integer
    i = 1
    If Not ((Not thisSATEnv.DeckInfo(CurrentDeckNo).TemplateByteCode) = True) _
        Then j = UBound(thisSATEnv.DeckInfo(CurrentDeckNo).TemplateByteCode) + 1
    While i < Len(getenv)
        ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).TemplateByteCode(j)
        thisSATEnv.DeckInfo(CurrentDeckNo).TemplateByteCode(j) = "&H" & Mid(getenv, i, 2)
        j = j + 1
        i = i + 2
    Wend
    
    Dim templength As Integer
    thisSATEnv.DeckInfo(CurrentDeckNo).TemplateTag = &H7
    templength = UBound(thisSATEnv.DeckInfo(CurrentDeckNo).TemplateByteCode) + 1
    If templength > 255 Then
        ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(2)
        thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(0) = &H82
        thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(1) = "&H" & Left("0" & Hex(templength), 2)
        thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(2) = "&H" & Right("0" & Hex(templength), 2)
    Else
        If templength > 127 And templength <= 255 Then
            ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(1)
            thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(0) = &H81
            thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(1) = "&H" & Mid(Hex(templength), 1, 2)
        Else
            If templength < 128 Then
                ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(0)
                thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(0) = "&H" & Right("0" & Hex(templength), 2)
            End If
        End If
    End If
    

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -