VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Demo"
   ClientHeight    =   6015
   ClientLeft      =   1125
   ClientTop       =   1680
   ClientWidth     =   8415
   BeginProperty Font 
      Name            =   "MS Sans Serif"
      Size            =   9.75
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   6015
   ScaleWidth      =   8415
   Begin VB.ListBox lbErr 
      Height          =   1980
      Left            =   240
      TabIndex        =   10
      Top             =   3960
      Width           =   6615
   End
   Begin VB.ListBox lbCmd 
      Height          =   1980
      Left            =   240
      TabIndex        =   9
      Top             =   1440
      Width           =   6495
   End
   Begin VB.Timer Timer1 
      Left            =   6840
      Top             =   360
   End
   Begin VB.TextBox EndAddr 
      Height          =   375
      Left            =   4200
      TabIndex        =   5
      Text            =   "0f"
      Top             =   480
      Width           =   735
   End
   Begin VB.TextBox StartAddr 
      Height          =   375
      Left            =   2280
      TabIndex        =   4
      Text            =   "01"
      Top             =   480
      Width           =   735
   End
   Begin VB.ComboBox comCombo 
      Height          =   360
      ItemData        =   "Form1.frx":0000
      Left            =   240
      List            =   "Form1.frx":0010
      TabIndex        =   2
      Text            =   "COM1"
      Top             =   480
      Width           =   1332
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Active"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   13.5
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   612
      Left            =   6975
      TabIndex        =   1
      Top             =   4200
      Width           =   1095
   End
   Begin VB.CommandButton exitCmd 
      Caption         =   "E&xit"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   13.5
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   612
      Left            =   6960
      TabIndex        =   0
      Top             =   5040
      Width           =   1095
   End
   Begin VB.Label lErrCnts 
      Caption         =   "Error"
      Height          =   255
      Left            =   6960
      TabIndex        =   16
      Top             =   3600
      Width           =   735
   End
   Begin VB.Label lTtlLoops 
      Caption         =   "Error"
      Height          =   255
      Left            =   6960
      TabIndex        =   15
      Top             =   2640
      Width           =   735
   End
   Begin VB.Label Label8 
      Caption         =   "Error Counts"
      Height          =   255
      Left            =   6960
      TabIndex        =   14
      Top             =   3240
      Width           =   1215
   End
   Begin VB.Label Label7 
      Caption         =   "Total Loops"
      Height          =   255
      Left            =   6960
      TabIndex        =   13
      Top             =   2280
      Width           =   1215
   End
   Begin VB.Label Label6 
      Caption         =   "Error"
      Height          =   255
      Left            =   240
      TabIndex        =   12
      Top             =   3720
      Width           =   735
   End
   Begin VB.Label Label5 
      Caption         =   "Good"
      Height          =   255
      Left            =   240
      TabIndex        =   11
      Top             =   1200
      Width           =   735
   End
   Begin VB.Label Label4 
      Caption         =   "==>"
      Height          =   255
      Left            =   3480
      TabIndex        =   8
      Top             =   600
      Width           =   495
   End
   Begin VB.Label Label2 
      Caption         =   "End Addr[hex]"
      Height          =   255
      Left            =   3960
      TabIndex        =   7
      Top             =   120
      Width           =   1335
   End
   Begin VB.Label Label1 
      Caption         =   "Start Addr[hex]"
      Height          =   255
      Left            =   2040
      TabIndex        =   6
      Top             =   120
      Width           =   1335
   End
   Begin VB.Label Label3 
      Caption         =   "COM Port:"
      Height          =   375
      Left            =   240
      TabIndex        =   3
      Top             =   120
      Width           =   1335
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim bProcessing As Boolean
Dim iLoopCnt As Long
Dim iTCnt1, iTCnt2 As Long

Private Sub Command1_Click()
     If Command1.Caption = "Stop" Then
         Timer1.Enabled = False
         Command1.Caption = "Active"
         exitCmd.Enabled = True
         Exit Sub
     End If
     
     Command1.Caption = "Stop"
     exitCmd.Enabled = False
     iTCnt1 = 0: iTCnt2 = 0
     iLoopCnt = 0
     lTtlLoops.Caption = "0"
     lErrCnts.Caption = "0"
     lbCmd.Clear
     lbErr.Clear

     If COMOpen = 1 Then  'Reopen Com port
        Close_Com (Port)
        COMOpen = 0
     End If
     
     OpenCom

     If COMOpen = 1 Then
          Timer1.Enabled = True
     End If
    
End Sub

Private Sub exitCmd_Click()
    End
End Sub

Private Sub Form_Load()
    comCombo.ListIndex = 1
    DataBit = 8    ' 8 data bit
    Parity = 0     ' Non Parity
    StopBit = 0    ' One Stop Bit
    COMOpen = 0
    Timer1.Enabled = False
    Timer1.Interval = 200
    iLoopCnt = 0
    SendTo7000 = Space(100)
    ReceiveFrom7000 = Space(100)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If COMOpen > 0 Then
        Close_Com (Port)
    End If
