generic_functions.bas

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

Attribute VB_Name = "Generic_Functions"

Public Type card
    Tag As Byte '0x05
    length() As Byte
    Attribute As Byte
    ID As Byte
    IDLength As Byte
    IDValue() As Byte
    ByteCode() As Byte 'a card can contain n set(s) of commands -> dynamic array
End Type

Public Type deck
    Tag As Byte '0x01
    length() As Byte
    Attribute As Byte
    
    'deck id
    ID As Byte '0x02
    IDLength As Byte
    IDValue() As Byte
    
    'service permanent store
    SPSTag As Byte '0x03
    SPSLength As Integer
    SPSValue() As Byte 'byte array
    
    'cleanup variable list element
    VarRefListTag As Byte '0x09
    VarRefListLength() As Byte
    varid() As Byte 'all the variables ID to be cleanup
    
    'text element table
    TxtEleTblTag As Byte '0x04
    TxtEleTblLength() As Byte
    TxtEleLV() As Byte 'byte array
    
    'card template
    TemplateTag As Byte '0x07
    TemplateLength() As Byte
    TemplateByteCode() As Byte
    
    'card
    CardInfo() As card 'a deck can contain n cards -> dynamic array
    
    'properties of attribute byte for this deck
    'DCS As String 'sms|ucs2
    'VarStorageType As String 'static|dynamic
    
    'HelpText As String
End Type

Public Type SATEnvironment
    DeckInfo() As deck 'a S@T environment can contain n decks -> dynamic array
End Type

Public thisSATEnv As SATEnvironment 'instantiate the S@T environment
Public output() As String 'used for outputing to the screen
Public APDU() As String


Private Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long
Private Const EM_GETLINECOUNT = &HBA
'Public Function StoreLength(ByVal Length As Integer, ByRef TargetArray() As Byte)
'
'    If Length > 255 Then '[256-65535]
'        '3 byte representation
'        ReDim Preserve TargetArray(2)
'        TargetArray(0) = "&H82" 'fixed
'        TargetArray(1) = "&H" & Mid(hexcardlength, 1, 2)
'        TargetArray(2) = "&H" & Mid(hexcardlength, 3, 2)
'        cardlength = cardlength + 3
'        card = card & "82" & Mid(hexcardlength, 1, 2) & Mid(hexcardlength, 3, 2)
'    Else
'        If Length > 127 And Length <= 255 Then '[128-255]
'            '2 byte representation
'            ReDim Preserve TargetArray(1)
'            TargetArray(0) = "&H81" 'fixed
'            TargetArray(1) = "&H" & Mid(hexcardlength, 1, 2)
'            cardlength = cardlength + 2
'            card = card & "81" & Mid(hexcardlength, 1, 2)
'        Else
'            If Length < 128 Then
'                '1 byte representation
'                ReDim Preserve TargetArray(0)
'                TargetArray(0) = "&H" & Mid(hexcardlength, 1, 2)
'                cardlength = cardlength + 1
'                card = card & Mid(hexcardlength, 1, 2)
'            End If
'        End If
'    End If
'
'End Function


Public Function InitSATEnvironment(ByVal CurrentDeckNo As Integer)
    'CurrentDeckNo = CurrentDeckNo - 1 'default lower bound for array = 0
    
    ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo) 'create this deck
    
    'thisSATEnv.DeckInfo(CurrentDeckNo).DCS = "sms"   'default value
    'thisSATEnv.DeckInfo(CurrentDeckNo).VarStorageType = "static" 'default value
    'thisSATEnv.HelpText = ""
        
    thisSATEnv.DeckInfo(CurrentDeckNo).SPSTag = "&HFF" 'deck optional field set to 0xFF during init
    thisSATEnv.DeckInfo(CurrentDeckNo).VarRefListTag = "&HFF" 'deck optional field set to 0xFF during init
    thisSATEnv.DeckInfo(CurrentDeckNo).TxtEleTblTag = "&HFF"  'deck optional field set to 0xFF during init
    thisSATEnv.DeckInfo(CurrentDeckNo).TemplateTag = "&HFF"   'deck optional field set to 0xFF during init
        
    
End Function

Public Function InitCard(ByVal CurrentDeckNo As Integer, ByVal CurrentCardNo As Integer)
    
    ReDim Preserve thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo) 'create current number card
    thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).Tag = "&HFF" 'card mandatory field
    thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).Attribute = &H0
    'init card id optional element
    thisSATEnv.DeckInfo(CurrentDeckNo).CardInfo(CurrentCardNo).ID = "&HFF"
    
End Function
Public Function NibbleSwap(ByVal Target As String) As String

Dim i As Integer
Dim temp As String
Dim result As String
Dim ton As String
i = 1

    If Mid(Target, 1, 1) = "+" Then
        ton = Mid(Target, 1, 1)
        Target = Mid(Target, 2, Len(Target))
    End If
    
    While i <= Len(Target)
        temp = Mid(Target, i, 2)
        If Len(temp) = 1 Then temp = temp & "F"
        result = result & Mid(temp, 2, 1) & Mid(temp, 1, 1)
        i = i + 2
    Wend
    
    If ton = "+" Then
        result = "91" & result
    Else
        result = "81" & result
    End If

