main.frm

Here you have the Development Kit of SkyeTek Module M1. Contains a demo software and some interestin

    Call refresh_HostCommand_box
End Sub
Private Sub RID_box_Change()
    If invalidF = True Then
        RID_box.Text = temp
    End If
    
    Call refresh_HostCommand_box
End Sub
Private Sub RID_box_KeyPress(KeyAscii As Integer)
    temp = RID_box.Text
    invalidF = IsNotHex(KeyAscii)
End Sub
Private Sub TagType_Change()
    Call refresh_HostCommand_box
End Sub
Private Sub TagType_Click()
    
    TID_box.Enabled = True
    
    Select Case TagType.Text
        Case "00  Auto-Detect"
            tag_type = "00"
            TID_box.Text = ""
            TID_box.Enabled = False
        Case "01  ISO15693"
            tag_type = "01"
            TID_box.MaxLength = 16
            TID_box.Text = ""
        Case "02  I稢ode SL1"
            tag_type = "02"
            TID_box.MaxLength = 16
            TID_box.Text = ""
        Case "03  Tag-it HF"
            tag_type = "03"
            TID_box.MaxLength = 8
            TID_box.Text = ""
        Case "04  ISO14443A"
            tag_type = "04"
            TID_box.MaxLength = 8
            TID_box.Text = ""
        Case "06  PicoTag"
            tag_type = "06"
            TID_box.MaxLength = 16
            TID_box.Text = ""
        Case "08  GemWave C210"
            tag_type = "08"
            TID_box.MaxLength = 0
            TID_box.Text = ""
    End Select
    
Call CalcBlockLength
Call refresh_HostCommand_box
End Sub
Private Sub TID_box_Change()
    If invalidF = True Then
        TID_box.Text = temp
    End If
    
    Call CalcBlockLength
    Call refresh_HostCommand_box
End Sub
Private Sub TID_box_KeyPress(KeyAscii As Integer)
    temp = TID_box.Text
    invalidF = IsNotHex(KeyAscii)
End Sub
Private Sub STARTING_BLOCK_box_Change()
    If invalidF = True Then
        STARTING_BLOCK_box.Text = temp
    End If
    
    Call refresh_HostCommand_box
End Sub
Private Sub STARTING_BLOCK_box_KeyPress(KeyAscii As Integer)
    temp = STARTING_BLOCK_box.Text
    invalidF = IsNotHex(KeyAscii)
End Sub


Private Function CalcBlockLength()
' determine block length here
        CalcBlockLength = 2
             
        If Read_Bit.Value = True And Sys_Bit.Value = True Then
            CalcBlockLength = 6
        End If
        
        If Write_Bit.Value = True And Sys_Bit.Value = True Then
            If STARTING_BLOCK_box.Text = "0A" Or STARTING_BLOCK_box.Text = "0C" Then
                CalcBlockLength = 160
            End If
        End If
             
        Select Case TagType
            Case "03  Tag-it HF"
                CalcBlockLength = 8
        End Select

        If Len(TID_box.Text) = 16 Then
            CalcBlockLength = 8              ' 4 bytes per block
            If (Val("&H" & Mid(TID_box.Text, 3, 2)) = 5) Then
                CalcBlockLength = 16  ' 8 bytes per block for Infineon my-d tags
            End If
        End If
    
        If Len(TID_box.Text) = 8 Then
            CalcBlockLength = 8              ' 4 bytes per block
        End If
        
        If Len(NUMBER_OF_BLOCKS_box.Text) = 2 Then
            ' note the value (text) shown in the NUMBER_OF_BLOCKS_box must be interpreted as a hex value
            DATA_box.MaxLength = Val("&H" & Mid(NUMBER_OF_BLOCKS_box.Text, 1, 2)) * CalcBlockLength
        End If
        
    ' block length now determined
End Function

Private Sub NUMBER_OF_BLOCKS_box_Change()
    Dim BlockLength%
    
    If invalidF = True Then
        NUMBER_OF_BLOCKS_box.Text = temp
    End If
    
        
    Call CalcBlockLength
    Call refresh_HostCommand_box
End Sub
Private Sub NUMBER_OF_BLOCKS_box_KeyPress(KeyAscii As Integer)
    temp = NUMBER_OF_BLOCKS_box.Text
    invalidF = IsNotHex(KeyAscii)
End Sub
Private Sub DATA_box_Change()
    If invalidF = True Then
        DATA_box.Text = temp
    End If
    
    Call refresh_HostCommand_box
End Sub
Private Sub DATA_box_KeyPress(KeyAscii As Integer)
    temp = DATA_box.Text
    invalidF = IsNotHex(KeyAscii)
End Sub
Private Sub CRC_box_Change()
    If invalidF = True Then
        CRC_box.Text = temp
    End If
End Sub
Private Sub CRC_box_KeyPress(KeyAscii As Integer)
    temp = CRC_box.Text
    invalidF = IsNotHex(KeyAscii)
    Call refresh_HostCommand_box
End Sub
Private Sub btnExit_Click()
    mnuFileExit_Click
