form1.frm

M8演示程序

        Else
            ' Check the tag type
            If protocolv2 = True Then
                typeOfTag = Mid(Response$, 4, 2)
                If typeOfTag > "03" Then
                    Call setStatus("No Read/Write Support for Tag")
                    Call setStatus("Waiting for Command")
                    Exit Sub
                End If
            End If
                        
            ' Setup the Starting Block and Number of Blocks
            ' and also the number of bytes supported by the tag etc.
            setBytesAndBlocksInfo
                
        End If
        
              
        Call setStatus("Writing...")
        
        If Len(textbox_Write) > MaxNumBytes Then
            result = MsgBox("Data Length Exceeds Tag Size!" & vbCrLf & "Proceed?", vbOKCancel, "Tag Size Exceeded")
            If result = vbOK Then
                byteCount = textbox_Write.MaxLength
                textbox_Write.MaxLength = MaxNumBytes
                textbox_Write.Text = textbox_Write
                textbox_Write.MaxLength = byteCount
                'textbox_Write.Text = textbox_Write & " [Tag Size Exceeded]"
            Else
                Call setStatus("Waiting for Command")
                Exit Sub
            End If
        End If
        
        flags = "68" ' set the TID_F and the CRC_F and the RF_F
        
        tag_block_index = 0
        
        bytesWritten = 0
        
        Do While bytesWritten < MaxNumBytes
            startBlock$ = Hex(StartingBlock)
            
            numTries = 0

            StartingBlock = StartingBlock + 1   ' Increment to the Next Block
            
            If Len(startBlock$) = 1 Then
                startBlock$ = "0" & startBlock$
            End If
            
            ' get next block of tag data from textbox_Write
            Data$ = ""
            For X = 1 To TagBlockLength
                If Mid$(textbox_Write.Text, (TagBlockLength * tag_block_index) + X, 1) = "" Then
                    Data$ = Data$ & "00"  ' pad the remainder of this tag block with nulls
                    j = MaxBLock         ' forces to abort of the j = StartingBlock to MaxBlock
                Else
                    temp$ = Mid$(textbox_Write.Text, (TagBlockLength * tag_block_index) + X, 1)
                    tmp = Asc(temp$)
                    temp$ = Hex(tmp)
                    Data$ = Data$ & temp$
                End If
            Next
            tag_block_index = tag_block_index + 1
                        
WriteAgain:
            writeCommand$ = flags$ & "44" & typeOfTag & TagID$ & startBlock$ & "01" & Data$
            
            If protocolv2 = True Then
                ' Calcualte the message length i.e. length of string/2 + 2 bytes of CRC
                byteCount = (Len(writeCommand$) / 2) + 2
                
                strByteCount = Hex(byteCount)
                
                If (byteCount < 16) Then
                    strByteCount = "0" + strByteCount
                End If
                
                writeCommand$ = strByteCount + writeCommand$
            End If

            crc$ = calculateCRC(writeCommand$)
            writeCommand$ = writeCommand$ & crc$
            
            ' send the WRITE_TAG command (write block)
            MSComm1.Output = Chr$(2)  ' use binary mode to put 1 character per byte on the tag
            
            For i = 1 To Len(writeCommand$) Step 2
                MSComm1.Output = Chr$("&H" & Mid$(writeCommand$, i, 2))
            Next i
        
            If GetBinaryResponse() = False Then
                If numTries < 2 Then
                    numTries = numTries + 1
                    GoTo WriteAgain
                Else
                    Call setStatus("Write Tag Fail")
                    Call setStatus("Waiting for Command")
                    Exit Sub
                End If
            End If
                        
            ' good response from the reader
            
            ' this loop determines whether to stop programming because a null was detected in the data that went to the tag
            For k = 1 To (TagBlockLength * 2) Step 2
                If Mid$(Data$, k, 2) = "00" Then
                    Call setStatus("Write Tag Pass")
                    Call setStatus("Waiting for Command")
                    Exit Sub
                End If
            Next k

            bytesWritten = bytesWritten + TagBlockLength
        Loop
                
        ' if the full memory of the tag was programmed and no nulls were ever detected then you are here
        Call setStatus("Write Tag Pass")
        Call setStatus("Waiting for Command")
        Exit Sub
    End If
    
    Call setStatus("No Tag Detected")
    Call setStatus("Waiting for Command")

