parse_satml.bas

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

                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
        
        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 value <> "" Then
            If Mid(value, 1, 1) = "$" Then
                couplestruct = couplestruct & "08" & "01" & Mid(value, 2, Len(value))
            Else
                couplestruct = couplestruct & "0A" & Right("0" & Hex(Len(ToHex(value)) / 2), 2) & ToHex(value)
            End If
        End If
        
        
        If url <> "" Then
            If Mid(url, 1, 1) = "$" Then
                urlstruct = "08" & "01" & Mid(url, 2, Len(url))
            Else
                urlstruct = "0E" & Right("0" & Hex(Len(ToHex(url)) / 2), 2) & ToHex(url)
            End If
        
            If attrib = "&H00" Then
                urlstruct = "0D" & Right("0" & Hex(Len(urlstruct) / 2), 2) & urlstruct
            Else
                urlstruct = attrib & urlstruct
                urlstruct = "0D" & Right("0" & Hex(Len(urlstruct) / 2), 2) & urlstruct
            End If
        
            couplestructtlv = couplestructtlv & 11 & Right("0" & Hex((Len(couplestruct) + Len(urlstruct)) / 2), 2) & couplestruct & urlstruct
        End If
        
        CurrentScriptIndex = CurrentScriptIndex + 1
    Wend
    
    
    If notfoundurl <> "" Then
        If Mid(notfoundurl, 1, 1) = "$" Then
            notfoundurlstruct = "08" & "01" & Mid(notfoundurl, 2, Len(notfoundurl))
        Else
            notfoundurlstruct = "0E" & Right("0" & Hex(Len(ToHex(notfoundurl)) / 2), 2) & ToHex(notfoundurl)
        End If
        
        couplestructtlv = couplestructtlv & "0D" & Right("0" & Hex(Len(notfoundurlstruct) / 2), 2) & notfoundurlstruct
    End If
    
    couplestructtlv = varid & couplestructtlv
    
    If casesensitive = "false" Then couplestructtlv = "40" & couplestructtlv
    
    If (Len(couplestructtlv) / 2) > 255 Then '[256-65535]
        '3 byte representation
        couplestructtlv = "82" & Right("0" & Hex(Len(couplestructtlv) / 2), 4) & couplestructtlv
    Else
        If (Len(couplestructtlv) / 2) > 127 And (Len(couplestructtlv) / 2) <= 255 Then '[128-255]
            '2 byte representation
            couplestructtlv = "81" & Right("0" & Hex(Len(couplestructtlv) / 2), 2) & couplestructtlv
        Else
            If (Len(couplestructtlv) / 2) < 128 Then
                '1 byte representation
                couplestructtlv = Right("0" & Hex(Len(couplestructtlv) / 2), 2) & couplestructtlv
            End If
        End If
    End If
                        
    If casesensitive = "false" Then
        couplestructtlv = "AA" & couplestructtlv
    Else
        couplestructtlv = "2A" & couplestructtlv
    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(couplestructtlv)
        ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode(j)
        thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode(j) = "&H" & Mid(couplestructtlv, i, 2)
        j = j + 1
        i = i + 2
    Wend
    
    couplestructtlv = "[Deck" & CurrentDeckNo & "] ---> " & "[Card" & CurrentCardNo & "] ---> " & _
                        "[Switch Case] ---> " & couplestructtlv
    i = 0
    If Not ((Not output) = True) Then i = UBound(output) + 1
    ReDim Preserve output(i)
    output(i) = couplestructtlv
                        
End Function
Public Function ProcessInitVarSel(ByVal CurrentDeckNo As Integer, ByVal CurrentCardNo As Integer, _
                        ByVal CurrentScriptIndex As Integer, ByRef script() As String) As Integer
                        
'eg of line to parsed
'<initvarsel destvar="01" title="title|$02">
'<item="1111|$03" value="1111|$03">
'<item="2222|$04" value="2222|$04">
'<item="3333|$05" value="3333|$05">
'</initvarsel>

