uhfdemo.frm

M8演示程序

    Form1.Response$ = ""
    'Form1.MSComm1.Output = vbCr & flags$ & comand$ & strtBlk$ & nbBlks$ & hexLong$ & crc$ & vbCr
    

    
    If Form1.MSComm1.PortOpen = False Then
        Exit Function
    End If
    
    
 ' Diasble the OnComm Events
        Form1.MSComm1.RThreshold = 0  ' disable OnComm
        Form1.MSComm1.InBufferCount = 0 ' clear the rx buffer in case a tag id was coming through just as we get here
        Form1.Response$ = ""
        ' Send the Command
        
        
        ' Erase Tag *************************************************************************
        If check96.Value = True Then
            '96 bit tag - Send Command
            Form1.MSComm1.Output = vbCr & "0044810000" & vbCr
        
        Else
            '64 bit tag - Send Command
            Form1.MSComm1.Output = vbCr & "0044810000" & vbCr
        End If
        
        
        Form1.MSComm1.InBufferCount = 0
        
        Dim Start As Single
        ' wait .1 second to give the reader time to process the command before it responds
        Start = Timer
        
        Do
        Loop Until (Timer - Start) > 0.5
        
            If Form1.GetResponse() = True Then
                ' Good tag response
                If Mid(Form1.Response, 2, 2) = "44" Then
                    labelStatus.Caption = "Erase Passed: Waiting For Command"
                    EraseTag = True
                Else
                    ' Failed to Write
                    labelStatus.Caption = "Erase Failed: Waiting For Command"
                    EraseTag = False
                    ' textClass0.Text = Mid(Form1.Response, 2, 2)
           
                End If
                
        
            End If

End Function

Private Sub Check1_Click()

End Sub

Private Sub btn_Write_Click()
    
    Dim Start As Single

    Form1.Response$ = ""
    'Form1.MSComm1.Output = vbCr & flags$ & comand$ & strtBlk$ & nbBlks$ & hexLong$ & crc$ & vbCr
    

    If option180006b.Value = True Then
        labelStatus.Caption = "Write Not Supported"
        Exit Sub
    ElseIf optionClass0P.Value = True Then
        labelStatus.Caption = "Write Not Supported"
        Exit Sub
    ElseIf optionClass0PM.Value = True Then
        labelStatus.Caption = "Write Not Supported"
        Exit Sub
    End If
        
    
    If Form1.MSComm1.PortOpen = False Then
        Exit Sub
    End If
    
    
    ' *********** CLASS 1 WRITE END ************
    If optionClass1 = True Then
        ' Diasble the OnComm Events
        Form1.MSComm1.RThreshold = 0  ' disable OnComm
        Form1.MSComm1.InBufferCount = 0 ' clear the rx buffer in case a tag id was coming through just as we get here
        Form1.Response$ = ""
        ' Send the Command
        
        ' If Class 1 erase tag
        If optionClass1.Value = True Then
            If EraseTag = True Then
                Call Erase_Tag
            Else
                Exit Sub
            End If
        End If
        
        
        If check96.Value = True Then
            '96 bit tag - Send Command
            If Len(textClass1) <> 24 Then
                MsgBox "Data Must be 12 Bytes"
                Exit Sub
            End If
            Form1.MSComm1.Output = vbCr & "004481000C" & textClass1.Text & vbCr
        
        Else
            '64 bit tag - Send Command
            If Len(textClass1) <> 16 Then
                MsgBox "Data Must be 8 Bytes"
                Exit Sub
            End If
            
            Form1.MSComm1.Output = vbCr & "0044810008" & textClass1.Text & vbCr
        End If
        
        
        Form1.MSComm1.InBufferCount = 0
        
        
        ' wait .1 second to give the reader time to process the command before it responds
        Start = Timer
        
        Do
        Loop Until (Timer - Start) > 0.5
        
            If Form1.GetResponse() = True Then
                ' Good tag response
                If Mid(Form1.Response, 2, 2) = "44" Then
                    
                    labelStatus.Caption = "Write Passed: Waiting For Command"
                Else
                    ' Failed to Write
                    labelStatus.Caption = "Write Failed: Waiting For Command"
                    textClass0.Text = Mid(Form1.Response, 2, 2)
           
                End If
                
        
            End If
    End If
            
    ' *********** CLASS 1 WRITE END ************
        
        
    ' *********** CLASS 0 WRITE END ************
    If optionClass0 = True Then
        ' Diasble the OnComm Events
        Form1.MSComm1.RThreshold = 0  ' disable OnComm
        Form1.MSComm1.InBufferCount = 0 ' clear the rx buffer in case a tag id was coming through just as we get here
        Form1.Response$ = ""
        ' Send the Command
        
        
        Form1.MSComm1.Output = vbCr & "084483000C" & textClass0.Text & vbCr
        
        
        Form1.MSComm1.InBufferCount = 0
        
        
        ' wait .1 second to give the reader time to process the command before it responds
        Start = Timer
        
        Do
        Loop Until (Timer - Start) > 0.5
        
            If Form1.GetResponse() = True Then
                ' Good tag response
                If Mid(Form1.Response, 2, 2) = "44" Then
                    
                    labelStatus.Caption = "Write Passed: Waiting For Command"
                Else
                    ' Failed to Write
                    labelStatus.Caption = "Write Failed: Waiting For Command"
                    textClass0.Text = Mid(Form1.Response, 2, 2)
           
                End If
                
        
            End If
        
    End If
            
    ' *********** CLASS 0 WRITE END ************
            
        
        
    