NibbleSwap = result

End Function

Public Function ToHex(ByVal sTeks As String) As String
'Purpose :  To convert any string into a sequence of characters that represent it's ASCII value"
            
    Dim i As Integer
    Dim sResult As String
    Dim sTemp As String
    
    For i = 1 To Len(sTeks)
        sTemp = Hex(asc(Mid$(sTeks, i, 1)))
        If Len(sTemp) = 1 Then
            sTemp = "0" & sTemp 'if it's a single hex character then concate with "0"
        End If
        sResult = sResult & sTemp
    Next i
    ToHex = sResult
End Function
Public Function NoOfLines(ByRef txtBox As TextBox) As Long
   On Error Resume Next
   NoOfLines = SendMessage(txtBox.hwnd, EM_GETLINECOUNT, 0&, ByVal 0&)
   On Error GoTo 0
End Function
Public Function GetLineText(txtBox As TextBox, lLine As Long) As String
Dim x As Long
Dim sText As String     ' Holds Textbox Text
Dim lLineStart As Long  ' Chr That Begins Line
Dim lLineEnd As Long     ' Chr That Ends Line
Dim lLength As Long      ' Length of line
sText = txtBox.Text

' We need to make sure that the text ends in a
' vbCrlf so...

If Right$(sText, 2) <> vbCrLf Then
    sText = sText & vbCrLf
End If

' If you want the first line of the textbox you
' know that the first character of the line
' will be the first character of the TextBox.

If lLine = 1 Then
    lLineStart = 1
Else

' If it isn't line 1 then we must find the first
' character of the line.  We know that each line
' is seperated by a vbCrLf (carriage return and
' line feed). So to find the second line starting
' position we find the 1st vbCrLf.  And to find
' the end of the second line we find the 3rd
' vbCrLf.

' This next little bit of code finds each vbCrlf
' up to (lLine - 1) which is the one that we need.

    lLineStart = 1  ' Initialize Offset
    For x = 1 To lLine - 1
    lLineStart = InStr(lLineStart, sText, vbCrLf)

    ' Compensate for the 2 characters in vbCrLf
    lLineStart = lLineStart + 2
    Next x
End If

' Now we need to find the end of the line.  We
' know that it is the very next vbCrLf after
' lLineStart, so...

lLineEnd = InStr(lLineStart, sText, vbCrLf)

' Get Line Length
lLength = lLineEnd - lLineStart
    
' Now we have the starting and ending characters
' for the line that we are trying to find.  Do
' you remember the Mid$ statement from the
' previous article..?

GetLineText = Mid$(sText, lLineStart, lLength)
End Function

Public Function ByteCodeToAPDU(ByVal hexvalue As String)

Dim i As Integer
Dim j As Integer
Dim p1 As Byte
Dim p2 As Byte
Dim p3 As Integer
Dim length As Integer
Dim original_len As Integer

hexvalue = Mid(hexvalue, 33, Len(hexvalue))

If Len(hexvalue) <= 400 Then
    If Not ((Not APDU) = True) Then j = UBound(APDU) + 1
    ReDim Preserve APDU(j)
    p3 = Right("0" & ToHex(Len(hexvalue) / 2), 2)
    p1 = &H0
    p2 = &H0
    APDU(j) = "A0D6" & Right("0" & Hex(p1), 2) & Right("0" & Hex(p2), 2) & Hex(p3) & hexvalue
Else
    length = Len(hexvalue)
    original_len = length
    i = 1
    While i <= original_len
        If Not ((Not APDU) = True) Then j = UBound(APDU) + 1
        ReDim Preserve APDU(j)
        If length >= 400 Then
            APDU(j) = Mid(hexvalue, 1, 400)
            length = length - 400
            i = i + 400
            hexvalue = Mid(hexvalue, 401, length)
        Else
            APDU(j) = Mid(hexvalue, 1, length)
            i = i + length
        End If
    Wend
End If

Dim p1p2 As Integer
p1p2 = 0


For i = 0 To UBound(APDU)
    p3 = (Len(APDU(i)) / 2)
    
    If p1p2 <= 255 Then
        APDU(i) = "A0D600" & Right("0" & Hex(p1p2), 2) & Right("0" & Hex(p3), 2) & APDU(i)
    Else
        APDU(i) = "A0D6" & Right("0" & Hex(p1p2), 4) & Right("0" & Hex(p3), 2) & APDU(i)
    End If
    
    p1p2 = p1p2 + p3
Next i

End Function

Public Function ProcessAllDecks(ByVal hexvalue As String) As String

Dim i As Integer
Dim k As Integer
Dim t As Integer
Dim r As Integer

t = 0
k = 0
j = 0
r = 0