End Sub
Private Sub btnSendHostCommand_Click()
Dim i As Integer   'Loop Variable

    ' if the inventory comand is not yet complete (i.e. if it ends with <LF><94><LF>) then dont send another command
    If INV_F.Value = 1 Then
        freezeF = True
    End If
    
    Call refresh_HostCommand_box
    
    frmMain.MSComm1.InBufferCount = 0    ' clear buffer
                
    If protocolF = True Then
        ' Send Host command as ASCII
        If secondLF = False Then
            ' test here to see if the inventory command is complete
            ' i.e. if the host response box contains ends with either <LF>94<LF> in ascii mode
            ' if the host response box ends with <STX>94 in binary mode, then the inventory
            ' command (in which INV_F=1) is complete and thus it's ok to send this next command
            If Len(Response_box.Text) > 10 Then
                If Mid(Response_box.Text, (Len(Response_box.Text) - 11), 12) = ("<LF>94<LF>" + vbCrLf) Then
                    If INV_F.Value = 0 Then
                        Response_box.Text = ""
                    End If
                End If
            End If
        End If
    
        frmMain.MSComm1.Output = ""
        frmMain.MSComm1.Output = vbCr
        For i = 5 To (Len(HostCommand_box.Text) - 4)
            frmMain.MSComm1.Output = Mid(HostCommand_box.Text, i, 1)
        Next i
        frmMain.MSComm1.Output = vbCr
    Else
        If Len(Response_box.Text) > 7 Then
            If Mid(Response_box.Text, (Len(Response_box.Text) - 8), 9) = ("<STX>94" + vbCrLf) Then
                If INV_F.Value = 0 Then
                    Response_box.Text = ""
                End If
            End If
        End If
        ' Send Host command as Binary
        frmMain.MSComm1.Output = ""
        frmMain.MSComm1.Output = Chr$(2)
        
        For i = 6 To Len(HostCommand_box.Text) Step 2
            frmMain.MSComm1.Output = Chr$(Val("&H" & Mid(HostCommand_box.Text, i, 2)))
        Next i
    End If
End Sub
Private Sub mnuFileExit_Click()
    If (frmMain.MSComm1.PortOpen = True) Then
            frmMain.MSComm1.PortOpen = False
    End If
    Unload frmMain
End Sub
Sub refresh_COMMAND_box()
    Dim H$
    H$ = Hex(command%)
    COMMAND_box.Text = Left("00", 2 - Len(H$)) & H$
End Sub

Sub refresh_FLAGS_box()
    Dim H$
    H$ = Hex(flags%)
    FLAGS_box.Text = Left("00", 2 - Len(H$)) & H$
End Sub
Sub refresh_HostCommand_box()
    Dim byteCount As Integer
    Dim strByteCount As String

    If TID_F.Value = 0 Then
        TID_box.Text = ""
        TID_box.Enabled = False
    End If
    
    If COMMAND_box.Text = "14" Then
        STARTING_BLOCK_box.Text = ""
        NUMBER_OF_BLOCKS_box.Text = ""
        DATA_box.Text = ""
    End If
    
    If TagType.Enabled = False Then
        tag_type = ""
    Else
        TID_box.Enabled = True
        Select Case TagType.Text
            Case "00  Auto-Detect"
                tag_type = "00"
                TID_box.Text = ""
                TID_box.Enabled = False
            Case "01  ISO15693"
                tag_type = "01"
                TID_box.MaxLength = 16
            Case "02  I稢ode SL1"
                tag_type = "02"
                TID_box.MaxLength = 16
            Case "03  Tag-it HF"
                tag_type = "03"
                TID_box.MaxLength = 8
            Case "04  ISO14443A"
                tag_type = "04"
                TID_box.MaxLength = 8
            Case "06  PicoTag"
                tag_type = "06"
                TID_box.MaxLength = 16
            Case "08  GemWave C210"
                tag_type = "08"
                TID_box.MaxLength = 0
        End Select
    End If
    
    If protocolF = True Then     ' ascii mode
        HostCommand_box.Text = "<CR>" + FLAGS_box.Text + COMMAND_box.Text + RID_box.Text + tag_type + TID_box.Text + STARTING_BLOCK_box.Text + NUMBER_OF_BLOCKS_box.Text + DATA_box.Text
        If CRC_F.Value = 1 Then
            Call refresh_CRC_box
        End If
        HostCommand_box.Text = HostCommand_box.Text + CRC_box.Text + "<CR>"
    End If
    
    ' october 26 work-around
    If TagType.Enabled = False Then
        tag_type = ""
    End If
    
    If protocolF = False Then     ' binary mode
                
        If protocolv2 = True Then
            byteCount = (Len(FLAGS_box.Text) + Len(COMMAND_box.Text) + Len(RID_box.Text) + Len(tag_type) + Len(TID_box.Text) + Len(STARTING_BLOCK_box.Text) + Len(NUMBER_OF_BLOCKS_box.Text) + Len(DATA_box.Text)) / 2
            
            If CRC_F.Value = 1 Then
            byteCount = byteCount + 2
            End If
            
            strByteCount = Hex(byteCount)
            
            If (byteCount < 16) Then
                strByteCount = "0" + strByteCount
            End If
        Else
            strByteCount = ""
        End If
        
        HostCommand_box.Text = "<STX>" + strByteCount + FLAGS_box.Text + COMMAND_box.Text + RID_box.Text + tag_type + TID_box.Text + STARTING_BLOCK_box.Text + NUMBER_OF_BLOCKS_box.Text + DATA_box.Text
        If CRC_F.Value = 1 Then
            Call refresh_CRC_box
        End If
        HostCommand_box.Text = HostCommand_box.Text + CRC_box.Text
    End If
