main.frm

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

    On Error GoTo X:
    frmMain.MSComm1.PortOpen = True
    setcom = True
    'End Function
    
X:
    If frmMain.MSComm1.PortOpen = False Then
        setcom = False
    End If

End Function
Private Sub Form_Load()
 Dim result$

 'Disble 'X' button on form menu
 DeleteMenu GetSystemMenu(Me.hWnd, False), SC_CLOSE, MF_BYCOMMAND

   
 Call mnuBaudRate_show_Click
 
    ' Set default values
    flags% = 0
    command% = &H14
    secondLF = False
    freezeF = False
        
    NUMBER_OF_BLOCKS_box.Locked = False
    protocolF = True   ' ASCII mode
    stxF = False
    TagType.Text = TagType.List(0) ' Sets tag_type$ and forces call to refresh_HostCommand_box in TagType_Click
                
    'Update the Flags
    UpdateFlags
            
End Sub
Private Function detectReader()
 
 Dim Start As Single
 Dim baudrate As Integer
 Dim com As Integer
 Dim result$
 Dim X$ ' to clear unwanted responce characters
 
Do
    For com = 1 To 6
    'com$ = InputBox("Which COM port is the SkyeRead RFID reader attached to?", "Select COM Port", "")
        
        If frmMain.MSComm1.PortOpen = True Then
            frmMain.MSComm1.PortOpen = False
        End If
        
        frmMain.MSComm1.CommPort = com
        frmMain.MSComm1.InputLen = 1
        frmMain.MSComm1.RThreshold = 0  ' disble OnComm
        'frmMain.MSComm1.PortOpen = True
        If setcom() = True Then
            frmMain.MSComm1.InputMode = comInputModeText
        
            For baudrate = 0 To 3
                Select Case baudrate
                    Case 0
                        '9600
                        frmMain.MSComm1.Settings = "9600,N,8,1"
                
                    Case 1
                        ' 19200
                        frmMain.MSComm1.Settings = "19200,N,8,1"
                
                    Case 2
                        ' 38400
                        frmMain.MSComm1.Settings = "38400,N,8,1"
                
                    Case 3
                        ' 57600
                        frmMain.MSComm1.Settings = "57600,N,8,1"
                             
                End Select
                
                If frmMain.MSComm1.PortOpen = True Then
                    frmMain.MSComm1.Output = vbCr & "00220101" & vbCr  ' request the reader firmware version
                End If
                


                If GetResponse() = True Then
                    
                        fwverH$ = Mid$(response$, 4, 2)
                        fwverL$ = Mid$(response$, 6, 2)
                        
                        fwver$ = fwverH$
                        
                        If fwverL$ = vbCrLf Then
                            ' this must be firmware version 000D or lower so it has no serial number
                            fwver$ = "00" & fwverH$
                            serNum$ = "Not Available"
                            Exit Function
                        End If
                        
                        fwver$ = fwverH$ & fwverL$
            
                        If frmMain.MSComm1.PortOpen = True Then
                            frmMain.MSComm1.Output = vbCr & "00220001" & vbCr  ' get the reader serial number for fw versions > 0D
                        End If
                        
                        If GetResponse() = True Then
                            serNum$ = Mid$(response$, 4, 8)
                        Else
                            serNum$ = "Not Detected"
                        End If
    
                        Exit Function
                    
                    End If
                
            Next  ' baud rate loop
            
        End If
        
        If frmMain.MSComm1.PortOpen = True Then
            frmMain.MSComm1.PortOpen = False
        End If
              
    Next ' try the next com port
        
    result = MsgBox("No SkyeRead Device Detected ", vbAbortRetryIgnore, "SkyeRead Device")
Loop Until ((result = vbAbort) Or (result = vbIgnore))

If (result = vbAbort) Then
    End
End If

End Function


Private Sub mnuBaudRate_show_Click()
    Dim result
    Dim a$
    
    Call detectReader
    frmMain.MSComm1.RThreshold = 1  ' Enable OnComm again
    
    If frmMain.MSComm1.PortOpen = True Then
        result = MsgBox("Baud Rate = " & frmMain.MSComm1.Settings & vbCrLf & "Firmware Version = " & fwver$ & vbCrLf & "Serial Number = " & serNum$, vbOKOnly, "SkyeRead Device Information")
    Else
        result = MsgBox("No Reader Detected", vbOKOnly, "SkyeRead Device Information")
    End If
    
    If fwver$ > "001A" Then
        protocolv2 = True
    Else
        protocolv2 = False
    End If
        
End Sub

