VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form main2 
   Caption         =   "MVPDEMO 2000           Ver 1.0 "
   ClientHeight    =   6480
   ClientLeft      =   165
   ClientTop       =   450
   ClientWidth     =   7950
   Icon            =   "Main2.frx":0000
   ScaleHeight     =   6480
   ScaleWidth      =   7950
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer Timer1 
      Interval        =   50
      Left            =   7560
      Top             =   0
   End
   Begin VB.Frame Frame8 
      Height          =   6375
      Left            =   120
      TabIndex        =   0
      Top             =   0
      Width           =   7935
      Begin VB.CommandButton CmdExit 
         Height          =   615
         Left            =   6360
         Picture         =   "Main2.frx":0442
         Style           =   1  'Graphical
         TabIndex        =   45
         Top             =   360
         Width           =   735
      End
      Begin VB.CommandButton CmdTerminal 
         Height          =   615
         Left            =   4800
         Picture         =   "Main2.frx":0884
         Style           =   1  'Graphical
         TabIndex        =   44
         Top             =   360
         Width           =   735
      End
      Begin VB.Frame Frame7 
         Caption         =   "Status Description"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H8000000D&
         Height          =   1575
         Left            =   3240
         TabIndex        =   39
         Top             =   4680
         Visible         =   0   'False
         Width           =   4215
         Begin VB.ListBox List1 
            Height          =   840
            Left            =   120
            TabIndex        =   42
            ToolTipText     =   "Displays Status descripion when Queried"
            Top             =   240
            Width           =   1935
         End
         Begin VB.ListBox List2 
            Height          =   840
            Left            =   2040
            TabIndex        =   41
            ToolTipText     =   "Displays Status descripion when Queried"
            Top             =   240
            Width           =   2055
         End
         Begin VB.TextBox TextRecv 
            Height          =   285
            Left            =   120
            TabIndex        =   40
            Top             =   1200
            Width           =   2415
         End
         Begin VB.Label Label6 
            Caption         =   "Received Data"
            BeginProperty Font 
               Name            =   "MS Sans Serif"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   2640
            TabIndex        =   43
            Top             =   1200
            Width           =   1335
         End
      End
      Begin VB.Frame SendFrame 
         Caption         =   "Send Commands"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H8000000D&
         Height          =   3015
         Left            =   3240
         TabIndex        =   31
         Top             =   1560
         Width           =   4215
         Begin VB.ListBox CommandHistory 
            Height          =   1425
            Left            =   240
            TabIndex        =   36
            Top             =   480
            Width           =   2295
         End
         Begin VB.TextBox TransmitText 
            Height          =   375
            Left            =   240
            TabIndex        =   35
            Top             =   2280
            Width           =   2295
         End
         Begin VB.CommandButton CmdHelp 
            Caption         =   "Help"
            Height          =   375
            Left            =   2760
            TabIndex        =   34
            ToolTipText     =   "Click to view Help on commands available & Motor Connections"
            Top             =   480
            Width           =   1335
         End
         Begin VB.CommandButton CmdHome 
            Caption         =   "Home/Enable"
            Height          =   375
            Left            =   2760
            TabIndex        =   33
            ToolTipText     =   "Set Home Position 0, and Enable Output"
            Top             =   2280
            Width           =   1335
         End
         Begin VB.CommandButton CmdDisable 
            Height          =   375
            Left            =   2760
            Picture         =   "Main2.frx":0CC6
            Style           =   1  'Graphical
            TabIndex        =   32
            ToolTipText     =   "Disable Output"
            Top             =   1440
            Width           =   1335
         End
         Begin VB.Label Label2 
            Caption         =   "Command History"
            BeginProperty Font 
               Name            =   "MS Sans Serif"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   360
            TabIndex        =   38
            Top             =   240
            Width           =   1695
         End
         Begin VB.Label Label1 
            Caption         =   "Enter Command"
            BeginProperty Font 
               Name            =   "MS Sans Serif"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   240
            TabIndex        =   37
            Top             =   2040
            Width           =   1695
         End
      End
      Begin VB.Frame Frame1 
         Caption         =   "Configuration"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H8000000D&
         Height          =   3015
         Left            =   0
         TabIndex        =   18
         Top             =   4080
         Visible         =   0   'False
         Width           =   2535
         Begin VB.Frame Frame5 
            Caption         =   "Port"
            BeginProperty Font 
               Name            =   "MS Sans Serif"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   1695
            Left            =   120
            TabIndex        =   26
            Top             =   240
            Width           =   1095
            Begin VB.OptionButton OptCom1 
               Caption         =   "Com1"
               Height          =   195
               Left            =   120
               TabIndex        =   30
               Top             =   240
               Width           =   735
            End
            Begin VB.OptionButton Optcom2 
               Caption         =   "Com2"
               Height          =   195
               Left            =   120
               TabIndex        =   29
               Top             =   600
               Width           =   735
            End
            Begin VB.OptionButton Optcom3 
               Caption         =   "Com3"
               Height          =   255
               Left            =   120
               TabIndex        =   28
               Top             =   960
               Width           =   855
            End
            Begin VB.OptionButton Optcom4 
               Caption         =   "Com4"
               Height          =   195
               Left            =   120
               TabIndex        =   27
               Top             =   1320
               Width           =   855
            End
         End
         Begin VB.Frame Frame6 
            Caption         =   "Baud"
            BeginProperty Font 
               Name            =   "MS Sans Serif"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   1695
            Left            =   1320
            TabIndex        =   21
            Top             =   240
            Width           =   1095
            Begin VB.OptionButton Opt9600 
               Caption         =   "9600"
               Height          =   255
               Left            =   120
               TabIndex        =   25
               Top             =   240
               Width           =   735
            End
            Begin VB.OptionButton Opt19200 
               Caption         =   "19200"
               Height          =   255
               Left            =   120
               TabIndex        =   24
               Top             =   600
               Width           =   855
            End
            Begin VB.OptionButton Opt38400 
               Caption         =   "38400"
               Height          =   255
               Left            =   120
               TabIndex        =   23
               Top             =   960
               Width           =   855
            End
            Begin VB.OptionButton Opt57600 
               Caption         =   "57600"
               Height          =   195
               Left            =   120
               TabIndex        =   22
               Top             =   1320
               Width           =   855
            End
         End
         Begin VB.CommandButton CmdSaveConfig 
            Caption         =   "Save Configuration"
            Height          =   375
            Left            =   480
            TabIndex        =   20
            Top             =   2520
            Width           =   1695
         End
         Begin VB.CheckBox ChkStatus 
            Caption         =   "Show Status Description"
            Height          =   375
            Left            =   240
            TabIndex        =   19
            Top             =   2040
            Width           =   2055
         End
      End
      Begin VB.Frame Frame3 
         Caption         =   "Terminal"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H8000000D&
         Height          =   4095
         Left            =   240
         TabIndex        =   15
         Top             =   5160
         Visible         =   0   'False
         Width           =   6855
         Begin VB.TextBox TextTerminal 
            BackColor       =   &H00FF0000&
            ForeColor       =   &H80000005&
            Height          =   3495
            Left            =   240
            MultiLine       =   -1  'True
            ScrollBars      =   2  'Vertical
            TabIndex        =   17
            Top             =   360
            Width           =   6375
         End
         Begin VB.CommandButton CmdClearTerm 
            Caption         =   "Clear Terminal"
            Height          =   375
            Left            =   2640
            TabIndex        =   16
            Top             =   4200
            Width           =   1695
         End
      End
      Begin VB.CommandButton CmdManual 
         Height          =   615
         Left            =   3240
         Picture         =   "Main2.frx":27FC
         Style           =   1  'Graphical
         TabIndex        =   13
         Top             =   360
         Width           =   735
      End
      Begin VB.CommandButton CmdCommandFile 
         Height          =   615
         Left            =   1800
         Picture         =   "Main2.frx":2C3E
         Style           =   1  'Graphical
         TabIndex        =   11
         Top             =   360
         Width           =   735
      End
      Begin VB.Frame Frame4 
         Caption         =   "Command File "
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H8000000D&
         Height          =   4695
         Left            =   360
         TabIndex        =   3
         Top             =   1560
         Visible         =   0   'False
         Width           =   2535
         Begin VB.CommandButton DownloadButton 
            Caption         =   "Download File"
            BeginProperty Font 
               Name            =   "MS Sans Serif"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   375
            Left            =   240
            TabIndex        =   48
            Top             =   3960
            Width           =   1935
         End
         Begin VB.TextBox Filename 
            Height          =   375
            Left            =   120
            TabIndex        =   10
            Top             =   360
            Width           =   1455
         End
         Begin VB.CommandButton PauseCmd 
            Caption         =   "Pause"
            Enabled         =   0   'False
            Height          =   375
            Left            =   1680
            TabIndex        =   9
            Top             =   1560
            Width           =   735
         End
         Begin VB.CommandButton CancelCmd 
            Caption         =   "Cancel"
            Enabled         =   0   'False
            Height          =   375
            Left            =   1680
            TabIndex        =   8
            Top             =   2160
            Width           =   735
         End
         Begin VB.CommandButton EditCmd 
            Caption         =   "Edit"
            Height          =   375
            Left            =   1680
            TabIndex        =   7
            Top             =   360
            Width           =   735
         End
         Begin VB.CommandButton ExecuteCmdFile 
            Caption         =   "Execute"
            Height          =   375
            Left            =   1680
            TabIndex        =   6
            Top             =   960
            Width           =   735
         End
         Begin VB.FileListBox Filelist 
            Height          =   2625
            Left            =   120
            Pattern         =   "*.cmd"
            TabIndex        =   5
            Top             =   840
            Width           =   1455
         End
         Begin VB.CommandButton DeleteCmd 
            Caption         =   "Delete"
            Height          =   375
            Left            =   1680
            TabIndex        =   4
            Top             =   2760
            Width           =   735
         End
      End
      Begin VB.CommandButton CmdSetup 
         Height          =   615
         Left            =   360
         Picture         =   "Main2.frx":3080
         Style           =   1  'Graphical
         TabIndex        =   1
         Top             =   360
         Width           =   735
      End
      Begin VB.Label Label8 
         Caption         =   "Exit"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   6600
         TabIndex        =   47
         Top             =   1080
         Width           =   375
      End
      Begin VB.Label Label4 
         Caption         =   "Terminal"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   4800
         TabIndex        =   46
         Top             =   1080
         Width           =   735
      End
      Begin VB.Line Line1 
         X1              =   360
         X2              =   7320
         Y1              =   1440
         Y2              =   1440
      End
      Begin VB.Label Label5 
         Caption         =   "Manual"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   3360
         TabIndex        =   14
         Top             =   1080
         Width           =   615
      End
      Begin VB.Label Label3 
         Caption         =   "Command File"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   1560
         TabIndex        =   12
         Top             =   1080
         Width           =   1215
      End
      Begin VB.Label Label7 
         Caption         =   "Setup"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   480
         TabIndex        =   2
         Top             =   1080
         Width           =   495
      End
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   0
      Top             =   0
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   327681
      CommPort        =   2
      DTREnable       =   0   'False
      InBufferSize    =   10000
      BaudRate        =   38400
   End
