parse_template.bas

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

    
    getenv = "[Deck" & CurrentDeckNo & " Template] ---> " & "[Get Env.Var] ---> " & getenv
    i = 0
    If Not ((Not output) = True) Then i = UBound(output) + 1
    ReDim Preserve output(i)
    output(i) = getenv
                        
End Function

Public Function ProcessTemplateConcatenate(ByVal CurrentDeckNo 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).TemplateByteCode) = True) _
        Then j = UBound(thisSATEnv.DeckInfo(CurrentDeckNo).TemplateByteCode) + 1
    While i < Len(concat)
        ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).TemplateByteCode(j)
        thisSATEnv.DeckInfo(CurrentDeckNo).TemplateByteCode(j) = "&H" & Mid(concat, 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
    
    
    concat = "[Deck" & CurrentDeckNo & " Template] ---> " & "[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 ProcessTemplateMCMI(ByVal CurrentDeckNo As Integer, _
                                ByVal CurrentScriptIndex As Integer, ByRef script() As String)
'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(urlstruct)) / 2), 2) & couplestruct & urlstruct
        End If
        
        CurrentScriptIndex = CurrentScriptIndex + 1
    Wend
        
    coupletlvstruct = ID & coupletlvstruct
    
    If remove = "true" Then
        coupletlvstruct = "40" & coupletlvstruct
        coupletlvstruct = "AC" & Right("0" & Hex(Len(coupletlvstruct) / 2), 2) & coupletlvstruct
    Else
        coupletlvstruct = "2C" & Right("0" & Hex(Len(coupletlvstruct) / 2), 2) & coupletlvstruct
    End If

    '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(coupletlvstruct)
        ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).TemplateByteCode(j)
        thisSATEnv.DeckInfo(CurrentDeckNo).TemplateByteCode(j) = "&H" & Mid(coupletlvstruct, 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
    
    
    
    
    
    
    coupletlvstruct = "[Deck" & CurrentDeckNo & " Template] ---> " & "[MCMI] ---> " & coupletlvstruct
    i = 0
    If Not ((Not output) = True) Then i = UBound(output) + 1
    ReDim Preserve output(i)
    output(i) = coupletlvstruct
    
End Function