Private Sub MSComm1_OnComm()
Dim rx$
Dim H$
Dim Start As Single
        
    If protocolF = True Then
        If frmMain.MSComm1.InBufferCount Then
            rx$ = frmMain.MSComm1.Input
            
            If rx$ = vbCr Then
                
                ' let the follwing (expected) LF to come into the buffer before we look for it
                Start = Timer
                Do
                Loop Until (Timer - Start) > 0.001
                rx$ = frmMain.MSComm1.Input
                If rx$ = vbLf Then
                    ' end of response
                    Response_box.Text = (Response_box.Text + "<CR><LF>" + vbCrLf)
                End If
            Else
                If rx$ = vbLf Then ' Check for linefeed
                    ' LF detected so it's a new response coming in
                    If INV_F.Value <> 1 Then
                        Response_box.Text = "" ' Just clear
                    End If
                    Response_box.Text = Response_box.Text + "<LF>"  ' Accumulate inventory
                Else
                    Response_box.Text = Response_box.Text + rx$ ' Build up response
                End If
            End If
        End If
        ' here we test to see if the end of the sid poll has occurred by testing whether the end of the
        ' captured string equals "<LF>94<CR><LF>"
        If (INV_F.Value = 1) And (Len(Response_box.Text) > 30) Then
            If Right(Response_box.Text, 32) = ("<LF>94<CR><LF>" + vbCrLf + "<LF>94<CR><LF>" + vbCrLf) Then
                Response_box.Text = Left(Response_box.Text, Len(Response_box.Text) - 16)
                freezeF = False
            End If
        End If
    Else    ' Binary Mode
        If stxF = False Then   ' if this is the beginning of a STX response then display the ASCII STX
            If frmMain.MSComm1.InBufferCount Then
                stxF = True
                rx$ = frmMain.MSComm1.Input
                If rx$ = Chr$(2) Then
                    Response_box.Text = "<STX>"
                Else
                    Response_box.Text = "ERROR"
                End If
            End If
        Else
        ' stxF was true --> already got the STX so keep displaying incoming bytes (2 ascii chars per byte) until >20ms
            Start = Timer
            Do
                If frmMain.MSComm1.InBufferCount Then
                   Start = Timer
                    rx$ = frmMain.MSComm1.Input
                    H$ = Hex(Asc(rx$))
                    Response_box.Text = Response_box.Text & Left("00", 2 - Len(H$)) & H$
                End If
            Loop Until (Timer - Start) > 0.1
            stxF = False
        End If
    End If
End Sub



Private Sub RID_F_Click()
    If RID_F.Value = 1 Then
      flags% = flags% Or &H80     ' sets BIT7
      RID_box.Enabled = True
      RID_box.Text = "00"
    Else
      flags% = flags% And &H7F    ' clears BIT7
      RID_box.Enabled = False
      RID_box.Text = ""
    End If
    Call refresh_FLAGS_box
    Call refresh_HostCommand_box
End Sub
Private Sub TID_F_Click()
    If TID_F.Value = 1 Then
      flags% = flags% Or &H40     ' sets BIT6
      TID_box.Enabled = True
      
    Else
      flags% = flags% And &HBF    ' clears BIT6
      TID_box.Enabled = False
      TID_box.Text = ""
    End If
    
    Call CalcBlockLength
    Call refresh_FLAGS_box
    Call refresh_HostCommand_box
End Sub
Private Sub CRC_F_Click()
    If CRC_F.Value = 1 Then
      flags% = flags% Or &H20     ' sets BIT5
      CRC_box.Enabled = True
    Else
      flags% = flags% And &HDF    ' clears BIT5
      CRC_box.Enabled = False
      CRC_box.Text = ""
    End If
    
    Call refresh_FLAGS_box
    Call refresh_HostCommand_box
End Sub
Private Sub AFI_F_Click()
    If AFI_F.Value = 1 Then
        AFI_F.Value = 0
    End If
End Sub
Private Sub RF_F_Click()
    If RF_F.Value = 1 Then
      flags% = flags% Or &H8      ' sets BIT3
    Else
      flags% = flags% And &HF7    ' clears BIT3
    End If
    
   Call refresh_FLAGS_box
   Call refresh_HostCommand_box
End Sub
Private Sub LOCK_F_Click()
    If LOCK_F.Value = 1 Then
        flags% = flags% Or &H4   'sets BIT2
    Else
        flags% = flags% And &HFB 'clears BIT2
        'LOCK_F.Value = 0
    End If
    
    Call refresh_FLAGS_box
    Call refresh_HostCommand_box
    