End
Attribute VB_Name = "main2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'---------------------------------------------------------------------
'Description: The following source code provides a "sample" program written
'             to demonstrate communications with Faulhaber's 3556 Integral Controller.
'
'             The following communication parameters are set by default:
'                  COM2  9600,N,8,1

'             This program can be edited and
'             customized to fulfil any special requirements.
'---------------------------------------------------------------------
             
             



Dim record As DeclaredRecord  'declared in Global defs
Dim ConfigString As String * 500



Dim DefaultCom As DefaultComSettings

Dim just_sent As Integer
Dim sent$
Dim parse$

';;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



Dim Tempstring As String * 500
Dim Cbuf(64) As String * 1


Public ComPort As Integer
Public DdtestStr As String
'Public CurrVal As Integer
Public CurrVal As Long



Public MaskMatched As Boolean

Public keyclear As Boolean
Public temp$

Public RecDataNoCr$
Public ReceivedData$
Public testval As Long
Public ConfigFile As String

Public LoopCnt As Integer      'new by carlos
Public Tcmd As String      'new by carlos
Public RepeatCount As Integer      'new by carlos
Public Repeat_num As Integer      'new by carlos
Public RepeatStart As Integer   'new by carlos
Public RepeatEnd As Integer      'new by carlos

Sub SendLiteral()
Dim klim As Integer
Dim fspace As Integer
Dim Nspace As Integer
Dim arb As String
Dim K As Integer



 If MSComm1.PortOpen = False Then
  MsgBox "Serial Port not configured properly!", vbCritical
  Exit Sub
 End If
 

 DoEvents
 
klim = 6
If CommandHistory.ListCount < klim Then
       Else
          CommandHistory.RemoveItem 0
       End If
       CommandHistory.AddItem Cmd
           
'''''''''''''''''''''''''''''''''''''
           
 MSComm1.Output = Cmd
 just_sent = 1
     
 
 'make sure it goes out!
  Do While MSComm1.OutBufferCount > 0
     DoEvents
  Loop

 If ExecuteActive = False Then
  Exit Sub
 End If
 

End Sub
Sub ShowGFS()

Dim diagmsg As String
Dim ErrorPresent As Boolean
Dim K As Integer


'move status desc. frame
Frame7.Height = 1575
Frame7.Left = 3240
Frame7.Top = 4680
Frame7.Width = 4215

ErrorPresent = False


List1.Clear
List2.Clear

'''''''''' convert BIN to DEC  ''''''''''
DdtestStr = RecDataNoCr$

K = Len(DdtestStr)
CurrVal = 0
 
       While K > 0
           temp = Mid$(DdtestStr, K, 1)
           CurrVal = CurrVal + ((2 ^ (K - 1)) * Val(temp))
           K = K - 1
       Wend

testval = CurrVal
TextRecv.Text = "Bin " & RecDataNoCr$ & " (Dec " & Str$(testval) & ")"
''''''''''''''''''''''''''

If testval = 0 Then
  diagmsg = "No Faults Detected"
  List1.AddItem diagmsg
  
End If

If (testval And 1) Then
  ErrorPresent = True
  diagmsg = "Over-Temperature Fault"
  List1.AddItem diagmsg
  
End If

    
If (testval And 2) = 1 Then
  ErrorPresent = True
  diagmsg = "Over Current Fault"
  List1.AddItem diagmsg
End If
 
If (testval And 4) Then
   ErrorPresent = True
   diagmsg = "Under Voltage Fault (<15V)"
   List1.AddItem diagmsg
End If
    
  
If (testval And 8) Then
   ErrorPresent = True
   diagmsg = "Over Voltage Fault (>28V)"
   List1.AddItem diagmsg
End If


 If ErrorPresent = True Then
   List1.ForeColor = &HFF&  'red
   List2.ForeColor = &HFF&  'red
 Else
   List1.ForeColor = -2147483630 'black
   List2.ForeColor = -2147483630 'black
 End If



End Sub

