uhfdemo.frm

M8演示程序

VERSION 5.00
Begin VB.Form UHFDemo 
   Caption         =   "Demo Application"
   ClientHeight    =   6150
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8850
   LinkTopic       =   "Form8"
   ScaleHeight     =   6150
   ScaleWidth      =   8850
   StartUpPosition =   3  'Windows Default
   Begin VB.OptionButton optionClass1Gen2 
      Caption         =   "Class 1 Gen 2"
      Height          =   495
      Left            =   600
      TabIndex        =   12
      Top             =   1440
      Width           =   1695
   End
   Begin VB.OptionButton option180006b 
      Caption         =   "ISO 180006B"
      Height          =   495
      Left            =   600
      TabIndex        =   11
      Top             =   1920
      Width           =   1455
   End
   Begin VB.CheckBox check96 
      Caption         =   "96 Bit Tag"
      Height          =   495
      Left            =   360
      TabIndex        =   10
      Top             =   3840
      Width           =   1455
   End
   Begin VB.OptionButton optionClass0 
      Caption         =   "Class 0 Impinj"
      Height          =   495
      Left            =   5040
      TabIndex        =   8
      Top             =   960
      Width           =   1575
   End
   Begin VB.OptionButton optionClass1 
      Caption         =   "Class 1"
      Height          =   495
      Left            =   600
      TabIndex        =   7
      Top             =   960
      Value           =   -1  'True
      Width           =   1215
   End
   Begin VB.TextBox textClass0 
      Height          =   495
      Left            =   5040
      TabIndex        =   6
      Top             =   2640
      Width           =   3255
   End
   Begin VB.Frame Frame2 
      Caption         =   "Class 0 Data / EPC"
      Height          =   3135
      Left            =   4680
      TabIndex        =   5
      Top             =   480
      Width           =   3975
      Begin VB.OptionButton optionClass0PM 
         Caption         =   "Class 0 + Matrics"
         Height          =   495
         Left            =   360
         TabIndex        =   14
         Top             =   1440
         Width           =   1695
      End
      Begin VB.OptionButton optionClass0P 
         Caption         =   "Class 0 + Impinj"
         Height          =   495
         Left            =   360
         TabIndex        =   13
         Top             =   960
         Width           =   1455
      End
   End
   Begin VB.CheckBox checkLoop 
      Caption         =   "Loop"
      Height          =   495
      Left            =   360
      TabIndex        =   4
      Top             =   4320
      Width           =   1215
   End
   Begin VB.CommandButton btn_Write 
      Caption         =   "Write"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   4680
      TabIndex        =   3
      Top             =   3840
      Width           =   1695
   End
   Begin VB.CommandButton btn_Read 
      Caption         =   "Read"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   2400
      TabIndex        =   2
      Top             =   3840
      Width           =   1695
   End
   Begin VB.TextBox textClass1 
      ForeColor       =   &H80000001&
      Height          =   495
      Left            =   480
      MaxLength       =   24
      TabIndex        =   1
      Top             =   2640
      Width           =   3255
   End
   Begin VB.Frame Frame1 
      Caption         =   "Class 1 Data / EPC"
      Height          =   3135
      Left            =   120
      TabIndex        =   0
      Top             =   480
      Width           =   3975
   End
   Begin VB.Label labelStatus 
      Caption         =   "Command Status"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1095
      Left            =   3360
      TabIndex        =   9
      Top             =   4560
      Width           =   2295
   End
End
Attribute VB_Name = "UHFDemo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim EraseTag As Boolean

Private Sub Command1_Click()

End Sub

Private Sub btn_Read_Click()
    
    Dim respBytes As Integer
    Dim TagID As String
    Dim crlfPosition As Integer
    
    
    labelStatus.Caption = "Reading a Tag"


    Form1.Response$ = ""
    
    textClass1.Text = ""
    textClass0.Text = ""
    
    If Form1.MSComm1.PortOpen = False Then
        Exit Sub
    End If
 
    
    
    Form1.MSComm1.InBufferCount = 0
    If checkLoop.Value = 1 Then
       Form1.demoLOOP = True

        If optionClass1.Value = True Then
            Form1.MSComm1.Output = vbCr & "011481" & vbCr
        ElseIf option180006b = True Then
            Form1.MSComm1.Output = vbCr & "011486" & vbCr
        Else
            Form1.MSComm1.Output = vbCr & "091482" & vbCr
        End If
        
        Start = Timer
        Do
        Loop Until (Timer - Start) > 0.1
        If Form1.GetResponse() = True Then
            If Mid(Form1.Response, 2, 2) <> "1C" Then

                'Exit Sub
            End If

        End If

        ' Now enable the OnComm Events
        Form1.MSComm1.RThreshold = 1  'Now enable OnComm to handle Loop Mode
       
    Else
    
        ' 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 optionClass1.Value = True Then
            Form1.MSComm1.Output = vbCr & "001481" & vbCr
        ElseIf option180006b = True Then
            Form1.MSComm1.Output = vbCr & "001486" & vbCr
        ElseIf optionClass0 = True Then
            Form1.MSComm1.Output = vbCr & "081482" & vbCr
        ElseIf optionClass0P = True Then
            Form1.MSComm1.Output = vbCr & "001483" & vbCr
        ElseIf optionClass0PM = Ture Then
            Form1.MSComm1.Output = vbCr & "001484" & vbCr
        Else
            Form1.MSComm1.Output = vbCr & "001481" & 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.1
        
            If Form1.GetResponse() = True Then
                ' Good tag response
                If Mid(Form1.Response, 2, 2) = "14" Then
                    'Tag found, parse the data here
                    crlfPosition = InStr(1, Form1.Response, vbCr)
                    TagID = Mid(Form1.Response, 4, crlfPosition - 4)
                    
                    If optionClass1.Value = True Then
                        textClass1.Text = TagID
                    ElseIf option180006b.Value = True Then
                        textClass1.Text = TagID
                    Else
                        textClass0.Text = TagID
                    End If
                            
                    
                    labelStatus.Caption = "Waiting For Command"
                    Exit Sub
                    
                    
                Else
                    'If Mid(Form1.Response, 2, 2) = "94" Then
                        'No Tag Found
    
                        If optionClass1.Value = True Then
                            textClass1.Text = "No Tag Found"
                        ElseIf option180006b.Value = True Then
                            textClass1.Text = "No Tag Found"
                        Else
                            textClass0.Text = "No Tag Found"
                        End If
                        
                        Start = Timer
                        Do
                        Loop Until (Timer - Start) > 0.5
                        
                        labelStatus.Caption = "Waiting For Command"
                        
                   ' End If
    
                End If
        
         End If
    
        
    End If

    
End Sub
Private Function Erase_Tag()

    
    TagErase = False