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

📄 parse_satml.bas

📁 s@T卡脚本解析标准范例
💻 BAS
📖 第 1 页 / 共 5 页
字号:
    Dim j As Integer
    i = 1
    If Not ((Not thisSATEnv.DeckInfo(CurrentDeckNo).TxtEleLV) = True) Then j = UBound(thisSATEnv.DeckInfo(CurrentDeckNo).TxtEleLV) + 1
    While i < Len(constant)
        ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).TxtEleLV(j)
        thisSATEnv.DeckInfo(CurrentDeckNo).TxtEleLV(j) = "&H" & Mid(constant, i, 2)
        j = j + 1
        i = i + 2
    Wend
    
    constant = "[Deck" & CurrentDeckNo & "] ---> " & "[Card" & CurrentCardNo & "] ---> " & _
                "[Set Constant] ---> " & constant
    i = 0
    If Not ((Not output) = True) Then i = UBound(output) + 1
    ReDim Preserve output(i)
    output(i) = constant


End Function

Public Function ProcessGo(ByVal CurrentDeckNo As Integer, ByVal CurrentCardNo As Integer, _
                        ByRef CurrentScriptIndex As Integer, _
                            ByRef script() As String, ByVal deckpropertyindex As Integer, _
                                ByVal cardpropertyindex As Integer)
'eg of line to be parsed
'if title <> "" do a couple TLV
'<goselected href="[deckid]#[cardid]|$c1" title="$d1|this is the title1" alphaid="list of select items|$00" method="get|post" sendreferer="true|false" resident="true|false" parameter="$10$11$12|test" const="abc,def|ghi|jkl|">
'<goselected href="[deckid]#[cardid]|$c2" title="$d2|this is the title2" method="get|post" sendreferer="true|false" resident="true|false" parameter="$10$11$12|test" const="abc,def|ghi|jkl|">
'</go>

'if title="" do a direct go
'<goselected href="[deckid]#[cardid]|$c1" method="get|post" sendreferer="true|false" resident="true|false" parameter="$10$11$12|test" const="abc,def|ghi|jkl|">
'</go>
'OR
'<goselected href="[deckid]#[cardid]|$c1" parameter="$10$11$12|test" const="abc,def|ghi|jkl|">
'</go>