Sub CheckForST()
    Dim fspace As Integer
    Dim CurrentNode As Integer
    Dim NodeStat As String * 1
    Dim Noarg As Boolean
    Dim Nspace As Integer
    Dim arb As String
    Dim temp As String
    Dim Ochr As String
    Dim Nchar As String * 1
    Dim Tl As Integer
    Dim Tdex As Integer
    Dim Rdex As Integer
    Dim Rword As String
    Dim Aword As String
    Dim kar As String * 1
    Dim DelimCount As Integer
    Dim Hlen As Integer
    Dim MiscCount As Long
    Dim Anode As String * 4
    Dim Thresh As Long
    
    
    Dim Resp As Integer
    
    Dim LastStatusCmd As String
    Dim RxCount As Long
    Dim ValCount As Long
    Dim Dnode As Long
    
    Dim Ddsub As Long
    Dim Hj As Integer
    Dim Hk As Integer
    Dim Term As Long
    Dim StatCase As Integer
    Dim StatTest As Integer
    Dim Jk As Integer

    Dim D As String
    Dim Wordlen As Integer
    Dim J As Integer
    Dim L As Integer
    Dim Currword As String
    Dim CurrAsc As Integer
    Dim CurrVal As Integer
    Dim SavVal As Integer
    Dim Cbuf(64) As String * 1
    Dim Longbuf As String
    Dim K As Integer
    Dim Rlim As Integer
    Dim Testmask As Long
    Dim Inputstat As Integer
    Dim UpperLim As Integer
    Dim Lk As Integer
    Dim LoopCount As Long
    Dim SuperCount As Long
    Dim Outvar As String
    Dim Char As String
    Dim SentMask As Boolean
    Dim getout As Boolean

                
                 
                Nspace = InStr(Cmd, " ")
                If Nspace > 0 Then
                   arb = UCase(Right$(Cmd, Len(Cmd) - Nspace))
                   
                    Mask = Val(arb)
                    LastArg = Mid$(Cmd, 1, Nspace - 1)
                    CompStr = ""
                Else
                   Mask = 0
                   Exit Sub
                End If
                                
     
            DdtestStr = RecDataNoCr$
            If Len(RecDataNoCr$) <= 2 Then
             Exit Sub
            End If

'''''''''' convert BIN to DEC  ''''''''''
DdtestStr = RecDataNoCr$

K = InStr(DdtestStr, " ")
CurrVal = 0
 
       
temp = Mid$(DdtestStr, K + 1, Len(DdtestStr))

'can't sort response that is not a "status" length
If Len(temp) > 4 Then
 Exit Sub
End If

CurrVal = Val("&H" + temp)

TextRecv.Text = RecDataNoCr$

