parse_satml.bas

s@T卡脚本解析标准范例

        While Mid(script(CurrentScriptIndex), i, 1) <> """"
            title = title & Mid(script(CurrentScriptIndex), i, 1)
            i = i + 1
        Wend
    End If
    i = InStr(1, script(CurrentScriptIndex), "name", vbTextCompare)
    If i > 0 Then
        i = i + 6
        While Mid(script(CurrentScriptIndex), i, 1) <> """"
            Name = Name & Mid(script(CurrentScriptIndex), i, 1)
            i = i + 1
        Wend
    End If
    i = InStr(1, script(CurrentScriptIndex), "value", vbTextCompare)
    If i > 0 Then
        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), "min", vbTextCompare)
    If i > 0 Then
        i = i + 5
        While Mid(script(CurrentScriptIndex), i, 1) <> """"
            min = min & Mid(script(CurrentScriptIndex), i, 1)
            i = i + 1
        Wend
    End If
    i = InStr(1, script(CurrentScriptIndex), "max", vbTextCompare)
    If i > 0 Then
        i = i + 5
        While Mid(script(CurrentScriptIndex), i, 1) <> """"
            max = max & Mid(script(CurrentScriptIndex), i, 1)
            i = i + 1
        Wend
    End If
    i = InStr(1, script(CurrentScriptIndex), "cmdqlf", vbTextCompare)
    If i > 0 Then
        i = i + 8
        While Mid(script(CurrentScriptIndex), i, 1) <> """"
            cmdqlf = cmdqlf & Mid(script(CurrentScriptIndex), i, 1)
            i = i + 1
        Wend
    End If
    
    gi = "23" & cmdqlf & "82"
    
    'format stk command
    'format text string
    If title <> "" Then
        'calculate length for title
        gi = gi & "8D" & Right("0" + Hex(Len(title) + 1), 2) & "04" & ToHex(title)
    End If
    'format response length
    If min And max <> "" Then
        gi = gi & "91" & "02" & Right("0" + Hex(min), 2) & Right("0" + Hex(max), 2)
    End If
    'format default value
    If value <> "" Then
        gi = gi & "97" & Right("0" + Hex(Len(value) + 1), 2) & "04" & ToHex(value)
    End If
    'format variable to store proactive command response
    If Name <> "" Then
        gi = gi & Name
    End If
    
    'prefix stk generic macro tag and length
    If (Len(gi) / 2) > 255 Then '[256-65535]
        '3 byte representation
        gi = "2D" & "82" & Right("0" + Hex(Len(gi) / 2), 4) & gi
    Else
        If (Len(gi) / 2) > 127 And (Len(gi) / 2) <= 255 Then '[128-255]
            '2 byte representation
            gi = "2D" & "81" & Right("0" + Hex(Len(gi) / 2), 2) & gi
        Else
            If (Len(gi) / 2) < 128 Then
                '1 byte representation
                gi = "2D" & Right("0" + Hex(Len(gi) / 2), 2) & gi
            End If
        End If
    End If
    
    'put into bytecode array
    Dim j As Integer
    i = 1
    If Not ((Not thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode) = True) Then j = UBound(thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode) + 1
    While i < Len(gi)
        ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode(j)
        thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode(j) = "&H" & Mid(gi, i, 2)
        j = j + 1
        i = i + 2
    Wend
    
    gi = "[Deck" & CurrentDeckNo & "]" & " ---> " & "[Card" & CurrentCardNo & "]" & " ---> " & _
            "[Get Input] ---> " & gi
    j = 0
    If Not ((Not output) = True) Then j = UBound(output) + 1
    ReDim Preserve output(j)
    output(j) = gi

End Function
Public Function ProcessConcatenate(ByVal CurrentDeckNo As Integer, ByVal CurrentCardNo As Integer, _
                                ByVal CurrentScriptIndex As Integer, ByRef script() As String)
'eg of line to parsed
' <concatenate destvar="01" value="$02 abc $03 def">

Dim destvar As String
Dim value As String
Dim temp As String
Dim concat As String
Dim i As Integer

    i = InStr(1, script(CurrentScriptIndex), "destvar", vbTextCompare)
    If i > 0 Then
        i = i + 9
        destvar = destvar & Mid(script(CurrentScriptIndex), i, 2)
    End If
    i = InStr(1, script(CurrentScriptIndex), "value", vbTextCompare)
    If i > 0 Then
        i = i + 7
        While Mid(script(CurrentScriptIndex), i, 1) <> """"
            value = value & Mid(script(CurrentScriptIndex), i, 1)
            i = i + 1
        Wend
    End If

    i = 1 'search from the start of the line
    'loop through whole line
    While i <= Len(value)
        'loop through line until variable reference indicated by "$"
        If Mid(value, i, 1) = "$" Then
            If temp <> "" Then concat = concat & "0A" & Right("0" & Hex(Len(temp)), 2) & ToHex(temp)
            concat = concat & "08" & "01" & Mid(value, i + 1, 2)
            i = i + 3
            temp = ""
        Else
            temp = temp & Mid(value, i, 1)
            i = i + 1
        End If
    Wend
        
    If temp <> "" Then concat = concat & "0A" & Right("0" & Hex(Len(temp)), 2) & ToHex(temp)

    concat = "24" & Right("0" & Hex(Len(concat) / 2 + 1), 2) & destvar & concat

    
    'put into bytecode array
    Dim j As Integer
    i = 1
    If Not ((Not thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode) = True) Then j = UBound(thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode) + 1
    While i < Len(concat)
        ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode(j)
        thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode(j) = "&H" & Mid(concat, i, 2)
        j = j + 1
        i = i + 2
    Wend
    
    concat = "[Deck" & CurrentDeckNo & "] ---> " & "[Card" & CurrentCardNo & "] ---> " & _
                "[Concatenate] ---> " & concat
    i = 0
    If Not ((Not output) = True) Then i = UBound(output) + 1
    ReDim Preserve output(i)
    output(i) = concat
    
