parse_satml.bas

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

                        "[Go Back] --- > " & goback
    i = 0
    If Not ((Not output) = True) Then i = UBound(output) + 1
    ReDim Preserve output(i)
    output(i) = goback

End Function


Public Function ProcessSetupCall(ByVal CurrentDeckNo As Integer, ByVal CurrentCardNo As Integer, _
                        ByRef CurrentScriptIndex As Integer, ByRef script() As String) As Integer
                        
'eg of line to parsed
'<setupcall sat-confirm="" sat-title="" sat-dest="" sat-cmdqual="" var-id="">

Dim confirm As String
Dim title As String
Dim dest As String
Dim cmdqlf As String
Dim varid As String
Dim setupcall As String

    i = InStr(1, script(CurrentScriptIndex), "sat-confirm", vbTextCompare)
    If i > 0 Then
        i = i + 13
            While Mid(script(CurrentScriptIndex), i, 1) <> """"
                confirm = confirm & Mid(script(CurrentScriptIndex), i, 1)
                i = i + 1
            Wend
    End If
    i = InStr(1, script(CurrentScriptIndex), "sat-title", vbTextCompare)
    If i > 0 Then
        i = i + 11
            While Mid(script(CurrentScriptIndex), i, 1) <> """"
                title = title & Mid(script(CurrentScriptIndex), i, 1)
                i = i + 1
            Wend
    End If
    i = InStr(1, script(CurrentScriptIndex), "sat-dest", vbTextCompare)
    If i > 0 Then
        i = i + 10
            While Mid(script(CurrentScriptIndex), i, 1) <> """"
                dest = dest & Mid(script(CurrentScriptIndex), i, 1)
                i = i + 1
            Wend
    End If
    i = InStr(1, script(CurrentScriptIndex), "sat-cmdqual", vbTextCompare)
    If i > 0 Then
        i = i + 13
        cmdqlf = Mid(script(CurrentScriptIndex), i, 2)
    End If
    i = InStr(1, script(CurrentScriptIndex), "var-id", vbTextCompare)
    If i > 0 Then
        i = i + 8
        varid = Mid(script(CurrentScriptIndex), i, 2)
    End If
    
    setupcall = "10" & cmdqlf & "82"
    
    If confirm <> "" Then
        'user confirmation phase
        setupcall = setupcall & "85" & Right("0" & Hex(Len(ToHex(confirm)) / 2), 2) & ToHex(confirm)
    End If
    
    'address
    setupcall = setupcall & "86" & Right("0" & Hex(Len(NibbleSwap(dest)) / 2), 2) & NibbleSwap(dest)
    
    'call setup phase
    setupcall = setupcall & "85" & Right("0" & Hex(Len(ToHex(title)) / 2), 2) & ToHex(title)
    
    If varid <> "" Then setupcall = setupcall & varid
    
    setupcall = "2D" & Right("0" & Hex(Len(setupcall) / 2), 2) & setupcall
    
    '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(setupcall)
        ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode(j)
        thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode(j) = "&H" & Mid(setupcall, i, 2)
        j = j + 1
        i = i + 2
    Wend
        
    setupcall = "[Deck" & CurrentDeckNo & "] ---> " & "[Card" & CurrentCardNo & "] ---> " & _
                        "[Setup Call] --- > " & setupcall
    i = 0
    If Not ((Not output) = True) Then i = UBound(output) + 1
    ReDim Preserve output(i)
    output(i) = setupcall
    
End Function

Public Function ProcessExit(ByVal CurrentDeckNo As Integer, ByVal CurrentCardNo As Integer, _
                        ByRef CurrentScriptIndex As Integer, ByRef script() As String) As Integer
                        
'eg of line to be parsed
'<satexit cleanbuf="true|false" outvarlist="a1b1c1d1e1f1">

Dim cleanbuf As String
Dim outvarlist As String
Dim satexit As String

cleanbuf = "false"

    i = InStr(1, script(CurrentScriptIndex), "cleanbuf", vbTextCompare)
    If i > 0 Then
        cleanbuf = ""
        i = i + 14
        While Mid(script(CurrentScriptIndex), i, 1) <> """"
            cleanbuf = cleanbuf & Mid(script(CurrentScriptIndex), i, 1)
            i = i + 1
        Wend
    End If
    i = InStr(1, script(CurrentScriptIndex), "outvarlist", vbTextCompare)
    If i > 0 Then
        i = i + 12
        While Mid(script(CurrentScriptIndex), i, 1) <> """"
            outvarlist = outvarlist & Mid(script(CurrentScriptIndex), i, 1)
            i = i + 1
        Wend
    End If
    
    If outvarlist <> "" Then satexit = "09" & Right("0" & Hex(Len(outvarlist) / 2), 2) & outvarlist
        
    
    If cleanbuf = "false" Then
        satexit = "2B" & Right("0" & Hex(Len(satexit) / 2), 2) & satexit
    Else
        satexit = "AB" & Right("0" & Hex(Len(satexit) / 2 + 1), 2) & "40" & satexit
    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(satexit)
        ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode(j)
        thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode(j) = "&H" & Mid(satexit, i, 2)
        j = j + 1
        i = i + 2
    Wend
    
    satexit = "[Deck" & CurrentDeckNo & "] ---> " & "[Card" & CurrentCardNo & "] ---> " & _
                        "[S@T Exit] --- > " & satexit
    i = 0
    If Not ((Not output) = True) Then i = UBound(output) + 1
    ReDim Preserve output(i)
    output(i) = satexit

End Function

Public Function ProcessExtract(ByVal CurrentDeckNo As Integer, ByVal CurrentCardNo 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).CardInfo(CurrentCardNo).ByteCode) = True) Then j = UBound(thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode) + 1
    While i < Len(extract)
        ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode(j)
        thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode(j) = "&H" & Mid(extract, i, 2)
        j = j + 1
        i = i + 2
    Wend
    
    extract = "[Deck" & CurrentDeckNo & "] ---> " & "[Card" & CurrentCardNo & "] ---> " & _
                        "[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 ProcessGetEnv(ByVal CurrentDeckNo As Integer, ByVal CurrentCardNo 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).CardInfo(CurrentCardNo).ByteCode) = True) Then j = UBound(thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode) + 1
    While i < Len(getenv)
        ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode(j)
        thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode(j) = "&H" & Mid(getenv, i, 2)
        j = j + 1
        i = i + 2
    Wend
    
    getenv = "[Deck" & CurrentDeckNo & "] ---> " & "[Card" & CurrentCardNo & "] ---> " & _
                        "[GetEnv] --- > " & getenv
    i = 0
    If Not ((Not output) = True) Then i = UBound(output) + 1
    ReDim Preserve output(i)
    output(i) = getenv
                        
End Function
Public Function ProcessSwitch(ByVal CurrentDeckNo As Integer, ByVal CurrentCardNo As Integer, _
                        ByVal CurrentScriptIndex As Integer, ByRef script() As String) As Integer
                        
'eg of line to parsed
'<switch varid="01" case="true|false" notfoundurl="11#01" method="get|post" sendreferer="true|false" resident="true|false" parameter="$10$11$12|test">
'<value="aaa" goto="11#02" method="get|post" sendreferer="true|false" resident="true|false" parameter="$10$11$12|test">
'<value="$02" goto="11#03">
'<value="bbb" goto="$03">
'</switch>

Dim varid As String
Dim casesensitive As String
Dim notfoundurl As String
Dim url As String
Dim value As String
Dim couplestruct As String
Dim method As String
Dim sendreferer As String
Dim resident As String
Dim attrib As Byte
Dim urlstruct As String
Dim notfoundurlstruct As String
Dim couplestructtlv As String

casesensitive = "true"


    While InStr(1, script(CurrentScriptIndex), "</switch>", vbTextCompare) = 0
        couplestruct = ""
    
        i = InStr(1, script(CurrentScriptIndex), "varid", vbTextCompare)
        If i > 0 Then
            i = i + 7
            varid = Mid(script(CurrentScriptIndex), i, 2)
        End If
        i = InStr(1, script(CurrentScriptIndex), "case", vbTextCompare)
        If i > 0 Then
            casesensitive = ""
            i = i + 6
            While Mid(script(CurrentScriptIndex), i, 1) <> """"
                casesensitive = casesensitive & Mid(script(CurrentScriptIndex), i, 1)
                i = i + 1
            Wend
        End If
        i = InStr(1, script(CurrentScriptIndex), "notfoundurl", vbTextCompare)
        If i > 0 Then
            notfoundurl = ""
            i = i + 13
            While Mid(script(CurrentScriptIndex), i, 1) <> """"
                notfoundurl = notfoundurl & 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
        i = InStr(1, script(CurrentScriptIndex), "goto", vbTextCompare)
        If i > 0 Then
            url = ""
            i = i + 6
            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)