form1.frm

M8演示程序

        uhfON = False
    End If
    
End Sub

Private Sub Form_Load()
   
    tagidIndex = 2
    textbox_TagID.Locked = True
    textbox_TagIDList.Locked = True
    textbox_Read.Locked = True
    
    demoLoadedF = False
    bootModeF = False
    
    MSComm1.InBufferCount = 0
    MSComm1.RThreshold = 0     ' disable OnComm - polling used at first
    
    Close #1
    
    ' detect a reader and set the baud rate
    Call mnuOptions_Reader_Click

    ' Give Title to the dialog box
    CommonDialog1.DialogTitle = "Open"
    Call openDemo
    
    If MSComm1.PortOpen = False Then
        textbox_TagID.Locked = False
        textbox_TagID.MaxLength = 16
        textbox_Write.Text = "Type text and data here that you want to write to the memory of a RFID tag or smart label"
    End If

End Sub


Private Function detectReader()

 Dim Start As Single
 Dim baudrate As Integer
 Dim com As Integer
 Dim X$ ' to clear unwanted responce characters
 MSComm1.InBufferCount = 0

 getTIDFlag = False
 RID$ = FF
Do
    For com = 1 To 16
    
        If MSComm1.PortOpen = True Then
            MSComm1.PortOpen = False
        End If
        
        MSComm1.CommPort = com
        MSComm1.InputLen = 1
        MSComm1.RThreshold = 0  ' disble OnComm
        'MSComm1.RThreshold = 1  ' enable OnComm

        Call setcom
        If MSComm1.PortOpen = True Then
            MSComm1.InputMode = comInputModeText
        
            For baudrate = 0 To 3
                Select Case baudrate
                    Case 0
                        '9600
                        MSComm1.Settings = "9600,N,8,1"
                
                    Case 1
                        ' 19200
                        MSComm1.Settings = "19200,N,8,1"
                
                    Case 2
                        ' 38400
                        MSComm1.Settings = "38400,N,8,1"
                
                    Case 3
                        ' 57600
                        MSComm1.Settings = "57600,N,8,1"
                             
                End Select
                
                If MSComm1.PortOpen = True Then
                    MSComm1.Output = vbCr & "0022010101" & vbCr  ' give an illegal message to get a known error message
                End If                                           ' 12-bytes total, just like a bootloader command
                
                If GetResponse() = True Then
                      
                   ' If Response$ = vbLf & "88" & vbCrLf Then    ' NACK from a reader whose EEPROM address 0x0B equals 0
                        ' this should have been the RESPONSE.
                        ' TBD: what to do if it wasn't?
                        ' do nothing
                                       
                     
                    'End If
               
                    MSComm1.Output = vbCr & "00220101" & vbCr  ' request the reader firmware version
                    
                    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 fwver$ >= "E000" And fwver$ <= "E0FF" Then
                         ' set flag if uhf firmware version
                           uhfF = True
                           textbox_Write.Text = "This functionality is not supported"
                           textbox_Write.Enabled = False
                           textbox_Read.Text = "This functionality is not supported"
                           textbox_Read.Enabled = False
                           btn_Read.Enabled = False
                           btn_Write.Enabled = False
                           checkbox_anticollision.Enabled = False
                           'tagFile$ = "taginfo.txt"
                           'Open tagFile$ For Input As #1
                           'Line Input #1, TagFileName(1)  ' 1st line has logo information
                           'Line Input #1, TagFileName(2)  ' 1st line has logo information
                           'Close #1
                           
                        End If
                            
                        
            
                        If MSComm1.PortOpen = True Then
                            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
                     
                End If
                
                
                'Marcus Code, to read reader with reader ID
                
                If MSComm1.PortOpen = True Then
                   MSComm1.Output = vbCr & "8012FF" & vbCr 'send select system command to receive 84 invalid command
                End If

                If GetResponse() = True Then
                    RID$ = Mid$(Response$, 4, 2) 'get reader ID

                    MSComm1.Output = vbCr & "8022FF0101" & vbCr  'get firmware version
                    If GetResponse() = True Then
                    
                        fwverH$ = Mid$(Response$, 6, 2)
                        fwverL$ = Mid$(Response$, 8, 2)
                    End If
                    
                    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 MSComm1.PortOpen = True Then
                        MSComm1.Output = vbCr & "8022FF0001" & vbCr  ' get the reader serial number for fw versions > 0D
                    End If

                    If GetResponse() = True Then
                        serNum$ = Mid$(Response$, 6, 8)
                    Else
                        serNum$ = "Not Detected"
                    End If

                    Exit Function

                End If
                'End marcus code
                    
            Next  ' baud rate loop
            
        End If
        
        If MSComm1.PortOpen = True Then
            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 Function setcom() As Boolean
    
    On Error GoTo X:
    MSComm1.PortOpen = True
    'End Function