Dim href As String
Dim title As String
Dim go As String
Dim deckid As String
Dim cardid As String
Dim addref As String
Dim method As String
Dim sendreferer As String
Dim resident As String
Dim attrib As Byte
Dim urllength As Integer
Dim urlref As String
Dim coupletlv As String
Dim coupletlvstruct As String
Dim alphaid As String
Dim constant As String
Dim constanttlv As String
Dim parameter As String
Dim parametertlv As String

    While InStr(1, script(CurrentScriptIndex), "</go>", vbTextCompare) = 0
        method = "get" 'default values
        sendreferer = "false"
        resident = "false"
        attrib = "&H00"
        addref = ""
        deckid = ""
        cardid = ""
        urllength = 0
        urlref = ""
        coupletlv = ""
        constant = ""
        constanttlv = ""
        parameter = ""
        parametertlv = ""
        
        i = InStr(1, script(CurrentScriptIndex), "alphaid", vbTextCompare)
        If i > 0 Then
            alphaid = ""
            i = i + 9
                While Mid(script(CurrentScriptIndex), i, 1) <> """"
                    alphaid = alphaid & Mid(script(CurrentScriptIndex), i, 1)
                    i = i + 1
                Wend
        End If
        i = InStr(1, script(CurrentScriptIndex), "href", vbTextCompare)
        If i > 0 Then
            href = ""
            i = i + 6
            'href="#c1|$c1" $-variable reference, #-address reference
                While Mid(script(CurrentScriptIndex), i, 1) <> """"
                    href = href & Mid(script(CurrentScriptIndex), i, 1)
                    i = i + 1
                Wend
        End If
        i = InStr(1, script(CurrentScriptIndex), "title", vbTextCompare)
        If i > 0 Then
            title = ""
            i = i + 7
            While Mid(script(CurrentScriptIndex), i, 1) <> """"
                title = title & Mid(script(CurrentScriptIndex), i, 1)
                i = i + 1
            Wend
        End If
        i = InStr(1, script(CurrentScriptIndex), "method", vbTextCompare)
        If i > 0 Then
            method = ""
            i = i + 8
            While Mid(script(CurrentScriptIndex), i, 1) <> """"
                method = method & Mid(script(CurrentScriptIndex), i, 1)
                i = i + 1
            Wend
        End If
        i = InStr(1, script(CurrentScriptIndex), "sendreferer", vbTextCompare)
        If i > 0 Then
            sendreferer = ""
            i = i + 13
            While Mid(script(CurrentScriptIndex), i, 1) <> """"
                sendreferer = sendreferer & Mid(script(CurrentScriptIndex), i, 1)
                i = i + 1
            Wend
        End If
        i = InStr(1, script(CurrentScriptIndex), "resident", vbTextCompare)
        If i > 0 Then
            resident = ""
            i = i + 10
            While Mid(script(CurrentScriptIndex), i, 1) <> """"
                resident = resident & Mid(script(CurrentScriptIndex), i, 1)
                i = i + 1
            Wend
        End If
        i = InStr(1, script(CurrentScriptIndex), "const", vbTextCompare)
        If i > 0 Then
            constant = ""
            i = i + 7
            While Mid(script(CurrentScriptIndex), i, 1) <> """"
                constant = constant & Mid(script(CurrentScriptIndex), i, 1)
                i = i + 1
            Wend
        End If
        i = InStr(1, script(CurrentScriptIndex), "parameter", vbTextCompare)
        If i > 0 Then
            parameter = ""
            i = i + 11
            While Mid(script(CurrentScriptIndex), i, 1) <> """"
                parameter = parameter & Mid(script(CurrentScriptIndex), i, 1)
                i = i + 1
            Wend
        End If
        
        If method = "post" Then attrib = attrib Or "&H40"
        If sendreferer = "true" Then attrib = attrib Or "&H20"
        If resident = "true" Then attrib = attrib Or "&H10"

        If Mid(href, 1, 1) = "$" Then
            addref = "08" & "01" & Mid(href, 2, Len(href))
        Else
            'build url reference
            '-> address reference TLV
            addref = "0E" & Right("0" & Hex(Len(ToHex(href)) / 2), 2) & ToHex(href)
        End If
                
        If attrib <> "&H00" Then
            addref = Hex(attrib) & addref
        End If
                
        If constant <> "" Then
            Dim temp As String
            Dim comma As String
            i = 1
            While i <= Len(constant)
                If Mid(constant, i, 1) = "|" Then
                    If temp <> "" Then
                            comma = comma & "0A" & Right("0" & Hex(Len(temp) / 2), 2) & temp
                            'i = i + 1
                            temp = ""
                    End If
                    If comma <> "" Then
                        constanttlv = constanttlv & "0F" & Right("0" & Hex(Len(comma) / 2), 2) & comma
                        i = i + 1
                        comma = ""
                    End If
                Else
                    If Mid(constant, i, 1) = "," Then
                        If temp <> "" Then
                            comma = comma & "0A" & Right("0" & Hex(Len(temp) / 2), 2) & temp
                            i = i + 1
                            temp = ""
                        End If
                    Else
                        temp = temp & ToHex(Mid(constant, i, 1))
                        i = i + 1
                    End If
                End If
                
            Wend
            
        End If
            
            
        If parameter <> "" Then
            If Mid(parameter, 1, 1) = "$" Then
                i = 2
                While i < Len(parameter)
                    parametertlv = parametertlv & "0C" & "01" & Mid(parameter, i, 2)
                    i = i + 3
                Wend
            Else
                parametertlv = "0F" & Right("0" & Hex(Len(ToHex(parameter)) / 2), 2) & ToHex(parameter)
            End If
        End If
        
                
        'compute url length
        'If attrib <> "&H00" Then urllength = urllength + 1
        urllength = urllength + (Len(addref) / 2) + (Len(constanttlv) / 2) + (Len(parametertlv) / 2)
        If urllength < 128 Then
            urlref = Right("0" & Hex(urllength), 2) & addref & constanttlv & parametertlv
        Else
            urlref = "81" & Right("0" & Hex(urllength), 2) & addref & constanttlv & parametertlv
        End If
        
        'prefix url tag
        If attrib <> "&H00" Then
            urlref = "8D" & urlref
        Else
            urlref = "0D" & urlref
        End If
        
        If title <> "" Then
            'implies couple TLV, not a direct go thus do a select item
            'construct title element
            If Mid(title, 1, 1) = "$" Then
                title = Mid(title, 2, Len(title))
                'variable reference
                coupletlv = "08" & "01" & title
            Else
                title = Mid(title, 1, Len(title))
                'inline value
                coupletlv = "0A" & Right("0" & Hex(Len(title)), 2) & ToHex(title)
            End If
            
            'concatenate content 1 and content 2 for couple TLV
            coupletlvstruct = coupletlvstruct & 11 & Right("0" & Hex((Len(coupletlv) + Len(urlref)) / 2), 2) & coupletlv & urlref
        End If
        CurrentScriptIndex = CurrentScriptIndex + 1
    Wend
    
    If alphaid <> "" Then
        If Mid(alphaid, 1, 1) <> "$" Then
            'inline value element
            coupletlvstruct = "0A" & Right("0" & Hex(Len(ToHex(alphaid)) / 2), 2) & ToHex(alphaid) & coupletlvstruct
        Else
            'variable reference element
            coupletlvstruct = "08" & "01" & Mid(alphaid, 2, Len(alphaid)) & coupletlvstruct
        End If
    End If
        
        
            'format golength
            If (Len(coupletlvstruct) / 2) > 255 Then '[256-65535]
                '3 byte representation
                coupletlvstruct = "82" & Right("0" & Hex(Len(coupletlvstruct) / 2), 4) & coupletlvstruct
            Else
                If (Len(coupletlvstruct) / 2) > 127 And (Len(coupletlvstruct) / 2) <= 255 Then '[128-255]
                    '2 byte representation
                    coupletlvstruct = "81" & Right("0" & Hex(Len(coupletlvstruct) / 2), 2) & coupletlvstruct
                Else
                    If (Len(coupletlvstruct) / 2) < 128 Then
                        '1 byte representation
                        coupletlvstruct = Right("0" & Hex(Len(coupletlvstruct) / 2), 2) & coupletlvstruct
                    End If
                End If
            End If
        
            'prefix 0x29 go selected tag
            coupletlvstruct = "29" & coupletlvstruct
        
            '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(coupletlvstruct)
                ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode(j)
                thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode(j) = "&H" & Mid(coupletlvstruct, i, 2)
                j = j + 1
                i = i + 2
            Wend
        
            coupletlvstruct = "[Deck" & CurrentDeckNo & "] ---> " & "[Card" & CurrentCardNo & "] ---> " & _
                        "[Go Selected] --- > " & coupletlvstruct
            i = 0
            If Not ((Not output) = True) Then i = UBound(output) + 1
            ReDim Preserve output(i)
            output(i) = coupletlvstruct
        
End Function

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

'eg of line to be parsed
'<goback restartcurrentcard="true|false">
Dim restartcurrentcard As String
Dim goback As String

restartcurrentcard = "false"

    i = InStr(1, script(CurrentScriptIndex), "restartcurrentcard", vbTextCompare)
    If i > 0 Then
        restartcurrentcard = ""
        i = i + 20
            While Mid(script(CurrentScriptIndex), i, 1) <> """"
                restartcurrentcard = restartcurrentcard & Mid(script(CurrentScriptIndex), i, 1)
                i = i + 1
            Wend
    End If

    If restartcurrentcard = "true" Then
        goback = "A8" & "01" & "40"
    Else
        goback = "28" & "00"
    End If
    
    'set current card donothistorize flag
    thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).Attribute = &H20

    '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(goback)
        ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode(j)
        thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode(j) = "&H" & Mid(goback, i, 2)
        j = j + 1
        i = i + 2
    Wend
        
    goback = "[Deck" & CurrentDeckNo & "] ---> " & "[Card" & CurrentCardNo & "] ---> " & _

⌨️ 快捷键说明

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