End Sub

Private Sub Form_Load()
    If Form1.MSComm1.PortOpen = False Then
        ' detect a reader and set the baud rate
        Call Form1.mnuOptions_Reader_Click
    End If
        
    Form1.MSComm1.InBufferCount = 0
    Form1.MSComm1.RThreshold = 0     ' disable OnComm - polling used at first
    
    optionClass0.Enabled = True
    optionClass0P.Enabled = True
    optionClass0PM.Enabled = True
    optionClass1Gen2.Enabled = False
    
    
    Close #1
End Sub

Private Sub option180006b_Click()
    btn_Write.Enabled = False
    
    optionClass1.Value = False
    optionClass1Gen2.Value = False
    option180006b.Value = True
    optionClass0.Value = False
    optionClass0P.Value = False
    optionClass0PM.Value = False
    
    check96.Enabled = False
    checkLoop.Enabled = True
    
End Sub

Private Sub optionClass0_Click()
    btn_Write.Enabled = True
    
    optionClass1.Value = False
    optionClass1Gen2.Value = False
    option180006b.Value = False
    optionClass0.Value = True
    optionClass0P.Value = False
    optionClass0PM.Value = False
    
    check96.Enabled = False
    checkLoop.Enabled = True
    
End Sub

Private Sub optionClass0P_Click()
    btn_Write.Enabled = False
    
    optionClass1.Value = False
    optionClass1Gen2.Value = False
    option180006b.Value = False
    optionClass0.Value = False
    optionClass0P.Value = True
    optionClass0PM.Value = False
    
    check96.Enabled = False
    checkLoop.Enabled = False
    
End Sub

Private Sub optionClass0PM_Click()
    btn_Write.Enabled = False
    
    optionClass1.Value = False
    optionClass1Gen2.Value = False
    option180006b.Value = False
    optionClass0.Value = False
    optionClass0P.Value = False
    optionClass0PM.Value = True
    
    check96.Enabled = False
    checkLoop.Enabled = False
    
End Sub

Private Sub optionClass1_Click()
    btn_Write.Enabled = True
    
    optionClass1.Value = True
    optionClass1Gen2.Value = False
    option180006b.Value = False
    optionClass0.Value = False
    optionClass0P.Value = False
    optionClass0PM.Value = False
    
    check96.Enabled = True
    checkLoop.Enabled = True
    
End Sub

Private Sub optionClass1Gen2_Click()
    btn_Write.Enabled = False
        
    optionClass1.Value = False
    optionClass1Gen2.Value = True
    option180006b.Value = False
    optionClass0.Value = False
    optionClass0P.Value = False
    optionClass0PM.Value = False
    
    check96.Enabled = False
    checkLoop.Enabled = False
    
End Sub