form9.frm

M8演示程序

VERSION 5.00
Begin VB.Form Form9 
   Caption         =   "Extended Memory"
   ClientHeight    =   9045
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6750
   LinkTopic       =   "Form8"
   ScaleHeight     =   9045
   ScaleWidth      =   6750
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Exit_Btn 
      Caption         =   "Exit"
      Height          =   375
      Left            =   5280
      TabIndex        =   3
      Top             =   8520
      Width           =   1335
   End
   Begin VB.CommandButton Erase_Btn 
      Caption         =   "Erase Records"
      Height          =   375
      Left            =   240
      TabIndex        =   2
      Top             =   960
      Width           =   6255
   End
   Begin VB.CommandButton Read_Btn 
      Caption         =   "Retreive Records"
      Height          =   375
      Left            =   240
      TabIndex        =   1
      Top             =   240
      Width           =   6255
   End
   Begin VB.TextBox TIDList_Box 
      Height          =   6615
      Left            =   240
      MultiLine       =   -1  'True
      TabIndex        =   0
      Top             =   1680
      Width           =   6255
   End
   Begin VB.Frame Frame1 
      Caption         =   "Stored Tag Id's"
      Height          =   6975
      Left            =   120
      TabIndex        =   4
      Top             =   1440
      Width           =   6495
   End
End
Attribute VB_Name = "Form9"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public RecordEndAdd$
Public Response$
Const ResponseTime = 0.1
Option Explicit
Private Function GetResponse(Response$) As Boolean
'******************************************************************
'*Function: GetResponse() - Detects if a response arrived
'*Author  : Sean Loving
'*Date    : Mar    2003
'*Revised : May 2, 2003
'*
'*Description:
'*Detects response to a command
'*
'*Syntax detectReader()
'*
'*Parameters:
'*Response  => passed by ref contains response if any
'*
'*Return Val:
'*True if response recieved else False
'*****************************************************************
    Dim Start As Single
    
    ' wait to give the reader time to process the command before it responds
    Start = Timer
    Do
        DoEvents
    Loop Until (Timer - Start) > ResponseTime
    
    Response$ = ""
    Do While Form1.MSComm1.InBufferCount > 0
        Response$ = Response$ & Form1.MSComm1.Input
        If Right$(Response$, 2) = vbCrLf Then
            Form1.MSComm1.InBufferCount = 0 ' clears the receive buffer
            Exit Do
        End If
    Loop
    
    If Response$ = "" Then
        GetResponse = False
    ElseIf Response$ = vbLf & "426116" & vbCrLf Then
        GetResponse = False
    ElseIf Response = vbLf & "8195D" & vbCrLf Then  'C
        GetResponse = False
    Else
        GetResponse = True
    End If
End Function

Private Function hex2int(ByVal StrHex As String) As Integer
'example input="1F" output=31, input=1FFF, output=8191
'to convert back use the function Hex

Dim StrTemp As String
Dim IntOut As Integer
StrTemp = "&H" & StrHex
hex2int = StrTemp

End Function
Private Function SortAndDispData(DataLen As Integer, Data As String)
Dim count As Integer
Dim TIDLen As Integer
Dim TID$

'For i = 1 To lenData
count = 0
While count < DataLen
    TIDLen = hex2int(Left$(Data, 2)) * 2
    TID$ = Mid$(Data, 3, TIDLen)
    count = count + TIDLen + 2
    Data = Right$(Data, DataLen - count)
    TIDList_Box.Text = TIDList_Box.Text & TID$ & vbCrLf
Wend

End Function
Private Sub GetEndAddress()
    Dim HighAdd$
    Dim LowAdd$
    
    HighAdd$ = ""
    LowAdd$ = ""
    Do
        Form1.MSComm1.Output = vbCr & "2021100152AC" & vbCr
        'Read the High Address
    Loop Until (GetResponse(Response$) = True)
    
    HighAdd$ = Mid$(Response$, 4, 2) 'C
    
    Do
        Form1.MSComm1.Output = vbCr & "202111014B74" & vbCr
        'Read the Low Address
    Loop Until (GetResponse(Response$) = True)
    
    LowAdd$ = Mid$(Response$, 4, 2) 'C
    
    RecordEndAdd$ = HighAdd$ & LowAdd$

End Sub

Private Sub Erase_Btn_Click()
Do
    'write to mem location 10
    Form1.MSComm1.Output = vbCr & "2041100100F6D0" & vbCr 'C
Loop Until (GetResponse(Response$) = True)

Do
    'write to mem location 11
    Form1.MSComm1.Output = vbCr & "2041110100AC0C" & vbCr 'C
Loop Until (GetResponse(Response$) = True)

End Sub

Private Sub Exit_Btn_Click()
    Unload Form9
End Sub

Private Sub Form_Load()
    TIDList_Box.Visible = False
    Frame1.Visible = False
End Sub


Private Sub Read_Btn_Click()
Dim count As Integer
Dim temp$
Dim i As Integer
Dim result$
TIDList_Box.Visible = True
 Frame1.Visible = True
Call GetEndAddress

If hex2int(RecordEndAdd$) <> 0 Then
    count = hex2int(RecordEndAdd$) / 64 'C
Else
    'message box displaying "no records"
    result$ = MsgBox("No Tag id's Stored", vbOKOnly, "SkyeWare Message")
End If

For i = count To 0
    If count <> 0 Then
        'read 64bytes
        Do
            Form1.MSComm1.Output = vbCr & "00220C01000040" & vbCr 'C
        Loop Until (GetResponse(Response$) = True)
        Response$ = Mid$(Response$, 4, 64 * 2) 'remove sarting and ending CRLF's and response code and CRC
        Call SortAndDispData(64 * 2, Response$)
    Else
        temp$ = Right("00" & Hex(hex2int(RecordEndAdd$) Mod 64), 2)
        'NOTE CRC Flag is not on right now to reduce caling the CRC function
        Do
            Form1.MSComm1.Output = vbCr & "00220C010000" & temp & vbCr  'C
        Loop Until (GetResponse(Response$) = True)
        Response$ = Mid$(Response$, 4, hex2int(RecordEndAdd$) * 2)
        Call SortAndDispData(hex2int(RecordEndAdd$) * 2, Response$)
    End If

Next i


End Sub