'''''''''''''''''''''''''''''''''
                 StatCase = 0
                 StatTest = 0

'test for status mask inside a command file
                 While StatCase < MaskCount(Cline) And StatTest = 0
                    StatCase = StatCase + 1
                    Testmask = CurrVal
                    If MaskArray(Cline, StatCase) = 0 Then GoTo skipck
                    
                    If (Testmask = MaskArray(Cline, StatCase)) Then
                    
                     'if status mask matches resp.
                       StatTest = StatCase
                       MaskMatched = True
                                          
                       If Len(MaskLabel(Cline, StatCase)) <> 0 Then
                          

'we come here when mask matches & we branch
                          Jk = 0
                          While Jk < labdex
                             Jk = Jk + 1
                             If MaskLabel(Cline, StatCase) = LabArray(LabRef(Jk)) Then
                                Cline = LabRef(Jk) - 1

                             End If
                          Wend
                       End If
                    Else
                     MaskMatched = False
                    End If
skipck:
                 Wend
                             
skiptx:
End Sub
Sub showdiag()

Dim diagmsg As String
Dim ErrorPresent As Boolean
Dim K As Integer


'move status desc. frame
Frame7.Height = 1575
Frame7.Left = 3240
Frame7.Top = 4680
Frame7.Width = 4215


ErrorPresent = False


List1.Clear
List2.Clear

'''''''''' convert BIN to DEC  ''''''''''
DdtestStr = RecDataNoCr$

K = InStr(DdtestStr, " ")
CurrVal = 0
 
       
temp = Mid$(DdtestStr, K + 1, Len(DdtestStr))
 
CurrVal = Val("&H" + temp)

TextRecv.Text = RecDataNoCr$
''''''''''''''''''''''''''

If (CurrVal And &H1) Then
  diagmsg = "Move in progress"
Else
  'diagmsg = "Not moving"
  diagmsg = "Motor Stopped"
End If
  List1.AddItem diagmsg
  
  
If (CurrVal And &H2) Then
  diagmsg = "In position"
Else
  diagmsg = "Out of Position"
End If
  List1.AddItem diagmsg

 
If (CurrVal And &H4) Then
  diagmsg = "Velocity Mode"
Else
  diagmsg = "Position Mode"
End If
List1.AddItem diagmsg

 
 
'If (CurrVal And &H8) Then
'  diagmsg = "Command Recognized"
'Else
'  diagmsg = "Command discarded"
'End If
' List1.AddItem diagmsg
 
 
If (CurrVal And 16) Then
  diagmsg = "*** Trajectory percent complete ***"
  List1.AddItem diagmsg
'Else
'  diagmsg = "Trajectory percent not completed"
End If
 
  
   
'If (CurrVal And 32) Then
'  diagmsg = "DeviceNet Active"
'Else
'  diagmsg = "DeviceNet Active"
'End If
' List1.AddItem diagmsg
   
If (CurrVal And 64) Then
  diagmsg = "*** DeviceNet Error ***"
   ErrorPresent = True
   List1.AddItem diagmsg
End If

   
If (CurrVal And 128) Then
  ErrorPresent = True
  diagmsg = "*** Following Error ***"
  List1.AddItem diagmsg
End If
   
If (CurrVal And 256) Then
   ErrorPresent = True
   diagmsg = "*** Drive disabled ***"
   List1.AddItem diagmsg
Else
   diagmsg = "Drive Enabled"
   List1.AddItem diagmsg
End If


If (CurrVal And 512) Then
   ErrorPresent = True
   diagmsg = "*** Range Limit Reached ***"
   List2.AddItem diagmsg
End If

If (CurrVal And 1024) Then
   diagmsg = "Local Mode active"
Else
   diagmsg = "Remote Mode active"
End If
List2.AddItem diagmsg

If (CurrVal And 2048) Then
   diagmsg = "*** Emergency Stop active ***"
   ErrorPresent = True
   List2.AddItem diagmsg
End If


If (CurrVal And 4096) Then
    diagmsg = "*** External Event#1 (J2-8) active ***"
    ErrorPresent = True
   List2.AddItem diagmsg
End If

If (CurrVal And 8192) Then
   diagmsg = "*** Positive Limit active ***"
   ErrorPresent = True
   List2.AddItem diagmsg
End If

If (CurrVal And 16384) Then
   ErrorPresent = True
   diagmsg = "*** External Event#2 (J2-7) active ***"
   List2.AddItem diagmsg
End If

If (CurrVal And 32768) Then
   ErrorPresent = True
   diagmsg = "*** Negative Limit active ***"
   List2.AddItem diagmsg
End If


 If ErrorPresent = True Then
   List1.ForeColor = &HFF&  'red
   List2.ForeColor = &HFF&  'red
 Else
   List1.ForeColor = -2147483630 'black
   List2.ForeColor = -2147483630 'black
 End If


End Sub
Private Sub viewbuffer()
Dim tj As Integer
Dim ttbuf As String
Dim comp As String

        tj = InStr(buf, Chr$(13))
         
         If tj = 0 Then GoTo noshow3
         
     Do While Len(buf) >= 2
         tj = InStr(buf, Chr$(13))
         If tj = 1 Then
          
          buf = Mid$(buf, tj + 1, Len(buf))
         End If
         
         If tj = 0 Then Exit Sub
         
         ttbuf = Mid$(buf, 1, tj)
         ttbuf = Mid$(ttbuf, 1, Len(ttbuf) - 1)
         
    
         buf = Mid$(buf, Len(ttbuf) + 2, Len(buf))
         
         ''ttbuf = buf   'NEW
         ttbuf = ttbuf   'old
         
'get rid of CR & LF on 1st char.
         comp = Mid$(ttbuf, 1, 1)
         If comp = Chr$(10) Or comp = Chr$(13) Then
          ttbuf = Mid$(ttbuf, 2, Len(ttbuf))
         End If
         
'stop overflow form occurring
         If Len(TextTerminal.Text) > 1000 Then
          TextTerminal = ""
         End If
         
         TextTerminal.Text = TextTerminal.Text & Chr$(13) & Chr$(10) & ttbuf & Chr$(13) & Chr$(10)
         
     Loop
     
noshow3:
End Sub



Sub ExitProgram()

 Unload Me
 
 utility.exitall  'unload API
 
 End

End Sub

Sub ParseCommandFile()
    Dim kk As Integer
    Dim Jpos As Integer
    Dim Cpos As Integer
    Dim Tpos As Integer
    Dim Notab As Integer
    Dim StatPos As Integer
    Dim Dcount As Integer
    Dim Dpos As Integer
    Dim LastTpos As Integer
    Dim OutOfJumps As Integer
    Dim LastJump As Integer
    Dim Clen As Integer
    Dim NextCommand As String
    
    kk = 0
    While kk < 8
       kk = kk + 1
       LabRef(kk) = 0
    Wend
    kk = 0
        
    While kk < ArrayLength
       kk = kk + 1
       LabArray(kk) = ""
       Carray(kk) = ""
    Wend

    'FIND LABELS
    kk = 0
    labdex = 0
    While kk < Bline
       kk = kk + 1
       Cpos = InStr(OArray(kk), ":")

       Tpos = 0
       Notab = 0
       While Notab = 0
       LastTpos = Tpos
       Tpos = InStr(LastTpos + 1, OArray(kk), Chr(9))
       If Tpos = 0 Then
          Notab = 1
       End If
    Wend
         
    If Cpos > 1 Then
       labdex = labdex + 1
       LabArray(kk) = UCase(Left$(OArray(kk), Cpos - 1))
       LabRef(labdex) = kk
    End If
    If LastTpos > Cpos Then
       Carray(kk) = LTrim$(Right$(OArray(kk), Len(OArray(kk)) - LastTpos))
    Else
       If Cpos > 0 Then
         Carray(kk) = LTrim$(Right$(OArray(kk), Len(OArray(kk)) - Cpos))
       Else
          Carray(kk) = OArray(kk)
       End If
    End If
 Wend

 kk = 0
 While kk < Bline
    kk = kk + 1
    
    StatPos = InStr(UCase(Carray(kk)), " ST ")
    If StatPos > 0 Then
       OutOfJumps = 0
       Jpos = StatPos + 3
       Dcount = 0
       
       While OutOfJumps = 0 And Dcount < 16
          LastJump = Jpos
          Jpos = InStr(LastJump + 1, Carray(kk), " ")
          If Jpos = 0 Then
             OutOfJumps = 1
             Clen = Len(Carray(kk))
             If LastJump < Clen Then
                NextCommand = RTrim$(LTrim$(Mid$(Carray(kk), LastJump, Clen - LastJump + 1)))
                If Len(NextCommand) > 0 Then
                   GoSub HandleMask
                End If
             End If
          Else
              NextCommand = RTrim$(LTrim$(Mid$(Carray(kk), LastJump, Jpos - LastJump + 1)))
              If Len(NextCommand) > 0 Then
                 GoSub HandleMask
              End If
          End If
       Wend
       End If
    Wend
    Exit Sub

HandleMask:
        Dcount = Dcount + 1
        
        Dpos = InStr(NextCommand, ">")
        If Dpos > 0 Then
           MaskArray(kk, Dcount) = Val(Left$(NextCommand, Dpos - 1))
           
           MaskLabel(kk, Dcount) = UCase(Right$((Mid$(NextCommand, Dpos + 1, Len(NextCommand) - Dpos)), Len(NextCommand) - Dpos))
           MaskCount(kk) = Dcount
           
        Else
           MaskArray(kk, Dcount) = Val(NextCommand)
           MaskLabel(kk, Dcount) = ""
           MaskCount(kk) = Dcount
        End If
        
        Return
    



End Sub
Sub RepeatMech()
    Dim Hcurr As Integer
    Dim CmdLine As String
    Dim J As Integer
    Dim X As Integer
    Dim Y As Integer
    Dim Z As Integer
    Dim DoRepeat As Boolean
    Dim B As String
    Dim Dl As Integer
    Dim Delcount As Long
    Dim Jlong As Long
    Dim dr As Integer
    Dim klim As Integer
    Dim Colon1, Colon2 As Integer
    Dim K As Integer
    Dim Tstring As String
    Dim Char As String * 1
      
      B = Carray(Cline)
      B = Carray(Cline)
      Cmd = B

'''''''''''''''''''CHECK FOR DELAY '''''''''''''''''''''''''''
       Dl = InStr(UCase(B), "DELAY")
       If Dl > 0 Then
          'GET ACTUAL DELAY
          Delcount = Val(Right$(B, Len(B) - Dl - 5))
           TimerCount = 0
           'fudge factor
           Delcount = Int((Delcount / 10) * 1.3)
         Do While Delcount > 0
           DoEvents
           If TimerCount > 1 Then
           Delcount = Delcount - TimerCount
           TimerCount = 0
           End If
         Loop
        End If
''''''''''''''''''''''''''''''''''''''''''''''''
      
