This is an app for a stationary raster scanner.
Can anyone tell me why the program below cycles thru the OnComm event 2-3 times when starting up or after a bad scan?
Stepping thru from the beginning, before any data is received I can type ? MSCOMM1.CommEvent into the Immediate window and it returns a 3. I haven't scanned anything at this point. It works great on a good read, including the data update, but I want to respond to validation and a bad read appropriately by changing screencolor and text.
Option Explicit
Public prod As String
Public lot As String
Public scan As String
Public conn As ADODB.Connection
Public rs As ADODB.Recordset
Public cmd As ADODB.Command
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Form_Load()
Set conn = DataEnvironment1.Connection1
Set rs = DataEnvironment1.rsCommand1
On Error GoTo commerr
With MSComm1
MSComm1.CommPort = 1
MSComm1.PortOpen = True
MSComm1.Handshaking = comRTS
MSComm1.RThreshold = 13
MSComm1.RTSEnable = True
MSComm1.Settings = "9600,E,7,1"
MSComm1.InputLen = 0
End With
commerr:
If Err.Number = 8005 Then
MSComm1.PortOpen = True
Resume Next
End If
End Sub
Private Sub MSComm1_OnComm()
Dim noread As String
noread = "NOREAD"
scan = ""
txtscandata.Text = ""
txtscandata.BackColor = vbWhite
lot = ""
prod = ""
txtdesc.Visible = False
txtdesc.BackColor = vbWhite
txtdesc.Text = ""
Select Case MSComm1.CommEvent
Case comEvReceive
txtscandata.Text = MSComm1.Input
scan = Trim(txtscandata.Text)
If Len(Trim(scan)) >= 13 And InStr(scan, noread) = 0 Then
Call HandleInput
Else
txtscandata.Text = "Bad scan- scan it again!"
txtscandata.BackColor = vbRed
Beep
Beep
Beep
Sleep 4000
GoTo badscan
End If
Case Else
txtscandata.Text = "Ready to Scan"
MSComm1.InBufferCount = 0
Exit Sub
'txtscandata.BackColor = vbRed
'Beep
'Beep
'Beep
' Sleep 4000
End Select
badscan:
MSComm1.InBufferCount = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
MSComm1.PortOpen = False
End Sub
Public Sub HandleInput()
Dim desc As String
scan = Trim(scan)
prod = Mid(scan, 1, 6)
lot = Mid(scan, 8, 13)
On Error GoTo Errorexit
Set rs = New ADODB.Recordset
Set cmd = New ADODB.Command
Set cmd.ActiveConnection = conn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "pValidateWSScan"
cmd.Parameters.Append cmd.CreateParameter("@prod", adChar, adParamInput, 10, Trim(prod))
cmd.Parameters.Append cmd.CreateParameter("@lot", adChar, adParamInput, 20, Trim(lot))
cmd.Parameters.Append cmd.CreateParameter("@desc", adChar, adParamOutput, 20, Trim(desc))
cmd.Execute
desc = cmd(2)
If Trim(desc) = "Invalid Product!" Or Trim(desc) = "" Then
txtdesc.BackColor = vbRed
txtdesc.Visible = True
txtdesc.Text = "Invalid Product!"
Beep
Beep
Beep
' Sleep 4000
Set cmd = Nothing
Exit Sub
Else
txtdesc.Visible = True
txtscandata.BackColor = vbGreen
txtdesc.BackColor = vbGreen
txtdesc.Text = desc
Set cmd = Nothing
' Sleep 4000
End If
Errorexit:
If Err.Number = 94 Then
Resume Next
End If
End Sub
'Private Sub OnComm_Idle()
'MSComm1.InBufferCount = 0
'txtscandata.Text = "Ready to Scan"
'scan = ""
'txtscandata.BackColor = vbWhite
'lot = ""
'prod = ""
'txtdesc.Visible = False
'txtdesc.BackColor = vbWhite
'txtdesc.Text = ""
'End Sub
Can anyone tell me why the program below cycles thru the OnComm event 2-3 times when starting up or after a bad scan?
Stepping thru from the beginning, before any data is received I can type ? MSCOMM1.CommEvent into the Immediate window and it returns a 3. I haven't scanned anything at this point. It works great on a good read, including the data update, but I want to respond to validation and a bad read appropriately by changing screencolor and text.
Option Explicit
Public prod As String
Public lot As String
Public scan As String
Public conn As ADODB.Connection
Public rs As ADODB.Recordset
Public cmd As ADODB.Command
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Form_Load()
Set conn = DataEnvironment1.Connection1
Set rs = DataEnvironment1.rsCommand1
On Error GoTo commerr
With MSComm1
MSComm1.CommPort = 1
MSComm1.PortOpen = True
MSComm1.Handshaking = comRTS
MSComm1.RThreshold = 13
MSComm1.RTSEnable = True
MSComm1.Settings = "9600,E,7,1"
MSComm1.InputLen = 0
End With
commerr:
If Err.Number = 8005 Then
MSComm1.PortOpen = True
Resume Next
End If
End Sub
Private Sub MSComm1_OnComm()
Dim noread As String
noread = "NOREAD"
scan = ""
txtscandata.Text = ""
txtscandata.BackColor = vbWhite
lot = ""
prod = ""
txtdesc.Visible = False
txtdesc.BackColor = vbWhite
txtdesc.Text = ""
Select Case MSComm1.CommEvent
Case comEvReceive
txtscandata.Text = MSComm1.Input
scan = Trim(txtscandata.Text)
If Len(Trim(scan)) >= 13 And InStr(scan, noread) = 0 Then
Call HandleInput
Else
txtscandata.Text = "Bad scan- scan it again!"
txtscandata.BackColor = vbRed
Beep
Beep
Beep
Sleep 4000
GoTo badscan
End If
Case Else
txtscandata.Text = "Ready to Scan"
MSComm1.InBufferCount = 0
Exit Sub
'txtscandata.BackColor = vbRed
'Beep
'Beep
'Beep
' Sleep 4000
End Select
badscan:
MSComm1.InBufferCount = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
MSComm1.PortOpen = False
End Sub
Public Sub HandleInput()
Dim desc As String
scan = Trim(scan)
prod = Mid(scan, 1, 6)
lot = Mid(scan, 8, 13)
On Error GoTo Errorexit
Set rs = New ADODB.Recordset
Set cmd = New ADODB.Command
Set cmd.ActiveConnection = conn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "pValidateWSScan"
cmd.Parameters.Append cmd.CreateParameter("@prod", adChar, adParamInput, 10, Trim(prod))
cmd.Parameters.Append cmd.CreateParameter("@lot", adChar, adParamInput, 20, Trim(lot))
cmd.Parameters.Append cmd.CreateParameter("@desc", adChar, adParamOutput, 20, Trim(desc))
cmd.Execute
desc = cmd(2)
If Trim(desc) = "Invalid Product!" Or Trim(desc) = "" Then
txtdesc.BackColor = vbRed
txtdesc.Visible = True
txtdesc.Text = "Invalid Product!"
Beep
Beep
Beep
' Sleep 4000
Set cmd = Nothing
Exit Sub
Else
txtdesc.Visible = True
txtscandata.BackColor = vbGreen
txtdesc.BackColor = vbGreen
txtdesc.Text = desc
Set cmd = Nothing
' Sleep 4000
End If
Errorexit:
If Err.Number = 94 Then
Resume Next
End If
End Sub
'Private Sub OnComm_Idle()
'MSComm1.InBufferCount = 0
'txtscandata.Text = "Ready to Scan"
'scan = ""
'txtscandata.BackColor = vbWhite
'lot = ""
'prod = ""
'txtdesc.Visible = False
'txtdesc.BackColor = vbWhite
'txtdesc.Text = ""
'End Sub