End Sub

Public Function OpenCom()
    Dim Response, RetValue As Integer
    Dim Cmd As String
    
    Cmd = Space(80)
    
    ' decide the COM Port
    Port = comCombo.ListIndex + 1
    BaudRate = 9600
    RetValue = Open_Com(Port, BaudRate, DataBit, Parity, StopBit)
    If RetValue > 0 Then
        Beep
        Response = MsgBox("Quit this demo?", vbYesNo, "OPEN_COM Error Code:" + Str(RetValue))
        If Response = vbYes Then
             Close_Com (Port)
             End
        End If
    Else
        COMOpen = 1
    End If
End Function

Private Sub Timer1_Timer()
    Dim iStart, iEnd, i As Integer
    Dim iRtn As Integer

     If bProcessing = True Then          'avoid to reenter this function
        Exit Sub
     Else
        bProcessing = True
     End If

     DoEvents
     iLoopCnt = iLoopCnt + 1
     lTtlLoops.Caption = Str(iLoopCnt)
     lbCmdAdd ("")
     lbCmdAdd ("=========== Loop:" + Str(iLoopCnt))
     'lbErrAdd("")
     'lbErrAdd("=========== Loop:" + Str(iLoopCnt))
     'SendTo7000 := "#**" + #13
     SendTo7000 = "#**"                     'Send the synchronise command
     iRtn = Send_Cmd(Port, SendTo7000, 0)
     If iRtn <> NoError Then
        lbErrAdd2 ("Send Cmd:#**   ==> ErrorCode:" + Str(iRtn))
     Else
        lbCmdAdd ("Send Cmd:#** ")
     End If

     Sleep (200)                          'Sleep 200 mSeconds( 0.2 seconds )
     iStart = Val("&h" + StartAddr.Text)
     iEnd = Val("&h" + EndAddr.Text)
     For i = iStart To iEnd
         Read7012 i
         DoEvents
         If Command1.Caption = "Active" Then
            bProcessing = False
            Exit Sub
         End If
     Next

     bProcessing = False
End Sub

Private Sub Read7012(ByVal i As Integer)
     Dim sAddr As String
     Dim wT    As Integer
     Dim iRtn As Integer
     
     DoEvents
     sAddr = Right("00" + Hex(i), 2)
     'SendTo7000 = "$" + sAddr + "4" + chr(13)
     SendTo7000 = "$" + sAddr + "4"             'Read the synchronise value

     'Clear the buffer for debug
     ReceiveFrom7000 = "                  "

     iRtn = Send_Receive_Cmd(Port, SendTo7000, ReceiveFrom7000, 200, 0, wT)
     If iRtn = NoError Then
         If Mid(ReceiveFrom7000, 4, 1) <> "1" Then
             'lbErrAdd2( "$" + sAddr + "4  ==> " + ReceiveFrom7000 + "  ==>S<>1:NotFirstReading")
             ' ********** Module Address ******* Receive String by hex ********* Loop Counters **********
             lbErrAdd2 ("$" + sAddr + "4  ==> " + GetNS(ReceiveFrom7000) + "  ==>LoopCnt:" + lTtlLoops.Caption)
         Else
            lbCmdAdd ("$" + sAddr + "4  ==> " + ReceiveFrom7000)
         End If
     Else
        'lbErrAdd2( "$" + sAddr + "4  ==> " + ReceiveFrom7000 + "  ==> ErrCode:" + Str(iRtn) )
        ' ********** Module Address ***** Receive String by hex ************ Error Code ************* Loop Counters *******
        lbErrAdd2 ("$" + sAddr + "4  ==> " + GetNS(ReceiveFrom7000) + " =>ErrCd:" + Str(iRtn) + " =>LpCnt:" + lTtlLoops.Caption)
    End If
End Sub

'Add string into Command ListBox
Private Sub lbCmdAdd(ByVal s As String)
     iTCnt1 = iTCnt1 + 1
     If iTCnt1 > 400 Then
        iTCnt1 = 1
        lbCmd.Clear
     End If

     lbCmd.AddItem s
End Sub

'Add string into Error ListBox
Private Sub lbErrAdd(ByVal s As String)
     iTCnt2 = iTCnt2 + 1
     If iTCnt2 > 400 Then
        iTCnt2 = 1
        lbErr.Clear
     End If

     lbErr.AddItem s
End Sub

'increase the Error Counter
Private Sub lbErrAdd2(ByVal s As String)
     lErrCnts.Caption = Str(Val(lErrCnts.Caption) + 1)
     lbErrAdd s
End Sub

'convert the string to hex value's string
Private Function GetNS(NS As String) As String
   Dim i As Integer
   Dim AStr As String
   Dim AChar As String
      
   AStr = ""
   For i = 1 To 13
        AChar = Mid(NS, i, 1)
        AStr = AStr + Right("00" + Hex(Asc(AChar)), 2)
   Next
   
   GetNS = AStr
End Function