End Function
Public Function ProcessSetVar(ByVal CurrentDeckNo As Integer, ByVal CurrentCardNo 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" & Right("0" & Hex(templength), 2)
        thisSATEnv.DeckInfo(CurrentDeckNo).VarRefListLength(2) = "&H" & Mid(Hex(templength), 3, 2)
        initvar = "20" & "82" & Right("0" & Hex(templength), 2) & Mid(Hex(templength), 3, 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 bytecode array
    Dim j As Integer
    i = 1
    If Not ((Not thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode) = True) Then j = UBound(thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode) + 1
    While i < Len(initvar)
        ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode(j)
        thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode(j) = "&H" & Mid(initvar, i, 2)
        j = j + 1
        i = i + 2
    Wend
    
    initvar = "[Deck" & CurrentDeckNo & "] ---> " & "[Card" & CurrentCardNo & "] ---> " & _
                "[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 ProcessSetConstant(ByVal CurrentDeckNo As Integer, ByVal CurrentCardNo As Integer, _
                        ByRef CurrentScriptIndex As Integer, ByRef script() As String)
                                
'eg of line to be parsed
'<setconst name="c1" value="constant value1">
'<setconst name="c2" value="constant value2">
'<setconst name="c5" value="constant value3">
'</setconst>
Dim Name As String
Dim value As String
Dim constant As String

    While InStr(1, script(CurrentScriptIndex), "</setconst>", vbTextCompare) = 0
        'i = InStr(1, script(CurrentScriptIndex), "name", vbTextCompare)
        'If i > 0 Then
        '    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
        
        constant = constant & Right("0" & Hex(Len(ToHex(value)) / 2), 2) & ToHex(value)
        CurrentScriptIndex = CurrentScriptIndex + 1
    Wend
    
    thisSATEnv.DeckInfo(CurrentDeckNo).TxtEleTblTag = "&H04"
    
    'calculate the length for the text element section
    Dim templength As Integer
    templength = Len(constant) / 2
    If templength > 255 Then '[256-65535]
        '3 byte representation
        ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).TxtEleTblLength(2)
        thisSATEnv.DeckInfo(CurrentDeckNo).TxtEleTblLength(0) = "&H82" 'fixed
        thisSATEnv.DeckInfo(CurrentDeckNo).TxtEleTblLength(1) = "&H" & Right("0" & Hex(templength), 2)
        thisSATEnv.DeckInfo(CurrentDeckNo).TxtEleTblLength(2) = "&H" & Mid(Hex(templength), 3, 2)
    Else
        If templength > 127 And templength <= 255 Then '[128-255]
            '2 byte representation
            ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).TxtEleTblLength(1)
            thisSATEnv.DeckInfo(CurrentDeckNo).TxtEleTblLength(0) = "&H81" 'fixed
            thisSATEnv.DeckInfo(CurrentDeckNo).TxtEleTblLength(1) = "&H" & Mid(Hex(templength), 1, 2)
        Else
            If templength < 128 Then
                '1 byte representation
                ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).TxtEleTblLength(0)
                thisSATEnv.DeckInfo(CurrentDeckNo).TxtEleTblLength(0) = "&H" & Right("0" & Hex(templength), 2)
            End If
        End If
    End If

    'put into text element LV array