parse_satml.bas

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

Attribute VB_Name = "Parse_SATML"
Public Function ProcessParagraph(ByVal CurrentDeckNo As Integer, ByVal CurrentCardNo As Integer, _
                                ByRef CurrentScriptIndex As Integer, ByRef script() As String)
Dim i As Integer
Dim satautoclear As String
Dim satprio As String
Dim dt As String
Dim cmdqlf As String
Dim varid As String
Dim tempdt As String
Dim concat As String

'eg of <p> to be parsed
'<p sat-auto-clr="true" sat-prio="high" varid="c1">

satautoclear = "false" 'default
satprio = "normal" 'default
dt = ""
'varid = "&HFF"

    While InStr(1, script(CurrentScriptIndex), "</p>", vbTextCompare) = 0
        i = InStr(1, script(CurrentScriptIndex), "sat-auto-clr", vbTextCompare)
        If i > 0 Then
            satautoclear = ""
            i = i + 14
            While Mid(script(CurrentScriptIndex), i, 1) <> """"
                satautoclear = satautoclear & Mid(script(CurrentScriptIndex), i, 1)
                i = i + 1
            Wend
        End If
        i = 0
        i = InStr(1, script(CurrentScriptIndex), "sat-prio", vbTextCompare)
        If i > 0 Then
            satprio = ""
            i = i + 10
            While Mid(script(CurrentScriptIndex), i, 1) <> """"
                satprio = satprio & Mid(script(CurrentScriptIndex), i, 1)
                i = i + 1
            Wend
        End If
        i = 0
        i = InStr(1, script(CurrentScriptIndex), "varid", vbTextCompare)
        If i > 0 Then
            i = i + 7
            varid = Mid(script(CurrentScriptIndex), i, 2)
        End If
        CurrentScriptIndex = CurrentScriptIndex + 1
        dt = Trim(script(CurrentScriptIndex)) 'remove spaces from left and right
        CurrentScriptIndex = CurrentScriptIndex + 1
    Wend
        
    'check if dt contains variable references => need to do concatenation + variable substitution
    'eg of line to be parsed -> hello $c1 World $c2
    i = InStr(1, dt, "$", vbTextCompare)
    If i > 0 Then
        If Len(dt) = 3 Then
            firstvar = Mid(dt, i + 1, 2)
        Else
            'there are variables references in this line of <p>
            i = 1 'search from the start of the line
            'loop through whole line
            While i <= Len(dt)
                'loop through line until variable reference indicated by "$"
                If Mid(dt, i, 1) = "$" Then
                    If tempdt <> "" Then concat = concat & "0A" & Right("0" & Hex(Len(tempdt)), 2) & ToHex(tempdt)
                    concat = concat & "08" & "01" & Mid(dt, i + 1, 2)
                    i = i + 3
                    tempdt = ""
                Else
                    tempdt = tempdt & Mid(dt, i, 1)
                    i = i + 1
                End If
            Wend
        
            If tempdt <> "" Then concat = concat & "0A" & Right("0" & Hex(Len(tempdt)), 2) & ToHex(tempdt)

            'to find the 1st variable used
            i = InStr(1, dt, "$", vbTextCompare)
            firstvar = Mid(dt, i + 1, 2)
            concat = "24" & Right("0" & Hex(Len(concat) / 2 + 1), 2) & firstvar & concat
        End If
    End If
    
    'variable dt to contain the text to display
    'variable satautoclear to contain property value
    'variable satprio to contain property value
    
    'DISPLAY TEXT,
    'bit 1:      0 = normal priority
    '            1 = high priority
    'bits 2-7:   = RFU
    'bit 8:      0 = clear message after a delay
    '            1 = wait for user to clear message
    
    'format command qualifer for dt
    Select Case satautoclear
        Case "false"
            Select Case satprio
                Case "normal"
                    cmdqlf = "80"
                Case "high"
                    cmdqlf = "81"
            End Select
        Case "true"
            Select Case satprio
                Case "normal"
                    cmdqlf = "00"
                Case "high"
                    cmdqlf = "01"
            End Select
    End Select
    
    'Type of command = 0x21
    
    'Destination device
    '82 = ME
    
    'prefix tag 0x8D = text string tag + length + DCS + value
    If concat <> "" Or firstvar <> "" Then
        dt = "21" & Right("0" & cmdqlf, 2) & "82" & "8D" & "FF" & firstvar
    Else
        dt = "21" & Right("0" & cmdqlf, 2) & "82" & "8D" & Right("0" + Hex(Len(dt) + 1), 2) & "04" & ToHex(dt)
    End If

    'check if varid has been set to value other than 0xFF
    If varid <> "" Then
        dt = dt & varid
    End If
    
    'prefix stk generic macro tag and length
    If (Len(dt) / 2) > 255 Then '[256-65535]
        '3 byte representation
        dt = "2D" & "82" & Right("0" + Hex(Len(dt) / 2), 4) & dt
    Else
        If (Len(dt) / 2) > 127 And (Len(dt) / 2) <= 255 Then '[128-255]
            '2 byte representation
            dt = "2D" & "81" & Right("0" + Hex(Len(dt) / 2), 2) & dt
        Else
            If (Len(dt) / 2) < 128 Then
                '1 byte representation
                dt = "2D" & Right("0" + Hex(Len(dt) / 2), 2) & dt
            End If
        End If
    End If
    
    If concat <> "" Then dt = concat & dt
    
    'insert into bytecode structure for this current deck this current card
    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(dt)
        ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode(j)
        thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode(j) = "&H" & Mid(dt, i, 2)
        j = j + 1
        i = i + 2
    Wend
    
    'output concat to bytecode textbox
    If concat <> "" Then
        concat = "[Deck" & CurrentDeckNo & "]" & " ---> " & "[Card" & CurrentCardNo & "]" & " ---> " & "[Concatenate] ---> " & concat
        j = 0
        If Not ((Not output) = True) Then j = UBound(output) + 1
        ReDim Preserve output(j)
        output(j) = concat
    End If
    
    'output to bytecode textbox
    dt = "[Deck" & CurrentDeckNo & "]" & " ---> " & "[Card" & CurrentCardNo & "]" & " ---> " & "[Display Text] ---> " & dt
    j = 0
    If Not ((Not output) = True) Then j = UBound(output) + 1
    ReDim Preserve output(j)
    output(j) = dt
    