End Sub
Private Sub btn_Read_Click()
    Dim crc$
    Dim byteCount As Integer
    Dim strByteCount As String
    Dim bytesRead As Integer
    Dim numTries As Integer
    
    ' first we get the tag id and then we read data from the tag.
    ' this form assumes data on a tag will be ASCII formatted data.
    ' this function will read and display tag data until a non-ascii character is found
    
    ' TBD:  handle "Selected State" processing
    textbox_TagID.Text = ""
    Call setStatus("Reading...")
    'label_Status.Caption = "Reading..."
    textbox_Read.Text = ""
    flags$ = "08"  ' RF_F=1
    If MSComm1.PortOpen = True Then
        MSComm1.Output = vbCr & flags$ & "1400" & vbCr  ' send the AUTO-DETECT SELECT Tag command
    End If
    
    If GetResponse() = True Then
        
        'TagID$ = Mid$(response$, 4, 16)
        
        If Mid(Response$, 2, 2) = "94" Then
            Call setStatus("No Tag Detected")
            Call setStatus("Waiting for Command")
            Exit Sub
        Else
            ' Check the tag type
            If protocolv2 = True Then
                typeOfTag = Mid(Response$, 4, 2)
                If typeOfTag > "03" Then
                    Call setStatus("No Read/Write Support for Tag")
                    Call setStatus("Waiting for Command")
                    Exit Sub
                End If
            End If
                        
            ' Setup the Starting Block and Number of Blocks
            ' and also the number of bytes supported by the tag etc.
            setBytesAndBlocksInfo
                
        End If
        
        ' Here's where the Read Loop Starts
        flags = "68" ' set the TID_F and the CRC_F and the RF_F
        
        textbox_Read.Text = ""  ' prepare to display new tag message
        
        bytesRead = 0   ' Set the number of bytes read to 0
        
        Do While bytesRead < MaxNumBytes
        
            numTries = 0
        
            startBlock$ = Hex(StartingBlock)
            
            StartingBlock = StartingBlock + 1   ' Increment to the Next Block
            
            If Len(startBlock$) = 1 Then
                startBlock$ = "0" & startBlock$
            End If
            
ReadAgain:
            readCommand$ = flags$ & "24" & typeOfTag & TagID$ & startBlock$ & "01"
            
            
            ' If version 2 then include the message length field
            If protocolv2 = True Then
                ' Calcualte the message length i.e. length of string/2 + 2 bytes of CRC
                byteCount = (Len(readCommand$) / 2) + 2
                
                strByteCount = Hex(byteCount)
                
                If (byteCount < 16) Then
                    strByteCount = "0" + strByteCount
                End If
                
                readCommand$ = strByteCount + readCommand$
            End If
            
            crc$ = calculateCRC(readCommand$)
            
            readCommand$ = readCommand$ & crc$
            
            ' send the Read Tag command (read single block)
            If MSComm1.PortOpen = True Then
                MSComm1.Output = Chr$(2)  ' use binary mode to put 1 character per byte on the tag
            End If
            
            For i = 1 To Len(readCommand$) Step 2
                If MSComm1.PortOpen = True Then
                    MSComm1.Output = Chr$("&H" & Mid$(readCommand$, i, 2))
                End If
            Next i
            
            If GetBinaryResponse() = True Then
                ' the next block was read successfully
                ' now display the block data byte by byte until a non-ascii byte is detected
                For i = 5 To Len(Response$) - 4 Step 2
                    
                    nextChar$ = Chr$("&H" & Mid$(Response$, i, 2))
                    If nextChar$ = Chr$(0) Then
                        Call setStatus("Read Tag Pass")
                        Call setStatus("Waiting for Command")
                        Exit Sub
                    End If
                    textbox_Read.Text = textbox_Read.Text + nextChar$
                Next i
            Else
                If numTries < 2 Then
                    numTries = numTries + 1
                    GoTo ReadAgain
                Else
                    textbox_Read.Text = ""
                    Call setStatus("Read Tag Fail")
                    Call setStatus("Waiting for Command")
                    Exit Sub
                End If
            End If
            
            bytesRead = bytesRead + TagBlockLength
        Loop
        
        If bytesRead = MaxNumBytes Then
            Call setStatus("Read Tag Pass")
            Call setStatus("Waiting for Command")
            Exit Sub
        End If
    
    End If
    
    If MSComm1.PortOpen = True Then
        Call setStatus("Read Tag Fail")
        Call setStatus("Waiting for Command")
    Else
        ' demo mode when no reader is connected
        textbox_Read.Text = "SkyeRead RFID Readers from SkyeTek can Read and Write text and data from RFID tags and smart labels."
    End If
    label_Status.Caption = "Waiting For Command"