X:
End Function
Private Sub openDemo()

    On Error GoTo ErrHandler

    ' Set filters.
    CommonDialog1.Filter = "SkyeWare Demo Files (*.dem)|*.dem"
    ' Specify default filter.
    CommonDialog1.FilterIndex = 2
    ' clear the filename line in the dialog box
    CommonDialog1.FileName = ""
    ' Display the Open dialog box.
    CommonDialog1.ShowOpen
    
    ' assign the filename of this demo file to the variable fileName$
    If CommonDialog1.FileName = "" Then
        Exit Sub
    End If
    demoFileName$ = CommonDialog1.FileName
        
    demoLoadedF = True
    
    ' Call the open file procedure.
    
    ' now open the filename specified by the user of the dialog box
    If CommonDialog1.DialogTitle = "Create New Demo" Then
        ' create a new blank .dem file with fliename=demoFileName$
        Open demoFileName$ For Output As #1
            Print #1, "logo="
            Close #1
        ' now we have a blank project, so let's also clear the ram
        For Linenumber = 1 To 15
            Linedata(Linenumber) = ""
            TagIDnum(Linenumber) = ""
            FileName(Linenumber) = ""
        Next
        demoFile$ = "logo=" & vbCrLf
        Image2.Picture = LoadPicture
    ElseIf CommonDialog1.DialogTitle = "Save Demo As" Then
        ' create new file.dem and then copy into it the contents of the old demo that still exist in demoFile$
        Open demoFileName$ For Output As #1
        For Linenumber = 1 To 15
            If Linedata(Linenumber) = "" Then
                Exit For
            End If
            Print #1, Linedata(Linenumber)
        Next
        Close #1
    Else
        ' "Open Demo" was the dialog
        ' load the array with all the (TagID, filename) associations
        Call ReadDemoFile   ' sets the value of demoFile$
        Image2.Picture = LoadPicture(FileName(1))  ' display the logo picture
        label_Logo.Visible = False
    End If
    
    ' TBD: now check to make sure all the filenames are valid
    
    ' update the title of the form
    Form1.Caption = "SkyeTek - SkyeWare RFID Demo Software - " & CommonDialog1.FileName
ErrHandler:
        ' User pressed Cancel button.
    Close #1

End Sub

Private Function ReadDemoFile()
    
    On Err GoTo ErrHandler
        
    If demoFileName$ = "" Then
        result = MsgBox("No Demo Loaded", vbOKOnly, "SkyeWare Message")
        Exit Function
    End If
        
        
    ' "Open Demo" was the dialog
    ' load the array with all the (TagID, filename) associations
    demoFile$ = ""
    Open demoFileName$ For Input As #1
    Line Input #1, Linedata(1)  ' 1st line has logo information
    Length = Len(Linedata(1)) - 5
    If Length > 0 Then
        FileName(1) = Mid$(Linedata(1), 6, Length)
    Else
        FileName(1) = ""
    End If
    demoFile$ = Linedata(1) & vbCrLf
    Image2.Picture = LoadPicture(FileName(1))
    Linenumber = 2
    While Not EOF(1)
        Line Input #1, Linedata(Linenumber)
        demoFile$ = demoFile$ & Linedata(Linenumber) & vbCrLf
        TagIDnum(Linenumber) = Mid$(Linedata(Linenumber), 1, 16)
        Length = Len(Linedata(Linenumber)) - 17
        If Length > 0 Then
                FileName(Linenumber) = Mid$(Linedata(Linenumber), 18, Length)
        End If
        Linenumber = Linenumber + 1
    Wend
    Close #1
    
    Image2 = LoadPicture(FileName(1))
    
ErrHandler:
        Close #1
End Function

Private Sub btn_Link_Click()

    
    
    ' load to RAM
    ' write to file
    ' display picture
    
    ' here to link a new pic to the tag id in textbox_TagID
    ' Dim fso As New FileSystemObject, fil As File
    
    ' CancelError is True.
    On Error GoTo ErrHandler
    
    If demoLoadedF = False Then
        result = MsgBox("No Demo Loaded", vbOKOnly, "SkyeWare Message")
        Exit Sub
    End If
    
    If Len(textbox_TagID.Text) < 16 Then
        If MSComm1.PortOpen = True Then
            result = MsgBox("Invalid Tag ID", vbOKOnly, "SkyeWare Message")
        Else
            result = MsgBox("Type a unique Tag ID", vbOKOnly, "SkyeWare Message")
        End If
    Else
    
        ' check to see if this tag id is already registered:
        For Linenumber = 2 To 15
            If TagIDnum(Linenumber) = Mid$(textbox_TagID.Text, 1, 16) Then
                ' msg box "this tag already has a picture"
                result = MsgBox("This Tag already Has a Picture." & vbCrLf & "Change the Tag ID, then Link.", vbOKOnly, "SkyeWare Message")
                Exit Sub
            End If
            If TagIDnum(Linenumber) = "" Then
                Exit For  ' exit with Linenumber pointing to the next available element in the array
            End If
        Next
        
        ' this tag ID was not already registered, so register it now in RAM and in the file projname.ini
        
        ' Set filters.
        CommonDialog1.Filter = "All Picture Files|*.jpg;*.gif;*.bmp"
        ' Specify default filter.
        
        CommonDialog1.DialogTitle = "Link Picture File"
        CommonDialog1.FileName = ""
        'CommonDialog1.FilterIndex = 2  ' Display the Open dialog box.
        
        CommonDialog1.ShowOpen
        ' Call the open file procedure.
        
        If CommonDialog1.FileName = "" Then
            Exit Sub
        End If
        
        'first put the new association into the array in RAM
        TagIDnum(Linenumber) = Mid$(textbox_TagID.Text, 1, 16)
        FileName(Linenumber) = CommonDialog1.FileName