Dim destvar As String
Dim title As String
Dim item As String
Dim value As String
Dim couplestruct As String
Dim coupletlvstruct As String

    While InStr(1, script(CurrentScriptIndex), "</initvarsel>", vbTextCompare) = 0
        couplestruct = ""
        
        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), "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), "item", vbTextCompare)
        If i > 0 Then
            item = ""
            i = i + 6
            While Mid(script(CurrentScriptIndex), i, 1) <> """"
                item = item & Mid(script(CurrentScriptIndex), i, 1)
                i = i + 1
            Wend
        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
        
        If item <> "" Then
            If Mid(item, 1, 1) = "$" Then
                couplestruct = couplestruct & "08" & "01" & Mid(item, 2, Len(item))
            Else
                couplestruct = couplestruct & "0A" & Right("0" & Hex(Len(ToHex(item)) / 2), 2) & ToHex(item)
            End If
        End If
        
        If value <> "" Then
            If Mid(value, 1, 1) = "$" Then
                couplestruct = couplestruct & "08" & "01" & Mid(value, 2, Len(value))
            Else
                couplestruct = couplestruct & "0A" & Right("0" & Hex(Len(ToHex(value)) / 2), 2) & ToHex(value)
            End If
        End If
        
        If item <> "" And value <> "" Then _
            coupletlvstruct = coupletlvstruct & 11 & Right("0" & Hex(Len(couplestruct) / 2), 2) & couplestruct
        
        CurrentScriptIndex = CurrentScriptIndex + 1
    Wend
        
        If title <> "" Then
            If Mid(title, 1, 1) = "$" Then
                coupletlvstruct = "08" & "01" & Mid(title, 2, Len(title)) & coupletlvstruct
            Else
                coupletlvstruct = "0A" & Right("0" & Hex(Len(ToHex(title)) / 2), 2) & ToHex(title) & coupletlvstruct
            End If
        End If
        
        coupletlvstruct = destvar & coupletlvstruct
        
        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
        
        coupletlvstruct = "21" & 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 & "] ---> " & _
                        "[Init Var Select] ---> " & coupletlvstruct
        i = 0
        If Not ((Not output) = True) Then i = UBound(output) + 1
        ReDim Preserve output(i)
        output(i) = coupletlvstruct
End Function

Public Function ProcessMCMI(ByVal CurrentDeckNo As Integer, ByVal CurrentCardNo As Integer, _
                        ByVal CurrentScriptIndex As Integer, ByRef script() As String) As Integer
'eg of line to parsed
'<mcmi id="" remove="true|false">
'<item="1111" url="11#01" method="get|post" sendreferer="true|false" resident="true|false">
'<item="2222" url="11#02">
'<item="3333" url="11#03">
'</mcmi>

Dim ID As String
Dim remove As String
Dim item As String
Dim url As String
Dim method As String
Dim sendreferer As String
Dim resident As String
Dim couplestruct As String
Dim urlattrib As Byte
Dim coupletlvstruct As String

remove = "false"

    While InStr(1, script(CurrentScriptIndex), "</mcmi>", vbTextCompare) = 0
        i = InStr(1, script(CurrentScriptIndex), "id", vbTextCompare)
        If i > 0 Then
            i = i + 4
            ID = Mid(script(CurrentScriptIndex), i, 2)
        End If
        i = InStr(1, script(CurrentScriptIndex), "remove", vbTextCompare)
        If i > 0 Then
            remove = ""
            i = i + 8
            While Mid(script(CurrentScriptIndex), i, 1) <> """"
                remove = remove & Mid(script(CurrentScriptIndex), i, 1)
                i = i + 1
            Wend
        End If
        i = InStr(1, script(CurrentScriptIndex), "item", vbTextCompare)
        If i > 0 Then
            item = ""
            i = i + 6
            While Mid(script(CurrentScriptIndex), i, 1) <> """"
                item = item & Mid(script(CurrentScriptIndex), i, 1)
                i = i + 1
            Wend
        End If
        i = InStr(1, script(CurrentScriptIndex), "url", vbTextCompare)
        If i > 0 Then
            url = ""
            i = i + 5
            While Mid(script(CurrentScriptIndex), i, 1) <> """"
                url = url & 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
        
        If item <> "" Then
            If Mid(item, 1, 1) = "$" Then
                couplestruct = couplestruct & "08" & "01" & Mid(item, 2, Len(item))
            Else
                couplestruct = couplestruct & "0A" & Right("0" & Hex(Len(ToHex(item)) / 2), 2) & ToHex(item)
            End If
        End If
        
        If method = "post" Then urlattrib = urlattrib Or "&H40"
        If sendreferer = "true" Then urlattrib = urlattrib Or "&H20"
        If resident = "true" Then urlattrib = urlattrib Or "&H10"
        
        If url <> "" Then
            If Mid(url, 1, 1) = "$" Then
                urlstruct = "08" & "01" & Mid(url, 2, Len(url))
            Else
                urlstruct = "0E" & Right("0" & Hex(Len(ToHex(url)) / 2), 2) & ToHex(url)
            End If
        
            If urlattrib = "&H00" Then
                urlstruct = "0D" & Right("0" & Hex(Len(urlstruct) / 2), 2) & urlstruct
            Else
                urlstruct = urlattrib & urlstruct
                urlstruct = "0D" & Right("0" & Hex(Len(urlstruct) / 2), 2) & urlstruct
            End If
        
            coupletlvstruct = coupletlvstruct & 11 & Right("0" & Hex((Len(couplestruct) + Len(urls