End Sub

Public Function GetResponse() 'gets called from form 7 also
    Dim Start As Single
    
    ' wait .1 second to give the reader time to process the command before it responds
    If (getTIDFlag = True) Then
        Start = Timer
        Do
        DoEvents
        Loop Until (Timer - Start) > 0.5
    Else
        Start = Timer
        Do
        DoEvents
        Loop Until (Timer - Start) > 0.1
    End If
    
    Response$ = ""
    Do While MSComm1.InBufferCount > 0
        DoEvents
        Response$ = Response$ & MSComm1.Input
        'If Right$(response$, 2) = vbCrLf Then
        '    MSComm1.InBufferCount = 0 ' clears the receive buffer
        '    Exit Do
        'End If
    Loop
    
    If Not Right$(Response$, 2) = vbCrLf Then
        ' unknown
        If Response$ = Chr$(21) Then
            bootModeF = True
            Form7.Show vbModal, Me
            Show
            result = MsgBox("Reset Power to the SkyeRead device," & vbCrLf & "then select Reset Reader from the Options menu", vbOKOnly, "SkyeWare Message")
        End If
        Response$ = ""
        GetResponse = False
    ElseIf Not Left$(Response$, 1) = vbLf Then
        Response$ = ""
        GetResponse = False
    ElseIf Response$ = vbLf & "1C" & vbCrLf Then
        ' Enter Loop Mode
        'response$ = ""
        GetResponse = True
    ElseIf Response$ = vbLf & "9C" & vbCrLf Then
        ' Exit Loop Mode
        Response$ = ""
        GetResponse = False
    Else
        GetResponse = True
    End If

End Function
Private Function GetBinaryResponse()
    Dim Start As Single
    Dim respStart As Integer
    
    ' wait .1 second to give the reader time to process the command before it responds
    Start = Timer
    Do
    Loop Until (Timer - Start) > 1
                                        
    Response$ = ""
    Do While MSComm1.InBufferCount > 0
        rx$ = Hex(Asc(MSComm1.Input))
        If Len(rx$) = 1 Then
            rx$ = "0" & rx$
        End If
        Response$ = Response$ & rx$  ' we could read into an array of bytes but the crc function operates on strings
    Loop
    
    If protocolv2 = True Then
        respStart = 5
    Else
        respStart = 3
    End If
    
    If Mid$(Response$, respStart, 1) = "4" Or Mid$(Response$, respStart, 1) = "2" Then
        ' RESP = "Pass"
        ' temporary work-around for Reader FWVER 000F (firmware bug) in the response of a write tag command
        
        If protocolv2 = False Then
            If Mid$(Response$, 3, 2) = "44" Then
                Response$ = Mid$(Response$, 1, 8)  ' truncate the second response from reader fwver 000f
            End If
        End If
        
        inter$ = Mid$(Response$, 3, (Len(Response$) - 6))
        
        crc$ = calculateCRC(inter$)
        If crc$ = Right$(Response$, 4) Then
            If protocolv2 = True Then
                Response$ = Mid$(Response$, 3, Len(Response$) - 2)
            End If
            
            GetBinaryResponse = True
            Exit Function
        End If
    End If
    ' Read Fail
    GetBinaryResponse = False
    Response$ = ""

End Function


Private Function DetermineTagType()
    ' Dim typeOfTag As Str