''''''''''''''''''' regular checks '''''''''''''''''
      Cmd = B
      If InStr(UCase(B), "PAUSE") > 0 Then
            MsgBox "Pause"
      Else
        
      
            X = (InStr(B, Chr$(34))) 'are there QUOTES?
            If X <> 0 Then
              B = Mid$(B, X + 1, Len(B))
              X = (InStr(B, Chr$(34)))
              If X > 2 Then       'figure out if there are up to
                                  '2 more control chars separated
                                  'by commas EX: "hello",13,10
                                  
               B = Mid$(B, 1, (X - 1))
               
               Y = InStr(Cmd, ",")
               If Y > X Then
                Cmd = Mid$(Cmd, Y + 1, Len(Cmd))
                
                Y = InStr(Cmd, ",")
                Z = Y
                Y = Val(Mid$(Cmd, 1, Y))
                
                Cmd = Mid$(Cmd, Z + 1, Len(Cmd))
                
                Z = Val(Cmd)
                
               End If
               
               
              End If
              
             Cmd = B + Chr$(Y) + Chr$(Z)
             SendLiteral
            Else
             SendCommand
            End If
          'if in continuous repeat loop
          'send a new msg every time slice
          'to let us sort recv. response
            TimerCount = 0
wait:
            DoEvents
            'was 5
            If TimerCount < 1 Then GoTo wait
            
     End If
End Sub

Sub ExecuteCommands()

    Dim Hcurr As Integer
    Dim CmdLine As String
    Dim J As Integer
    Dim X As Integer
    Dim Y As Integer
    Dim Z As Integer
    Dim DoRepeat As Boolean
    Dim B As String
    Dim Dl As Integer
    Dim Delcount As Long
    Dim Jlong As Long
    Dim dr As Integer
    Dim klim As Integer
    Dim Colon1, Colon2 As Integer
    Dim K As Integer
    Dim Tstring As String
    Dim Tmpstring As String
    Dim ExtraString As String
    
    
    Dim Char As String * 1
    
    AppFileName = App.Path
    If Right$(AppFileName, 1) <> "\" Then
       AppFileName = AppFileName + "\" + filename.Text
    Else
       AppFileName = AppFileName + filename.Text
    End If
    
    Hcurr = FreeFile
    Open AppFileName For Binary Shared As Hcurr
    If LOF(Hcurr) = 0 Then
       MsgBox ("Command file is empty.")
       Close
       Exit Sub
    End If
    Close Hcurr
    
    ExecuteActive = True
    
    
    
    
    dr = MsgBox("Do you want execution of this command file to repeat continuously? ", vbYesNoCancel) 'vbYesNo)
    
    If dr = 2 Then  'if cancel
     GoTo noexec 'Exit Sub
    End If
     
    
    If dr = 6 Then             'if yes=6
       RepeatStat = True       'if no=7
    Else
       RepeatStat = False
    End If
           
    
'disable other functions while running cmd file!




EditCmd.Enabled = False
ExecuteCmdFile.Enabled = False
DeleteCmd.Enabled = False

filename.Enabled = False
Filelist.Enabled = False
    
PauseCmd.Enabled = True
PauseCmd.SetFocus
CancelCmd.Enabled = True

'************* open file  *******

    Hcurr = FreeFile
    Open AppFileName For Input Shared As Hcurr
    Bline = 0
    While Not EOF(Hcurr)
       Line Input #Hcurr, CmdLine
       
       
       If Len(RTrim$(CmdLine)) > 0 Then
          If InStr(CmdLine, "/*") > 1 Then
             CmdLine = Left$(CmdLine, InStr(CmdLine, "/*") - 1)
          End If
          K = 0
          Tstring = ""
          Do While K < Len(CmdLine)
             K = K + 1
             Char = Mid$(CmdLine, K, 1)
             If Char = Chr$(9) Then  'look for TAB
                Tstring = Tstring + " "
             Else
                Tstring = Tstring + Char
             End If
          Loop
          If InStr(Tstring, "/*") = 0 Then
             Bline = Bline + 1
             OArray(Bline) = RTrim$(Tstring)
          End If
        
          X = InStr(UCase(Tstring), "REPEAT ")
          If X > 0 Then
           RepeatStart = Bline + 1
           RepeatCount = Val(Mid$(Tstring, X + 6, Len(Tstring)))
           RepeatCount = RepeatCount - 1
           LoopCnt = 1
          End If

          

          X = InStr(UCase(Tstring), "REND")
          If X > 0 Then
           RepeatEnd = Bline
          End If
          
       End If
    Wend
    Close Hcurr

    ParseCommandFile
    
'**********
Stat = 0

klim = 6

    Cline = 0
    While (RepeatStat Or Cline < Bline) And Stat = 0 And Not CancelEvent
        
      Cline = Cline + 1
      If Cline = Bline + 1 And RepeatStat Then
        Cline = 1
      End If


'********************* REPEAT MECHANISM  ******************
'anything added to this EXECUTE COMMANDS routine must be added
'to REPEATMECH routine
       Repeat_num = RepeatCount
     
       While (Cline = RepeatStart) And Repeat_num <> 0 And Not CancelEvent
        
        Repeat_num = Repeat_num - 1
                
         While RepeatEnd <> Cline
          Call RepeatMech         'mini version of this
          Cline = Cline + 1       'EXECUTE COMMANDS routine
         Wend
        
         LoopCnt = LoopCnt + 1
         Cline = RepeatStart
              
       Wend
       
         
        If RepeatEnd = Cline Then  'when REND is reached reset Loopcnt
         LoopCnt = 1   'after REND reset LoopCnt
        End If
'***********************************************************
      B = Carray(Cline)
      Cmd = B

'''''''''''''''''''CHECK FOR DELAY '''''''''''''''''''''''''''
       Dl = InStr(UCase(B), "DELAY")
       If Dl > 0 Then
          'GET ACTUAL DELAY
          Delcount = Val(Right$(B, Len(B) - Dl - 5))
           TimerCount = 0
           'fudge factor
           Delcount = Int((Delcount / 10) * 1.3)
         Do While Delcount > 0
           DoEvents
           If TimerCount > 1 Then
           Delcount = Delcount - TimerCount
           TimerCount = 0
           End If
         Loop
        End If
''''''''''''''''''''''''''''''''''''''''''''''''
      If InStr(UCase(B), "PAUSE") > 0 Then
            MsgBox "Pause"
      Else
        
      
            X = (InStr(B, Chr$(34))) 'are there QUOTES?
            If X <> 0 Then
              B = Mid$(B, X + 1, Len(B))
              X = (InStr(B, Chr$(34)))
              If X > 2 Then       'figure out if there are up to
                                  '2 more control chars separated
                                  'by commas EX: "hello",13,10
                                  
               B = Mid$(B, 1, (X - 1))
               
               Y = InStr(Cmd, ",")
               If Y > X Then
                Cmd = Mid$(Cmd, Y + 1, Len(Cmd))
                
                Y = InStr(Cmd, ",")
                Z = Y
                Y = Val(Mid$(Cmd, 1, Y))
                
                Cmd = Mid$(Cmd, Z + 1, Len(Cmd))
                
                Z = Val(Cmd)
                
               End If
               
               
              End If
              
             Cmd = B + Chr$(Y) + Chr$(Z)
             SendLiteral
            Else
             SendCommand
            End If
          'if in continuous repeat loop
          'send a new msg every time slice
          'to let us sort recv. response
            TimerCount = 0
wait:
            DoEvents
            'was 5
            If TimerCount < 1 Then GoTo wait
            
      End If
    Wend
       
noexec:

'''''''
EditCmd.Enabled = True
ExecuteCmdFile.Enabled = True
DeleteCmd.Enabled = True

PauseCmd.Enabled = False
CancelCmd.Enabled = False

filename.Enabled = True
Filelist.Enabled = True

CancelEvent = True
ExecuteActive = False

TransmitText.Enabled = True

CmdManual.Enabled = True
CmdTerminal.Enabled = True
CmdHome.Enabled = True
DownloadButton.Enabled = True


  


End Sub

Sub SendCommand()
Dim klim As Integer
Dim fspace As Integer
Dim Nspace As Integer
Dim arb As String
Dim K As Integer
Dim X As Integer
Dim Z As Integer

Dim Tmpstring As String
Dim ExtraString As String



 MaskMatched = False

 If MSComm1.PortOpen = False Then
  MsgBox "Serial Port not configured properly!", vbCritical
  Exit Sub
 End If
 
resend:

 DoEvents
 
klim = 6
If CommandHistory.ListCount < klim Then
       Else
          CommandHistory.RemoveItem 0
       End If
       CommandHistory.AddItem Cmd
           