End Function
Public Function ProcessSMS(ByVal CurrentDeckNo As Integer, ByVal CurrentCardNo As Integer, _
                            ByRef CurrentScriptIndex As Integer, ByRef script() As String)
'eg of line to parsed
'<sms cmdqlf="" alphaid="" servcc="" destno="" dcs="" varid="">
'this is a test sms|$00
'</sms>

Dim cmdqlf As String
Dim alphaid As String
Dim servcc As String
Dim destno As String
Dim dcs As String
Dim varid As String
Dim sms As String
Dim tpdu As String
Dim convdestno As String
Dim smsc As String
Dim tosend As String
    
    While InStr(1, script(CurrentScriptIndex), "</sms>", vbTextCompare) = 0
        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
        i = 0
        i = InStr(1, script(CurrentScriptIndex), "alphaid", vbTextCompare)
        If i > 0 Then
            i = i + 9
            While Mid(script(CurrentScriptIndex), i, 1) <> """"
                alphaid = alphaid & Mid(script(CurrentScriptIndex), i, 1)
                i = i + 1
            Wend
        End If
        i = 0
        i = InStr(1, script(CurrentScriptIndex), "servcc", vbTextCompare)
        If i > 0 Then
            i = i + 8
            While Mid(script(CurrentScriptIndex), i, 1) <> """"
                servcc = servcc & Mid(script(CurrentScriptIndex), i, 1)
                i = i + 1
            Wend
        End If
        i = 0
        i = InStr(1, script(CurrentScriptIndex), "destno", vbTextCompare)
        If i > 0 Then
            i = i + 8
            While Mid(script(CurrentScriptIndex), i, 1) <> """"
                destno = destno & Mid(script(CurrentScriptIndex), i, 1)
                i = i + 1
            Wend
        End If
        i = 0
        i = InStr(1, script(CurrentScriptIndex), "dcs", vbTextCompare)
        If i > 0 Then
            i = i + 5
            While Mid(script(CurrentScriptIndex), i, 1) <> """"
                dcs = dcs & Mid(script(CurrentScriptIndex), i, 1)
                i = i + 1
            Wend
        End If
        i = 0
        i = InStr(1, script(CurrentScriptIndex), "varid", vbTextCompare)
        If i > 0 Then
            i = i + 7
            While Mid(script(CurrentScriptIndex), i, 1) <> """"
                varid = varid & Mid(script(CurrentScriptIndex), i, 1)
                i = i + 1
            Wend
        End If
        CurrentScriptIndex = CurrentScriptIndex + 1
        tosend = Trim(script(CurrentScriptIndex)) 'remove spaces from left and right
        CurrentScriptIndex = CurrentScriptIndex + 1
    Wend

    '83=network
    sms = "13" & cmdqlf & "83"
    
    If alphaid <> "" Then _
        sms = sms & "85" & Right("0" & Hex(Len(ToHex(alphaid)) / 2), 2) & ToHex(alphaid)
    
    'insert service center address
    If servcc <> "" Then _
        sms = sms & "86" & Right("0" & Hex(Len(NibbleSwap(servcc)) / 2), 2) & NibbleSwap(servcc)
    
    convdestno = NibbleSwap(destno)
    'sms-submit + TP-MR + Dest. Addr + PID + DCS + TP-VP
    tpdu = "11" & "00" & Right("0" & Hex(Len(convdestno) / 2), 2) & convdestno & "00" & dcs & "08"
    
    i = 0
    i = InStr(1, tosend, "$", vbTextCompare)
    If i > 0 Then
        tosend = Mid(tosend, i + 1, 2)
        tpdu = tpdu & "FF" & tosend
    Else
        tpdu = tpdu & Right("0" & Hex(Len(ToHex(tosend)) / 2), 2) & ToHex(tosend)
    End If
    
    tpdu = "8B" & Right("0" & Hex(Len(tpdu) / 2), 2) & tpdu

    If varid <> "" Then tpdu = tpdu & varid
    
    sms = sms & tpdu
    
    'prefix stk generic macro tag and length
    If (Len(sms) / 2) > 255 Then '[256-65535]
        '3 byte representation
        sms = "2D" & "82" & Right("0" + Hex(Len(sms) / 2), 4) & sms
    Else
        If (Len(sms) / 2) > 127 And (Len(sms) / 2) <= 255 Then '[128-255]
            '2 byte representation
            sms = "2D" & "81" & Right("0" + Hex(Len(sms) / 2), 2) & sms
        Else
            If (Len(sms) / 2) < 128 Then
                '1 byte representation
                sms = "2D" & Right("0" + Hex(Len(sms) / 2), 2) & sms
            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(sms)
        ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode(j)
        thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ByteCode(j) = "&H" & Mid(sms, i, 2)
        j = j + 1
        i = i + 2
    Wend
    
    sms = "[Deck" & CurrentDeckNo & "]" & " ---> " & "[Card" & CurrentCardNo & "]" & " ---> " & _
            "[Send Short Message] ---> " & sms
    j = 0
    If Not ((Not output) = True) Then j = UBound(output) + 1
    ReDim Preserve output(j)
    output(j) = sms
    
    

End Function


Public Function ProcessInput(ByVal CurrentDeckNo As Integer, ByVal CurrentCardNo As Integer, _
                            ByRef CurrentScriptIndex As Integer, ByRef script() As String)
'eg of line to be parsed
'<input title="alphaid" name="c1" value="default value" min="1" max="10" cmdqlf="01">
Dim title As String
Dim Name As String
Dim value As String
Dim min As String
Dim max As String
Dim cmdqlf As String
Dim gi As String

    i = InStr(1, script(CurrentScriptIndex), "title", vbTextCompare)
    If i > 0 Then
        i = i + 7