'loop through all decks
For i = 0 To UBound(thisSATEnv.DeckInfo)
    hexvalue = hexvalue & Right("0" & Hex(thisSATEnv.DeckInfo(i).Tag), 2)
    For r = 0 To UBound(thisSATEnv.DeckInfo(i).length)
        hexvalue = hexvalue & Right("0" & Hex(thisSATEnv.DeckInfo(i).length(r)), 2)
    Next r
    If thisSATEnv.DeckInfo(i).Tag = "&H81" Then
        'concatenate attribute byte
        hexvalue = hexvalue & Right("0" & Hex(thisSATEnv.DeckInfo(i).Attribute), 2)
    End If
        
    'mandatory deck id element
    hexvalue = hexvalue & Right("0" + Hex(thisSATEnv.DeckInfo(i).ID), 2)
    hexvalue = hexvalue & Right("0" + Hex(thisSATEnv.DeckInfo(i).IDLength), 2)
    For r = 0 To UBound(thisSATEnv.DeckInfo(i).IDValue)
        hexvalue = hexvalue & Right("0" & Hex(thisSATEnv.DeckInfo(i).IDValue(r)), 2)
    Next r
    
    'optional element -> variable reference list tag
    If thisSATEnv.DeckInfo(i).VarRefListTag = "&H09" Then
        hexvalue = hexvalue & Right("0" & thisSATEnv.DeckInfo(i).VarRefListTag, 2)
        For r = 0 To UBound(thisSATEnv.DeckInfo(i).VarRefListLength)
            hexvalue = hexvalue & Right("0" & Hex(UBound(thisSATEnv.DeckInfo(CurrentDeckNo).varid) + 1), 2)
        Next r
        For r = 0 To UBound(thisSATEnv.DeckInfo(i).varid)
            hexvalue = hexvalue & Right("0" & Hex(thisSATEnv.DeckInfo(i).varid(r)), 2)
        Next r
    End If
    
    'optional element -> text element tag
    If thisSATEnv.DeckInfo(i).TxtEleTblTag = "&H04" Then
        hexvalue = hexvalue & Right("0" & thisSATEnv.DeckInfo(i).TxtEleTblTag, 2)
        For r = 0 To UBound(thisSATEnv.DeckInfo(i).TxtEleTblLength)
            hexvalue = hexvalue & Right("0" & Hex(thisSATEnv.DeckInfo(CurrentDeckNo).TxtEleTblLength(r)), 2)
        Next r
        For r = 0 To UBound(thisSATEnv.DeckInfo(i).TxtEleLV)
            hexvalue = hexvalue & Right("0" & Hex(thisSATEnv.DeckInfo(i).TxtEleLV(r)), 2)
        Next r
    End If
    
    'optional element -> card template tag
    If thisSATEnv.DeckInfo(i).TemplateTag = "&H07" Then
        hexvalue = hexvalue & Right("0" & thisSATEnv.DeckInfo(i).TemplateTag, 2)
        For r = 0 To UBound(thisSATEnv.DeckInfo(i).TemplateLength)
            hexvalue = hexvalue & Right("0" & Hex(thisSATEnv.DeckInfo(CurrentDeckNo).TemplateLength(r)), 2)
        Next r
        For r = 0 To UBound(thisSATEnv.DeckInfo(i).TemplateByteCode)
            hexvalue = hexvalue & Right("0" & Hex(thisSATEnv.DeckInfo(i).TemplateByteCode(r)), 2)
        Next r
    
    End If
    
    'loop through no.of cards
    For j = 0 To UBound(thisSATEnv.DeckInfo(i).CardInfo)
        hexvalue = hexvalue & Right("0" & Hex(thisSATEnv.DeckInfo(i).CardInfo(j).Tag), 2)
        For r = 0 To UBound(thisSATEnv.DeckInfo(i).CardInfo(j).length)
            hexvalue = hexvalue & Right("0" & Hex(thisSATEnv.DeckInfo(i).CardInfo(j).length(r)), 2)
        Next r
        If thisSATEnv.DeckInfo(i).CardInfo(j).Tag = "&H85" Then
            hexvalue = hexvalue & Right("0" & Hex(thisSATEnv.DeckInfo(i).CardInfo(j).Attribute), 2)
        End If
        If thisSATEnv.DeckInfo(i).CardInfo(j).ID <> "&HFF" Then
            hexvalue = hexvalue & Right("0" & Hex(thisSATEnv.DeckInfo(i).CardInfo(j).ID), 2)
            hexvalue = hexvalue & Right("0" & Hex(thisSATEnv.DeckInfo(i).CardInfo(j).IDLength), 2)
            For r = 0 To UBound(thisSATEnv.DeckInfo(i).CardInfo(j).IDValue)
                hexvalue = hexvalue & Right("0" & Hex(thisSATEnv.DeckInfo(i).CardInfo(j).IDValue(r)), 2)
            Next r
        End If
        'loop through all bytecode for this card
        For t = 0 To UBound(thisSATEnv.DeckInfo(i).CardInfo(j).ByteCode)
            hexvalue = hexvalue & Right("0" & Hex(thisSATEnv.DeckInfo(i).CardInfo(j).ByteCode(t)), 2)
        Next t
        
    Next j
    
Next i

ProcessAllDecks = hexvalue

End Function