'    If LOCK_F.Value = 1 Then
'        LOCK_F.Value = 0
'    End If

End Sub
Private Sub INV_F_Click()
    If Sel_Bit.Value = False Then
        INV_F.Value = 0
    End If
    
    If INV_F.Value = 1 Then
      flags% = flags% Or &H2       ' sets BIT1
    Else
      flags% = flags% And &HFD    ' clears BIT1
    End If
    
    Call refresh_FLAGS_box
    Call refresh_HostCommand_box
End Sub
Private Sub LOOP_F_Click()
    If LOOP_F.Value = 1 Then
      flags% = flags% Or &H1     ' sets BIT0
    Else
      flags% = flags% And &HFE    ' clears BIT0
    End If
    
   Call refresh_FLAGS_box
   Call refresh_HostCommand_box
End Sub
Private Sub Write_Bit_Click()

    'INV_F.Value = 0
    'INV_F.Enabled = False
    
    'flags% = flags% And &HFD    ' clears BIT1
    
    ' Update the Flags
    UpdateFlags
    
    STARTING_BLOCK_box.Enabled = True
    If STARTING_BLOCK_box.Text = "" Then
        STARTING_BLOCK_box.Text = "00"
    End If
    
    NUMBER_OF_BLOCKS_box.Enabled = True
    If NUMBER_OF_BLOCKS_box.Text = "" Then
        NUMBER_OF_BLOCKS_box.Text = "01"
    End If
        
    DATA_box.Enabled = True
    
    command% = command% And &HF  ' clears high nibble
    command% = command% Or &H40   ' sets high nibble to 0100
    
    Call CalcBlockLength
    Call refresh_COMMAND_box
    Call refresh_HostCommand_box
End Sub
Private Sub Read_Bit_Click()
    'INV_F.Value = 0
    'LOCK_F.Value = 0
    'flags% = flags% And &HFD    ' clears BIT1
    
    ' Update the flags
    UpdateFlags
    
    STARTING_BLOCK_box.Enabled = True
    If STARTING_BLOCK_box.Text = "" Then
        STARTING_BLOCK_box.Text = "00"
    End If
    
    NUMBER_OF_BLOCKS_box.Enabled = True
    If NUMBER_OF_BLOCKS_box.Text = "" Then
        NUMBER_OF_BLOCKS_box.Text = "01"
    End If
    
    If Sys_Bit.Value = True Then
        DATA_box.Text = ""
        DATA_box.Enabled = True
        DATA_box.MaxLength = 6
    Else
        DATA_box.Text = ""
        DATA_box.Enabled = False
    End If
    
    command% = command% And &HF  ' clears high nibble
    command% = command% Or &H20   ' sets high nibble to 0010
    
    Call CalcBlockLength
    Call refresh_COMMAND_box
    Call refresh_HostCommand_box
End Sub
Private Sub Sel_Bit_Click()
    'LOCK_F.Value = 0
    
    ' Update the Flags
    UpdateFlags
    
    STARTING_BLOCK_box.Enabled = False
    STARTING_BLOCK_box.Text = ""
    NUMBER_OF_BLOCKS_box.Enabled = False
    NUMBER_OF_BLOCKS_box.Text = ""
    
    If Tag_Bit.Value = True Then
        DATA_box.Enabled = False
        DATA_box.Text = ""
    End If
    
    command% = command% And &HF  ' clears high nibble
    command% = command% Or &H10   ' sets high nibble to 0001
    
    Call CalcBlockLength
    Call refresh_COMMAND_box
    Call refresh_HostCommand_box
End Sub
Private Sub Tag_Bit_Click()
    ' Update the Flags
    UpdateFlags
    
    TagType.Text = TagType.List(0)
    TagType.Enabled = True
    
    command% = command% And &HF0 ' clears low nibble
    command% = command% Or &H4   ' sets low nibble to 0100
    
    Call CalcBlockLength
    Call refresh_COMMAND_box
    Call refresh_HostCommand_box
End Sub
Private Sub Sys_Bit_Click()
    ' Update the Flags
    UpdateFlags
    
    TagType.Enabled = False
    
    command% = command% And &HF0 ' clears low nibble
    command% = command% Or &H2   ' sets low nibble to 0010
    
    Call refresh_COMMAND_box
    Call refresh_HostCommand_box
End Sub
Private Sub Mem_Bit_Click()
    ' Update the Flags
    UpdateFlags
    
    TagType.Enabled = False
    
    command% = command% And &HF0 ' clears low nibble
    command% = command% Or &H1   ' sets low nibble to 0001
    
    Call refresh_COMMAND_box