End Sub

Sub refresh_CRC_box()
Dim H$
Dim X As Integer, byteHL%
Dim i As Integer, j As Integer 'Loop Variables
Dim CRC_16 As Long
Const Poly As Long = 33800   ' Cannot use &H8404 due to bug in VB6 relating to sign extension?
                                                'Temp fix to bug would be &H8408 Xor &HFFFF0000. However this will fail if bug fixed.
    CRC_16 = 0
    If protocolF = True Then ' ASCII mode
        X = 5  ' ASCII Mode
    Else
        X = 6  ' Binary Mode
    End If
    
    For i = X To Len(HostCommand_box.Text) Step 2
        byteHL% = Val("&H" & Mid(HostCommand_box.Text, i, 2))
        ' byteHL% is the next byte to CRC
        CRC_16 = CRC_16 Xor byteHL%
        For j = 1 To 8
            If (CRC_16 And 1) Then
                CRC_16 = CRC_16 \ 2
                CRC_16 = (CRC_16 Xor Poly)
            Else
                CRC_16 = CRC_16 \ 2
            End If
        Next j
    Next i
    H$ = Hex(CRC_16)
    CRC_box.Text = Left("0000", 4 - Len(H$)) & H$
End Sub

Sub UpdateFlags()

    If Sel_Bit.Value = True Then
        
        If Tag_Bit.Value = True Then
            TID_F.Enabled = True
            RF_F.Enabled = True
            INV_F.Enabled = True
            LOOP_F.Enabled = True
            AFI_F.Enabled = True
            LOCK_F.Value = 0
            LOCK_F.Enabled = False
            flags% = flags% And &HFB    ' clears BIT2
        Else
            TID_F.Value = 0
            TID_F.Enabled = False
            RF_F.Value = 0
            RF_F.Enabled = False
            INV_F.Value = 0
            INV_F.Enabled = False
            LOOP_F.Value = 0
            LOOP_F.Enabled = False
            AFI_F.Value = 0
            AFI_F.Enabled = False
            LOCK_F.Value = 0
            LOCK_F.Enabled = False
            flags% = flags% And &HA0    ' clears BITs 0,1,2,3,4 and 6
        End If
    End If
    
    If Read_Bit.Value = True Then
    
        If Tag_Bit.Value = True Then
            'TID_F.Value = 0
            TID_F.Enabled = True
            'RF_F.Value = 0
            RF_F.Enabled = True
            INV_F.Value = 0
            INV_F.Enabled = False
            LOOP_F.Value = 0
            LOOP_F.Enabled = False
            AFI_F.Value = 0
            AFI_F.Enabled = False
            LOCK_F.Value = 0
            LOCK_F.Enabled = False
            flags% = flags% And &HE8    ' clears BITs 0,1,2 and 4
        Else
            TID_F.Value = 0
            TID_F.Enabled = False
            RF_F.Value = 0
            RF_F.Enabled = False
            INV_F.Value = 0
            INV_F.Enabled = False
            LOOP_F.Value = 0
            LOOP_F.Enabled = False
            AFI_F.Value = 0
            AFI_F.Enabled = False
            LOCK_F.Value = 0
            LOCK_F.Enabled = False
            flags% = flags% And &HA0    ' clears BITs 0,1,2,3,4 and 6
        End If
    End If
    
    If Write_Bit.Value = True Then
    
        If Tag_Bit.Value = True Then
            'TID_F.Value = 0
            TID_F.Enabled = True
            'RF_F.Value = 0
            RF_F.Enabled = True
            INV_F.Value = 0
            INV_F.Enabled = False
            LOOP_F.Value = 0
            LOOP_F.Enabled = False
            AFI_F.Value = 0
            AFI_F.Enabled = False
            'LOCK_F.Value = 0
            LOCK_F.Enabled = True
            flags% = flags% And &HEC    ' clears BITs 0,1,2 and 4
        Else
            TID_F.Value = 0
            TID_F.Enabled = False
            RF_F.Value = 0
            RF_F.Enabled = False
            INV_F.Value = 0
            INV_F.Enabled = False
            LOOP_F.Value = 0
            LOOP_F.Enabled = False
            AFI_F.Value = 0
            AFI_F.Enabled = False
            LOCK_F.Value = 0
            LOCK_F.Enabled = False
            flags% = flags% And &HA0    ' clears BITs 0,1,2,3,4 and 6
        End If
    
    End If
    
End Sub