''''''''''''''''''''''''''''''''''''
           X = InStr(UCase(Cmd), "+REPEAT")
          If X > 0 Then
           Tmpstring = Left(Cmd, (Len(Cmd) - (Len(Cmd) - (X - 1))))
           ExtraString = Tmpstring
          
            'first space
            Tmpstring = Mid$(Tmpstring, 3, Len(Tmpstring))
           
            X = InStr(UCase(Tmpstring), " ")
            Z = X + 2 'where 2nd space was found
            
            If X > 0 Then 'second space Parameter follows..
             X = Val(Mid$(Tmpstring, X, Len(Tmpstring))) + LoopCnt
             
             Cmd = Mid$(Cmd, 1, Z)
             
             Cmd = Cmd & Trim(Str$(X))
             
            End If
           
          End If
          
           X = InStr(UCase(Cmd), "-REPEAT")
          If X > 0 Then
           Tmpstring = Left(Cmd, (Len(Cmd) - (Len(Cmd) - (X - 1))))
           ExtraString = Tmpstring
          
            'first space
            Tmpstring = Mid$(Tmpstring, 3, Len(Tmpstring))
           
            X = InStr(UCase(Tmpstring), " ")
            Z = X + 2 'where 2nd space was found
            
            If X > 0 Then 'second space Parameter follows..
             X = Val(Mid$(Tmpstring, X, Len(Tmpstring))) - LoopCnt
             
             Cmd = Mid$(Cmd, 1, Z)
             
             Cmd = Cmd & Trim(Str$(X))
             
            End If
           
          End If
          
          

          X = InStr(UCase(Cmd), "*REPEAT")
          If X > 0 Then
           Tmpstring = Left(Cmd, (Len(Cmd) - (Len(Cmd) - (X - 1))))
           ExtraString = Tmpstring
          
            'first space
            Tmpstring = Mid$(Tmpstring, 3, Len(Tmpstring))
           
            X = InStr(UCase(Tmpstring), " ")
            Z = X + 2 'where 2nd space was found
            
            If X > 0 Then 'second space Parameter follows..
             X = Val(Mid$(Tmpstring, X, Len(Tmpstring))) * LoopCnt
             
             Cmd = Mid$(Cmd, 1, Z)
             
             Cmd = Cmd & Trim(Str$(X))
             
            End If
           
          End If
          
          
          X = InStr(UCase(Cmd), "%REPEAT")
          If X > 0 Then
           Tmpstring = Left(Cmd, (Len(Cmd) - (Len(Cmd) - (X - 1))))
           ExtraString = Tmpstring
          
            'first space
            Tmpstring = Mid$(Tmpstring, 3, Len(Tmpstring))
           
            X = InStr(UCase(Tmpstring), " ")
            Z = X + 2 'where 2nd space was found
            
            If X > 0 Then 'second space Parameter follows..
             X = Val(Mid$(Tmpstring, X, Len(Tmpstring))) / LoopCnt
             
             Cmd = Mid$(Cmd, 1, Z)
             
             Cmd = Cmd & Trim(Str$(X))
             
            End If
           
          End If
          
          
'''''''''''''''''''''''''''''''''''''
     Tcmd = ""
     X = InStr(UCase(Cmd), " ST ")
     If X <> 0 Then
      Tcmd = Mid$(Cmd, 1, 4)
      MSComm1.Output = Chr$(13) & Tcmd & Chr$(13)
     Else
       MSComm1.Output = Chr$(13) & Cmd & Chr$(13)
     End If
           
 just_sent = 1
     

 
 'make sure it goes out!
  Do While MSComm1.OutBufferCount > 0
     DoEvents
  Loop

 If ExecuteActive = False Then
  Exit Sub
 End If
 
 If InStr(UCase(Cmd), "ST ") > 0 Then
  If MaskMatched = False Then
          'if in continuous repeat loop
          'send a new msg every time slice
          'to let us sort recv. response
            TimerCount = 0
wait2:
            DoEvents
            'was 5
            If TimerCount < 1 Then GoTo wait2
     GoTo resend
  End If
 End If
  

End Sub



Private Sub CancelCmd_Click()

EditCmd.Enabled = True
ExecuteCmdFile.Enabled = True
DeleteCmd.Enabled = True

PauseCmd.Enabled = False
CancelCmd.Enabled = False

filename.Enabled = True
Filelist.Enabled = True

CancelEvent = True
ExecuteActive = False

TransmitText.Enabled = True

CmdManual.Enabled = True
CmdTerminal.Enabled = True
CmdHome.Enabled = True


End Sub

Private Sub ChkStatus_Click()
 List1.Clear
 List2.Clear
 TextRecv.Text = ""
End Sub


Private Sub CmdClearTerm_Click()
'clear terminal button
 TextTerminal.Text = ""
 TextTerminal.SetFocus

End Sub

Private Sub CmdCommandFile_Click()

'disable configuration frame if visible
Frame1.Visible = False

'disable terminal frame if visible
Frame3.Visible = False

'enable frame4 (command file)
Frame4.Visible = True

'enable cmd history frame
SendFrame.Visible = True





End Sub

Private Sub CmdDisable_Click()
'disable button
 Cmd = "0 DI"
 SendCommand
 
If ExecuteActive = True Then
    EditCmd.Enabled = True
    ExecuteCmdFile.Enabled = True
    DeleteCmd.Enabled = True
    
    PauseCmd.Enabled = False
    CancelCmd.Enabled = False
    
    filename.Enabled = True
    Filelist.Enabled = True
    
    CancelEvent = True
    
    ExecuteActive = False
    
    CmdManual.Enabled = True
    CmdTerminal.Enabled = True
    CmdHome.Enabled = True
End If

    TransmitText.Enabled = True
    TransmitText.SetFocus
 

End Sub

Private Sub CmdExit_Click()

 Call ExitProgram

End Sub

Private Sub CmdHelp_Click()


 
 Form2.Show
 Form2.Visible = True
 Form2.SetFocus


End Sub

Private Sub CmdHome_Click()


'home enable button
Cmd = "0 HO"
SendCommand

Cmd = "0 EN"
SendCommand

TransmitText.SetFocus

End Sub


Private Sub CmdManual_Click()
'disable configuration frame if visible
Frame1.Visible = False

'disable terminal frame if visible
Frame3.Visible = False

'enable frame4 (command file)
Frame4.Visible = True

'enable manual command
SendFrame.Visible = True
TransmitText.SetFocus




End Sub

Private Sub CmdSaveConfig_Click()
Dim configinfo$
Dim Hcmd As Long
Dim position As Integer



'save configuration settings
Frame1.Visible = False


