This code runs fine when I run it in de-bugger, but when I run is as an .EXE it terminates the entire program after about 30 seconds when the comm port is open receiving data.
There is no "kill" statement in any of the code.
Any thoughts would be appreciated.
norason
Private Sub CmdGetCurrentPrimeStep_Click()
GetPSR
End Sub
Public Function GetPSR()
If StartScan = False Then
Unload Me
Exit Function
End If
IsStatusVisible
Dim PSRStr As String
With MSComm1
On Error Resume Next
If .PortOpen Then
.PortOpen = False
End If
Select Case COMM_BAUD
Case 0
ChartBaud = "57600"
Case 1
ChartBaud = "19200"
Case 2
ChartBaud = "38400"
Case 3
ChartBaud = "57600"
Case 4
ChartBaud = "115200"
Case Else
ChartBaud = "9600"
End Select
.InBufferSize = 32000
.CommPort = PMP_COMM_PORT + 1
.Settings = ChartBaud + ",n,8,1"
.RThreshold = 1
.SThreshold = 1
.PortOpen = True
.InputLen = 0
.Output = Chr$(&HAA) + Chr$(&H1) + "X,PSR,LR" + XorchecksumPSR(Chr(ChecksumPSR))
RS232loop = 0
Do
DoEvents
RS232loop = RS232loop + 1
PSRDataStr = PSRDataStr & MSComm1.Input
If QuitStatus = True Then
Unload fmPumpStatus
Exit Function
End If
For Each frm In Forms
If frm.Name = "fmPumpStatus" Then
If frm.Visible = False Then
QuitStatus = True
Unload fmPumpStatus
Exit Function
End If
End If
Next
If RS232loop > 25000 Then
MsgBox "COMM ERROR - ABORT", vbExclamation, "PSR"
LblChartsAvailable.Caption = "FAILED"
Screen.MousePointer = vbDefault
Exit Function
End If
Loop Until InStr(PSRDataStr, "LR") Or RS232COUNTER > 25000
.InBufferCount = 0
End With
PSRDataStart = InStr(PSRDataStr, ",")
PSRDataEnd = InStrRev(PSRDataStr, ",")
LblPrimeStep.Caption = Mid$(PSRDataStr, PSRDataStart + 4, PSRDataEnd - (PSRDataStart + 4))
GetPP
End Function
Public Function XorchecksumPSR(Buffer As String) As String
Buffer = Chr$(&HAA) + Chr$(&H1) + "X,PSR,LR"
Dim PSRSerial As Integer
Dim ChecksumPSR As Byte
For PSRSerial = 1 To Len(Buffer)
ChecksumPSR = ChecksumPSR Xor (Asc(Mid$(Buffer, PSRSerial, 1)))
Next PSRSerial
XorchecksumPSR = Chr$(ChecksumPSR)
End Function
Private Sub CmdGetPressure_Click()
GetPP
End Sub
Public Function GetPP()
If StartScan = False Then
Unload Me
Exit Function
End If
IsStatusVisible
If QuitStatus = True Then
Unload Me
End If
Dim PPStr As String
With MSComm1
On Error Resume Next
.InputLen = 0
.Output = Chr$(&HAA) + Chr$(&H1) + "X,PP,LR" + XorchecksumPP(Chr(ChecksumPP))
RS232loop = 0
Do
DoEvents
RS232loop = RS232loop + 1
PPDataStr = PPDataStr & MSComm1.Input
If QuitStatus = True Then
Unload fmPumpStatus
Exit Function
End If
For Each frm In Forms
If frm.Name = "fmPumpStatus" Then
If frm.Visible = False Then
QuitStatus = True
Unload fmPumpStatus
Exit Function
End If
End If
Next
If RS232loop > 2000000 Then
MsgBox "COMM ERROR - ABORT", vbExclamation, "PP"
LblChartsAvailable.Caption = "FAILED"
Screen.MousePointer = vbDefault
Exit Function
End If
Loop Until InStr(PPDataStr, "LR") Or RS232COUNTER > 2000000
.InBufferCount = 0
End With
PPDataStart = InStr(PPDataStr, ",")
PPDataEnd = InStrRev(PPDataStr, ",")
LblPumpPressure.Caption = Val(Mid$(PPDataStr, PPDataStart + 4, PPDataEnd - (PPDataStart + 4)))
GetPST
End Function
Public Function XorchecksumPP(Buffer As String) As String
Buffer = Chr$(&HAA) + Chr$(&H1) + "X,PP,LR"
Dim PPSerial As Integer
Dim ChecksumPP As Byte
For PPSerial = 1 To Len(Buffer)
ChecksumPP = ChecksumPP Xor (Asc(Mid$(Buffer, PPSerial, 1)))
Next PPSerial
XorchecksumPP = Chr$(ChecksumPP)
End Function
Private Sub CmdGetStepTimeRemaining_Click()
GetPST
End Sub
Public Function GetPST()
If StartScan = False Then
Unload Me
Exit Function
End If
If QuitStatus = True Then
Unload Me
End If
IsStatusVisible
Dim PSTStr As String
With MSComm1
On Error Resume Next
.InputLen = 0
.Output = Chr$(&HAA) + Chr$(&H1) + "X,PST,LR" + XorchecksumPST(Chr(ChecksumPST))
RS232loop = 0
Do
DoEvents
RS232loop = RS232loop + 1
PSTDataStr = PSTDataStr & MSComm1.Input
If QuitStatus = True Then
Unload fmPumpStatus
Exit Function
End If
For Each frm In Forms
If frm.Name = "fmPumpStatus" Then
If frm.Visible = False Then
QuitStatus = True
Unload fmPumpStatus
Exit Function
End If
End If
Next
If RS232loop > 25000 Then
MsgBox "COMM ERROR - ABORT", vbExclamation, "PST"
LblChartsAvailable.Caption = "FAILED"
Screen.MousePointer = vbDefault
Exit Function
End If
Loop Until InStr(PSTDataStr, "LR") Or RS232COUNTER > 25000
.InBufferCount = 0
End With
PSTDataStart = InStr(PSTDataStr, ",")
PSTDataEnd = InStrRev(PSTDataStr, ",")
LblStepTimeRemaning.Caption = Mid$(PSTDataStr, PSTDataStart + 4, PSTDataEnd - (PSTDataStart + 4))
GetPTT
End Function
Public Function XorchecksumPST(Buffer As String) As String
Buffer = Chr$(&HAA) + Chr$(&H1) + "X,PST,LR"
Dim PSTSerial As Integer
Dim ChecksumPST As Byte
For PSTSerial = 1 To Len(Buffer)
ChecksumPST = ChecksumPST Xor (Asc(Mid$(Buffer, PSTSerial, 1)))
Next PSTSerial
XorchecksumPST = Chr$(ChecksumPST)
End Function
Private Sub CmdGetTotalTimeRemaining_Click()
GetPTT
End Sub
Public Function GetPTT()
If StartScan = False Then
Unload Me
Exit Function
End If
If QuitStatus = True Then
Unload Me
End If
IsStatusVisible
Dim PTTStr As String
With MSComm1
On Error Resume Next
.InputLen = 0
.Output = Chr$(&HAA) + Chr$(&H1) + "X,PTT,LR" + XorchecksumPTT(Chr(ChecksumPTT))
RS232loop = 0
Do
DoEvents
RS232loop = RS232loop + 1
PTTDataStr = PTTDataStr & MSComm1.Input
If QuitStatus = True Then
Unload fmPumpStatus
Exit Function
End If
For Each frm In Forms
If frm.Name = "fmPumpStatus" Then
If frm.Visible = False Then
QuitStatus = True
Unload fmPumpStatus
Exit Function
End If
End If
Next
If RS232loop > 25000 Then
MsgBox "COMM ERROR - ABORT", vbExclamation, "PTT"
LblChartsAvailable.Caption = "FAILED"
Screen.MousePointer = vbDefault
Exit Function
End If
Loop Until InStr(PTTDataStr, "LR") Or RS232COUNTER > 25000
.PortOpen = False
.InBufferCount = 0
End With
PTTDataStart = InStr(PTTDataStr, ",")
PTTDataEnd = InStrRev(PTTDataStr, ",")
LblTotalTimeRemaining.Caption = Mid$(PTTDataStr, PTTDataStart + 4, PTTDataEnd - (PTTDataStart + 4))
GetPSR
End Function
Public Function XorchecksumPTT(Buffer As String) As String
Buffer = Chr$(&HAA) + Chr$(&H1) + "X,PTT,LR"
Dim PTRSerial As Integer
Dim ChecksumPTT As Byte
For PTTSerial = 1 To Len(Buffer)
ChecksumPTT = ChecksumPTT Xor (Asc(Mid$(Buffer, PTTSerial, 1)))
Next PTTSerial
XorchecksumPTT = Chr$(ChecksumPTT)
End Function
Public Sub CmdStartStatus_Click()
StartScan = True
GetPSR
End Sub
Public Sub CmdStatusClose_Click()
StartScan = False
QuitStatus = True
Unload Me
fmMain.Show
End Sub
Private Sub Form_Load()
If QuitStatus = True Then
Unload Me
Exit Sub
End If
With MSComm1
If .PortOpen Then
.PortOpen = False
End If
End With
fmPumpStatus.Show
End Sub
Public Function XorchecksumSBD(Buffer As String) As String
Buffer = Chr$(&HAA) + Chr$(&H1) + "X,SBD,LR"
Dim SBDSerial As Integer
Dim ChecksumSBD As Byte
For SBDSerial = 1 To Len(Buffer)
ChecksumSBD = ChecksumSBD Xor (Asc(Mid$(Buffer, SBDSerial, 1)))
Next SBDSerial
XorchecksumSBD = Chr$(ChecksumSBD)
End Function
Private Sub IsStatusVisible()
Dim frm As Form
For Each frm In Forms
If frm.Name = "fmPumpStatus" Then
If frm.Visible = False Then
Unload Me
End If
Exit For
End If
Next
If QuitStatus = True Then
Unload Me
End If
End Sub
There is no "kill" statement in any of the code.
Any thoughts would be appreciated.
norason
Private Sub CmdGetCurrentPrimeStep_Click()
GetPSR
End Sub
Public Function GetPSR()
If StartScan = False Then
Unload Me
Exit Function
End If
IsStatusVisible
Dim PSRStr As String
With MSComm1
On Error Resume Next
If .PortOpen Then
.PortOpen = False
End If
Select Case COMM_BAUD
Case 0
ChartBaud = "57600"
Case 1
ChartBaud = "19200"
Case 2
ChartBaud = "38400"
Case 3
ChartBaud = "57600"
Case 4
ChartBaud = "115200"
Case Else
ChartBaud = "9600"
End Select
.InBufferSize = 32000
.CommPort = PMP_COMM_PORT + 1
.Settings = ChartBaud + ",n,8,1"
.RThreshold = 1
.SThreshold = 1
.PortOpen = True
.InputLen = 0
.Output = Chr$(&HAA) + Chr$(&H1) + "X,PSR,LR" + XorchecksumPSR(Chr(ChecksumPSR))
RS232loop = 0
Do
DoEvents
RS232loop = RS232loop + 1
PSRDataStr = PSRDataStr & MSComm1.Input
If QuitStatus = True Then
Unload fmPumpStatus
Exit Function
End If
For Each frm In Forms
If frm.Name = "fmPumpStatus" Then
If frm.Visible = False Then
QuitStatus = True
Unload fmPumpStatus
Exit Function
End If
End If
Next
If RS232loop > 25000 Then
MsgBox "COMM ERROR - ABORT", vbExclamation, "PSR"
LblChartsAvailable.Caption = "FAILED"
Screen.MousePointer = vbDefault
Exit Function
End If
Loop Until InStr(PSRDataStr, "LR") Or RS232COUNTER > 25000
.InBufferCount = 0
End With
PSRDataStart = InStr(PSRDataStr, ",")
PSRDataEnd = InStrRev(PSRDataStr, ",")
LblPrimeStep.Caption = Mid$(PSRDataStr, PSRDataStart + 4, PSRDataEnd - (PSRDataStart + 4))
GetPP
End Function
Public Function XorchecksumPSR(Buffer As String) As String
Buffer = Chr$(&HAA) + Chr$(&H1) + "X,PSR,LR"
Dim PSRSerial As Integer
Dim ChecksumPSR As Byte
For PSRSerial = 1 To Len(Buffer)
ChecksumPSR = ChecksumPSR Xor (Asc(Mid$(Buffer, PSRSerial, 1)))
Next PSRSerial
XorchecksumPSR = Chr$(ChecksumPSR)
End Function
Private Sub CmdGetPressure_Click()
GetPP
End Sub
Public Function GetPP()
If StartScan = False Then
Unload Me
Exit Function
End If
IsStatusVisible
If QuitStatus = True Then
Unload Me
End If
Dim PPStr As String
With MSComm1
On Error Resume Next
.InputLen = 0
.Output = Chr$(&HAA) + Chr$(&H1) + "X,PP,LR" + XorchecksumPP(Chr(ChecksumPP))
RS232loop = 0
Do
DoEvents
RS232loop = RS232loop + 1
PPDataStr = PPDataStr & MSComm1.Input
If QuitStatus = True Then
Unload fmPumpStatus
Exit Function
End If
For Each frm In Forms
If frm.Name = "fmPumpStatus" Then
If frm.Visible = False Then
QuitStatus = True
Unload fmPumpStatus
Exit Function
End If
End If
Next
If RS232loop > 2000000 Then
MsgBox "COMM ERROR - ABORT", vbExclamation, "PP"
LblChartsAvailable.Caption = "FAILED"
Screen.MousePointer = vbDefault
Exit Function
End If
Loop Until InStr(PPDataStr, "LR") Or RS232COUNTER > 2000000
.InBufferCount = 0
End With
PPDataStart = InStr(PPDataStr, ",")
PPDataEnd = InStrRev(PPDataStr, ",")
LblPumpPressure.Caption = Val(Mid$(PPDataStr, PPDataStart + 4, PPDataEnd - (PPDataStart + 4)))
GetPST
End Function
Public Function XorchecksumPP(Buffer As String) As String
Buffer = Chr$(&HAA) + Chr$(&H1) + "X,PP,LR"
Dim PPSerial As Integer
Dim ChecksumPP As Byte
For PPSerial = 1 To Len(Buffer)
ChecksumPP = ChecksumPP Xor (Asc(Mid$(Buffer, PPSerial, 1)))
Next PPSerial
XorchecksumPP = Chr$(ChecksumPP)
End Function
Private Sub CmdGetStepTimeRemaining_Click()
GetPST
End Sub
Public Function GetPST()
If StartScan = False Then
Unload Me
Exit Function
End If
If QuitStatus = True Then
Unload Me
End If
IsStatusVisible
Dim PSTStr As String
With MSComm1
On Error Resume Next
.InputLen = 0
.Output = Chr$(&HAA) + Chr$(&H1) + "X,PST,LR" + XorchecksumPST(Chr(ChecksumPST))
RS232loop = 0
Do
DoEvents
RS232loop = RS232loop + 1
PSTDataStr = PSTDataStr & MSComm1.Input
If QuitStatus = True Then
Unload fmPumpStatus
Exit Function
End If
For Each frm In Forms
If frm.Name = "fmPumpStatus" Then
If frm.Visible = False Then
QuitStatus = True
Unload fmPumpStatus
Exit Function
End If
End If
Next
If RS232loop > 25000 Then
MsgBox "COMM ERROR - ABORT", vbExclamation, "PST"
LblChartsAvailable.Caption = "FAILED"
Screen.MousePointer = vbDefault
Exit Function
End If
Loop Until InStr(PSTDataStr, "LR") Or RS232COUNTER > 25000
.InBufferCount = 0
End With
PSTDataStart = InStr(PSTDataStr, ",")
PSTDataEnd = InStrRev(PSTDataStr, ",")
LblStepTimeRemaning.Caption = Mid$(PSTDataStr, PSTDataStart + 4, PSTDataEnd - (PSTDataStart + 4))
GetPTT
End Function
Public Function XorchecksumPST(Buffer As String) As String
Buffer = Chr$(&HAA) + Chr$(&H1) + "X,PST,LR"
Dim PSTSerial As Integer
Dim ChecksumPST As Byte
For PSTSerial = 1 To Len(Buffer)
ChecksumPST = ChecksumPST Xor (Asc(Mid$(Buffer, PSTSerial, 1)))
Next PSTSerial
XorchecksumPST = Chr$(ChecksumPST)
End Function
Private Sub CmdGetTotalTimeRemaining_Click()
GetPTT
End Sub
Public Function GetPTT()
If StartScan = False Then
Unload Me
Exit Function
End If
If QuitStatus = True Then
Unload Me
End If
IsStatusVisible
Dim PTTStr As String
With MSComm1
On Error Resume Next
.InputLen = 0
.Output = Chr$(&HAA) + Chr$(&H1) + "X,PTT,LR" + XorchecksumPTT(Chr(ChecksumPTT))
RS232loop = 0
Do
DoEvents
RS232loop = RS232loop + 1
PTTDataStr = PTTDataStr & MSComm1.Input
If QuitStatus = True Then
Unload fmPumpStatus
Exit Function
End If
For Each frm In Forms
If frm.Name = "fmPumpStatus" Then
If frm.Visible = False Then
QuitStatus = True
Unload fmPumpStatus
Exit Function
End If
End If
Next
If RS232loop > 25000 Then
MsgBox "COMM ERROR - ABORT", vbExclamation, "PTT"
LblChartsAvailable.Caption = "FAILED"
Screen.MousePointer = vbDefault
Exit Function
End If
Loop Until InStr(PTTDataStr, "LR") Or RS232COUNTER > 25000
.PortOpen = False
.InBufferCount = 0
End With
PTTDataStart = InStr(PTTDataStr, ",")
PTTDataEnd = InStrRev(PTTDataStr, ",")
LblTotalTimeRemaining.Caption = Mid$(PTTDataStr, PTTDataStart + 4, PTTDataEnd - (PTTDataStart + 4))
GetPSR
End Function
Public Function XorchecksumPTT(Buffer As String) As String
Buffer = Chr$(&HAA) + Chr$(&H1) + "X,PTT,LR"
Dim PTRSerial As Integer
Dim ChecksumPTT As Byte
For PTTSerial = 1 To Len(Buffer)
ChecksumPTT = ChecksumPTT Xor (Asc(Mid$(Buffer, PTTSerial, 1)))
Next PTTSerial
XorchecksumPTT = Chr$(ChecksumPTT)
End Function
Public Sub CmdStartStatus_Click()
StartScan = True
GetPSR
End Sub
Public Sub CmdStatusClose_Click()
StartScan = False
QuitStatus = True
Unload Me
fmMain.Show
End Sub
Private Sub Form_Load()
If QuitStatus = True Then
Unload Me
Exit Sub
End If
With MSComm1
If .PortOpen Then
.PortOpen = False
End If
End With
fmPumpStatus.Show
End Sub
Public Function XorchecksumSBD(Buffer As String) As String
Buffer = Chr$(&HAA) + Chr$(&H1) + "X,SBD,LR"
Dim SBDSerial As Integer
Dim ChecksumSBD As Byte
For SBDSerial = 1 To Len(Buffer)
ChecksumSBD = ChecksumSBD Xor (Asc(Mid$(Buffer, SBDSerial, 1)))
Next SBDSerial
XorchecksumSBD = Chr$(ChecksumSBD)
End Function
Private Sub IsStatusVisible()
Dim frm As Form
For Each frm In Forms
If frm.Name = "fmPumpStatus" Then
If frm.Visible = False Then
Unload Me
End If
Exit For
End If
Next
If QuitStatus = True Then
Unload Me
End If
End Sub