''''''''' save config info  ''''''
If OptCom1.Value = True Then configinfo$ = "Com1" & Chr$(13) & Chr$(10)
If Optcom2.Value = True Then configinfo$ = "Com2" & Chr$(13) & Chr$(10)
If Optcom3.Value = True Then configinfo$ = "Com3" & Chr$(13) & Chr$(10)
If Optcom4.Value = True Then configinfo$ = "Com4" & Chr$(13) & Chr$(10)

If Opt9600.Value = True Then configinfo$ = configinfo$ & "9600" & Chr$(13) & Chr$(10)
If Opt19200.Value = True Then configinfo$ = configinfo$ & "19200" & Chr$(13) & Chr$(10)
If Opt38400.Value = True Then configinfo$ = configinfo$ & "38400" & Chr$(13) & Chr$(10)
If Opt57600.Value = True Then configinfo$ = configinfo$ & "57600" & Chr$(13) & Chr$(10)

If ChkStatus.Value = 1 Then configinfo$ = configinfo$ & "status" & Chr$(13) & Chr$(10)

 

AppFileName = App.Path & "\" & ConfigFile

Hcmd = FreeFile

' Open sample file for random access.
Open AppFileName For Random As Hcmd Len = Len(record)


Tempstring = configinfo$

position = 1
'store up to 500 string chars..
Put Hcmd, position, Tempstring   ' Read third record.

' Close file.
 Close Hcmd


End Sub

Private Sub CmdSetup_Click()
'disable terminal frame if visible
Frame3.Visible = False
Frame4.Visible = False


Frame1.Height = 3015
Frame1.Left = 360
Frame1.Top = 1560
Frame1.Width = 2535

Frame1.Visible = True

SendFrame.Visible = True  'enable cmd history




End Sub

Private Sub CmdTerminal_Click()

'enable terminal frame & set position
Frame3.Visible = True
Frame3.Height = 4695
Frame3.Left = 360
Frame3.Top = 1560
Frame3.Width = 6855

Frame1.Visible = False  'disable config if active



TextTerminal.SetFocus

ReceivedData$ = ""
RecDataNoCr$ = ""
Cmd = ""
buf = ""
just_sent = 0

End Sub


Private Sub DeleteCmd_Click()
    Dim D As Long
    Dim dr As Integer
    Dim TestFileName As String
    Dim Htest As Integer
    Dim Hcmd As Integer
    Dim Hedit As Integer
    
    AppFileName = App.Path
    If Right$(AppFileName, 1) <> "\" Then
       AppFileName = AppFileName + "\" + filename.Text
    Else
       AppFileName = AppFileName + filename.Text
    End If
    
'check to make sure this is what user wants
  dr = MsgBox("Are you sure you want to delete " & UCase(filename.Text) & "?", vbYesNo + vbQuestion)
  
       
    If dr = 6 Then             'if yes=6
        Kill AppFileName       'if no=7
    End If
    
'clear file name box
    filename.Text = ""
   
nokill:
   'refresh list of command files
   
    
    Filelist.Pattern = "*.Cmd"
    Filelist.Refresh
   


End Sub

Private Sub DownloadButton_Click()

 main2.Enabled = False

 utility.Show

End Sub

Private Sub EditCmd_Click()
Dim D As Long

If filename.Text = "" Then
  MsgBox "Please select a file or Enter new file name!"
  Exit Sub
Else
    Filelist.Path = App.Path
    
    AppFileName = Filelist.Path + "\" + filename.Text
End If

If AppFileName <> "" Then
  D = Shell("notepad " + AppFileName, vbNormalFocus)
Else
  MsgBox "Cannot locate file!"
End If


End Sub

Private Sub ExecuteCmdFile_Click()
  
'if port not opened we should not be here
    If MSComm1.PortOpen = False Then
     MsgBox "Please check Port Configuration", vbExclamation
     Exit Sub
    End If
    
    CancelEvent = False
    
    TransmitText.Enabled = False
    CmdManual.Enabled = False
    CmdTerminal.Enabled = False
    CmdHome.Enabled = False
    DownloadButton.Enabled = False
    
    
    
    
    
    Openport
    ExecuteCommands
End Sub

Private Sub Filelist_Click()
    Filelist.Path = App.Path
    filename.Text = Filelist.List(Filelist.ListIndex)
    
End Sub

Private Sub Form_Load()
 
Dim readtemp As String
Dim Hcmd As Long
Dim position  As Integer
Dim K As Integer




 Hcmd = FreeFile
 ConfigFile = "mvp2kcfg.dat"
 AppFileName = App.Path & "\" & ConfigFile

'read config file if it exists
   Open AppFileName For Binary Shared As Hcmd
    If LOF(Hcmd) = 0 Then
    'COM2 & 9600 BAUD DEFAULT
     ComPort = 2
     Optcom2.Value = True
     Opt9600.Value = True
     GoTo got_config
    End If
   Close Hcmd
    
'''''''' read config file  '''''''


AppFileName = App.Path & "\" & ConfigFile


Hcmd = FreeFile
' Open sample file for random access.
Open AppFileName For Random As Hcmd Len = Len(record)
               

position = 1    ' Define record number

'store up to 500 string chars..
Get Hcmd, position, Tempstring  ' Read 1st record.

' Close file.
 Close Hcmd

K = InStr(Tempstring, Chr$(10))
If K = 0 Then GoTo got_config

readtemp = Mid$(Tempstring, 1, K - 2)
If UCase(readtemp) = "COM1" Then ComPort = 1: OptCom1.Value = True
If UCase(readtemp) = "COM2" Then ComPort = 2: Optcom2.Value = True
If UCase(readtemp) = "COM3" Then ComPort = 3: Optcom3.Value = True
If UCase(readtemp) = "COM4" Then ComPort = 4: Optcom4.Value = True


'resize
Tempstring = Mid$(Tempstring, K + 1, Len(Tempstring))

K = InStr(Tempstring, Chr$(10))
If K = 0 Then GoTo got_config

readtemp = Mid$(Tempstring, 1, K - 2)

If UCase(readtemp) = "9600" Then Opt9600.Value = True
If UCase(readtemp) = "19200" Then Opt19200.Value = True
If UCase(readtemp) = "38400" Then Opt38400.Value = True
If UCase(readtemp) = "57600" Then Opt57600.Value = True


'resize
Tempstring = Mid$(Tempstring, K + 1, Len(Tempstring))

K = InStr(Tempstring, Chr$(10))

If K = 0 Then GoTo got_config

readtemp = Mid$(Tempstring, 1, K - 2)
If UCase(readtemp) = "STATUS" Then ChkStatus.Value = 1


'''''''''''''''''''''''''''''''
got_config:
'''''''''''''''''''''''''''''''
 
 Filelist.Path = App.Path
 Filelist.Pattern = "*.cmd"
 

 'fill in filename text box on boot
    If Filelist.ListCount <> 0 Then
     Filelist.ListIndex = 0
     AppFileName = ""
     Filelist.Path = App.Path
     filename.Text = Filelist.List(Filelist.ListIndex)
     AppFileName = Filelist.Path + "\" + AppFileName + Filelist.List(Filelist.ListIndex)
    End If
 
            


          
 
 
 
End Sub

Private Sub Form_Paint()
Dim HalfX, HalfY    ' Declare variables.

'clear Form's private memory
   Set main = Nothing
   
    Filelist.Pattern = "*.Cmd"
    Filelist.Refresh
    
    

End Sub

Private Sub Form_Resize()

Dim J As Long
Dim K As Long

Exit Sub

main2.Refresh


  J = ScaleHeight
  K = ScaleWidth

 If J = 7395 Then
  
  Frame8.Left = 120
 Else
  Frame8.Left = 1920
 End If
 
  



End Sub

Private Sub Form_Terminate()

If MSComm1.PortOpen = True Then
 MSComm1.PortOpen = False
End If

Unload Me

End
 
 
End Sub






Private Sub MSComm1_OnComm()

Dim K As Integer
Dim kar As String
Dim CurrVal As Integer





   Select Case MSComm1.CommEvent
        Case comEvReceive   ' Received RThreshold # of
        GoTo ReceiveData
                                ' chars.
   End Select

Exit Sub
'========================================================================
'              RECEIVING MESSAGES FROM THE MVP
'========================================================================
ReceiveData:

If utility.Visible = False Then
'if terminal frame showing..
      If Frame3.Visible = True Then
          If MSComm1.PortOpen Then
              'if keyclear Then
             If (MSComm1.InBufferCount > 0) Or keyclear Then
             
                MSComm1.InputLen = 0
                nstring = MSComm1.Input
                buf = buf + nstring
                
               K = InStr(buf, Chr$(13))
               If K = 0 Then
                GoTo NotComplete
               End If
                
'if we find an "echo" of our transmitted
'command delete it from our received data
             K = InStr(buf, Cmd)
             If K <> 0 Then
               K = InStr(buf, "00")  'look for node
               If K = 0 Then
                GoTo NotComplete
               End If
               
               buf = Mid$(buf, K, Len(buf))
               Cmd = ""  'already found so clear it
               K = InStr(buf, Chr$(13))
               If K = 0 Then
                GoTo NotComplete
               End If
             End If
             

              Cmd = ""  'already found so clear it
                
                K = 0
                If Len(buf) > 1 And InStr(buf, Chr$(13)) > 0 Then
                 Call viewbuffer
                 TextTerminal.SelStart = Len(TextTerminal) + 1
                End If
                
                DoEvents
                buf = ""
             End If

       
             ReceivedData$ = ""
             RecDataNoCr$ = ""
             just_sent = 0
             GoTo NotComplete
          End If
      End If
       
        
        
        MSComm1.InputLen = 0
        buf = MSComm1.Input
        
                
        K = MSComm1.InBufferCount
        'store all
        ReceivedData$ = ReceivedData$ & buf
                
        If (Mid$(ReceivedData$, 1, 1) = Chr$(13)) Or ((Mid$(ReceivedData$, 1, 1) = Chr$(10))) Then
         ReceivedData$ = Mid$(ReceivedData$, 2, Len(ReceivedData$))
        End If
        
        K = InStr(ReceivedData$, Chr$(13))
        If K = 0 Then
         GoTo NotComplete
        End If
        
'if we find an "echo" of our transmitted
'command delete it from our received data
        K = InStr(ReceivedData$, Cmd)
        If K <> 0 Then
         K = InStr(ReceivedData$, Cmd)
         ReceivedData$ = Mid$(ReceivedData$, K + 3 + Len(Cmd), Len(ReceivedData$))
         K = InStr(ReceivedData$, Chr$(13))
         If K = 0 Then
          GoTo NotComplete
         End If
         GoTo skiptcmd
        End If
''''''''''''''''''''' added to accomodate TCMD '''''

        K = InStr(ReceivedData$, Tcmd)
        If K <> 0 Then
         K = InStr(ReceivedData$, Tcmd)
         ReceivedData$ = Mid$(ReceivedData$, K + 3 + Len(Tcmd), Len(ReceivedData$))
         K = InStr(ReceivedData$, Chr$(13))
         If K = 0 Then
          GoTo NotComplete
         End If
        End If

''''''''''''''''''
skiptcmd:
        
        List1.Clear  'clear status desc.
        List2.Clear  'every timer we recv.
        
        K = InStr(ReceivedData$, Chr$(13))
        ReceivedData$ = Mid$(ReceivedData$, 1, K)
        
        'store NON- cr & lf
        RecDataNoCr$ = Mid$(ReceivedData$, 1, K - 1)
        
       
         
                
'**** is display status active?
        If ChkStatus.Value = 1 Then
          'display data recv.
          TextRecv.Text = RecDataNoCr$
          If InStr(UCase(Cmd), "ST") > 0 Then
           Call showdiag
          End If
        End If
        

        If just_sent = 1 And ((InStr(UCase(Cmd), "ST") > 0)) Then
          Call CheckForST
           
        
        End If
    

                      
           ReceivedData$ = ""
           RecDataNoCr$ = ""
  
           
           just_sent = 0
           
           
  
     
NotComplete:

End If

If utility.Visible = True Then

        'if keyclear Then
             If (MSComm1.InBufferCount > 0) Then
             ''If Len(Tmpstring) > 0 Then
                            
             Tmpstring = Tmpstring & MSComm1.Input
                'nstring = MSComm1.Input
                nstring = Tmpstring
                Tmpstring = ""
                
                buf = buf + nstring
                
                K = InStr(buf, Chr$(13))
                If K = 0 Then
                 GoTo NotComplete2
                End If
                
                'get rid of TX ECHO if present
                SerialData = buf
                K = InStr(SerialData, XmitString)
                If K <> 0 Then
                 SerialData = Mid$(SerialData, K, Len(SerialData))
                End If
                                
                
'if we find an "echo" of our transmitted
'command delete it from our received data
              K = InStr(buf, Cmd)
              If K <> 0 Then
                K = InStr(buf, "00")  'look for node
                If K = 0 Then
                 GoTo NotComplete2
                End If
               
                buf = Mid$(buf, K, Len(buf))
                Cmd = ""  'already found so clear it
                K = InStr(buf, Chr$(13))
                If K = 0 Then
                 GoTo NotComplete2
                End If
               End If
             

               Cmd = ""  'already found so clear it
                
                
                buf = ""
             End If

       
             ReceivedData$ = ""
             RecDataNoCr$ = ""
             just_sent = 0
           
   
     
NotComplete2:

End If


End Sub

Private Sub Opt19200_Click()
 Call Openport
End Sub


Private Sub Opt38400_Click()
 Call Openport
End Sub

Private Sub Opt57600_Click()
 
 Call Openport
 
End Sub

Private Sub Opt9600_Click()

 Call Openport
 
End Sub

Private Sub OptCom1_Click()

 
  ComPort = 1
  Call Openport
 
  
End Sub
Public Sub Openport()
Dim settings$
  
On Error Resume Next

    settings$ = "9600,n,8,1"  'default
    

'Sets and returns the number of characters
'to receive before the MSComm control sets
'the CommEvent property to comEvReceive
'and generates the OnComm event. if 0
'it disables "interrupt driven" method
    MSComm1.RThreshold = 1

    If MSComm1.PortOpen Then
       MSComm1.PortOpen = False
    End If
    
  
  
  If Opt9600.Value = True Then
   settings$ = "9600,n,8,1"
  End If
  
  If Opt19200.Value = True Then
   settings$ = "19200,n,8,1"
  End If
  
  If Opt38400.Value = True Then
   settings$ = "38400,n,8,1"
  End If
  
  If Opt57600.Value = True Then
   settings$ = "57600,n,8,1"
  End If
  
    
  MSComm1.CommPort = ComPort
  MSComm1.settings = settings$
  MSComm1.PortOpen = True
  PortStarted = True
  
End Sub

Private Sub Optcom2_Click()
 
  ComPort = 2
  Call Openport
  
End Sub

Private Sub SendButton_clik()
  
  
 If MSComm1.PortOpen = False Then
  MsgBox "Serial Port not configured properly!", vbCritical
  Exit Sub
 End If
 
 
 
 sent$ = Chr$(13) + TransmitText.Text + Chr$(13)
 MSComm1.Output = sent$
 just_sent = 1
 
End Sub


Private Sub Optcom3_Click()
 
  ComPort = 3
  Call Openport

End Sub


Private Sub Optcom4_Click()
ComPort = 4
  Call Openport

End Sub

Private Sub PauseCmd_Click()
    MsgBox "Pause", vbExclamation
End Sub

Private Sub TextTerminal_KeyPress(KeyAscii As Integer)


    If KeyAscii = 13 Then
       keyclear = True
    Else
       keyclear = False
    End If
   
     If MSComm1.PortOpen Then
          
          Cmd = Cmd & Chr$(KeyAscii)
          
          If KeyAscii = 13 Then
           just_sent = 1
           buf = ""
           MSComm1.InputLen = 0
           nstring = MSComm1.Input
           nstring = ""
           
           Cmd = Chr$(13) & Cmd
           MSComm1.Output = Cmd
           'rs485
           'Cmd = ""   'done sending it
           DoEvents
          End If
     End If

End Sub

Private Sub Timer1_Timer()
    
    
    Dim K As Integer
    Dim kar As String * 1
 
    

    If TimerCount < 10000 Then
       TimerCount = TimerCount + 1
    Else
       TimerCount = 0
    End If
    
     'if terminal frame showing..
      If Frame3.Visible = True Then
          'don't show status frame if terminal
          Frame7.Visible = False
          SendFrame.Visible = False 'don't show cmd hist
      Else
          'if Check status checked show frame
        If ChkStatus.Value = 1 Then
          Frame7.Visible = True
        Else
          Frame7.Visible = False
        End If
      End If

    
    
End Sub


Private Sub TransmitText_KeyPress(KeyAscii As Integer)
    Dim K As Integer
    Dim klim As Integer
    Dim Fbuf As String
       
    
    klim = 6
    If KeyAscii = 13 Then
    
'if port not opened we should not be here
    If MSComm1.PortOpen = False Then
     MsgBox "Please check Port Configuration", vbExclamation
     Exit Sub
    End If
    
        
     If PortStarted Then
        'flush buffer before sending a new command
      MSComm1.InputLen = 0
      Fbuf = MSComm1.Input
      MSComm1.InputLen = 1
     End If
     
       txcount = 0 'carlos
      
       CancelEvent = True
       RepeatStat = False
       
       DoEvents
       CancelEvent = False
       RepeatStat = True
       
       Cmd = RTrim$((TransmitText.Text))
       
       SendCommand
       
       TransmitText.Text = ""
    End If

End Sub
