Private Sub MSComm1_OnComm()
Select Case MSComm1.CommEvent '判斷MSComm1 通信事件
Case comEvReceive '收到Rhtreshold 個位元組后產生接收事件
'///////////////中斷程式開始///////////////////////////////////////////////////////////////////////////////////
Static sz(900) As String
Static a As Integer
Static b As Integer
Static i As Integer
Static Temp As String
Static Temp1 As Integer
Static add As Double
Static pi_data As Integer
pi_data = 140
If MSComm1.CommEvent = comEvReceive Then Temp = MSComm1.Input
Temp1 = Asc(Temp)
If Temp = "$" Then
a = 0: MSComm1.InBufferCount = 0
Text4.Text = "$"
Else
a = a + 1
Text4.Text = Text4.Text + Temp
sz(a) = Temp
End If
If Temp1 <> 13 And Temp1 <> 32 And Temp1 <> 36 Then
If Temp1 > 57 Or Temp1 < 48 Then a = 0
End If
If Text4.Text = "$at1" + vbCr Then Beep: a = 0: Text4.Text = "": f = MsgBox("電機有邏輯順序", , "控制盒準備情況"): Check10.Value = 0: Check11.Value = 0
If Text4.Text = "$at0" + vbCr Then Beep: a = 0: Text4.Text = "": f = MsgBox("電機無邏輯順序", , "控制盒準備情況"): Check10.Value = 0: Check11.Value = 0
If Text4.Text = "$atA" + vbCr Then Beep: a = 0: Text4.Text = "": f = MsgBox("控制盒準備就緒", , "控制盒準備情況"): Check10.Value = 0: Check11.Value = 0
If Text4.Text = "$atB" + vbCr Then Beep: a = 0: Text4.Text = "": f = MsgBox("資料寫入成功", , "資料寫入情況"): Check10.Value = 0: Check11.Value = 0
If Text4.Text = "$atC" + vbCr Then Beep: a = 0: Text4.Text = "": f = MsgBox("控制盒將重啟", , "控制盒準備情況"): Check10.Value = 0: Check11.Value = 0: If Text2.Text = "416" Then MSComm1.Settings = 19200
If Text4.Text = "$atD" + vbCr Then Beep: a = 0: Text4.Text = "": f = MsgBox("控制盒需要解鎖", , "控制盒準備情況"): Text15.Text = Text27.Text: Call send_data(Text15.Text, Text2.Text): Check10.Value = 0: Check11.Value = 0: Command1.Visible = True
If a >= pi_data Then a = 0: Text3.Text = "": Text4.Text = ""
If a >= (pi_data - 1) And Temp = vbCr Then
Text3.Text = Text4.Text
b = 0
For i = 1 To (pi_data - 8)
b = b Xor Val(sz(i))
If Val(Mid(Text3.Text, (pi_data - 7), 5)) = b Then
Text5.Text = Mid(Text3.Text, 2, 6)
Text6.Text = Mid(Text3.Text, 8, 6)
Text7.Text = Mid(Text3.Text, 14, 6)
Text8.Text = Mid(Text3.Text, 20, 6)
Text9.Text = Mid(Text3.Text, 26, 6)
Text10.Text = Mid(Text3.Text, 32, 6)
Text11.Text = Mid(Text3.Text, 38, 6)
Text12.Text = Mid(Text3.Text, 44, 6)
Text13.Text = Mid(Text3.Text, 50, 6)
Text14.Text = Mid(Text3.Text, 56, 6)
Text16.Text = Mid(Text3.Text, 62, 6)
Text17.Text = Mid(Text3.Text, 68, 6)
Text18.Text = Mid(Text3.Text, 74, 6)
Text19.Text = Mid(Text3.Text, 80, 6)
Text20.Text = Mid(Text3.Text, 86, 6)
Text21.Text = Mid(Text3.Text, 92, 6)
Text22.Text = Mid(Text3.Text, 98, 6)
Text23.Text = Mid(Text3.Text, 104, 6)
Text24.Text = Mid(Text3.Text, 110, 6)
Text25.Text = Mid(Text3.Text, 116, 6)
Text26.Text = Mid(Text3.Text, 122, 6)
Text27.Text = Mid(Text3.Text, 128, 6)
'檔案保存開始////////////////////////////////////////////////////////////
If Check1.Value = 1 Then
fFile = FreeFile:
Open "f:\老化\tx1.txt" For Append As fFile
Write #fFile, Now; Text3.Text
Close fFile
End If
'/檔案保存結束///////////////////////////////////////////////////////////
End If
Next i
End If
'///////////////中斷程式結束///////////////////////////////////////////////////////////////////////////////////
End Select
End Sub
uj5u.com熱心網友回復：
Rhtreshold調到1，然后在oncomm事件里把資料收完整再出去。其實就一個通訊超時的問題，位元組沒有收完整不觸發oncomm事件，不知道哪里設定。
uj5u.com熱心網友回復：
希望有人可以解決，多謝！uj5u.com熱心網友回復：
我也沒試過，不知道靈不靈，看看能不能設定超時
Private Type COMMTIMEOUTS
ReadIntervalTimeout As Long
WriteTotalTimeoutConstant As Long
ReadTotalTimeoutConstant As Long
WriteTotalTimeoutMultiplier As Long
ReadTotalTimeoutMultiplier As Long
End Type
Private Declare Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
Private Sub Form_Load()
Dim lpCommTimeouts As COMMTIMEOUTS
... ... ... ...
MSComm1.PortOpen=True
'設定通訊超時引數,ms，這段代碼加在MSComm1.Open=True之后
lpCommTimeouts.ReadIntervalTimeout = 2
lpCommTimeouts.ReadTotalTimeoutConstant = 4
lpCommTimeouts.ReadTotalTimeoutMultiplier = 3
lpCommTimeouts.WriteTotalTimeoutConstant = 5000 '一次寫入串口資料的固定超時。
lpCommTimeouts.WriteTotalTimeoutMultiplier = 50 '寫入每字符間的超時。
SetCommTimeouts MSComm1.CommID, lpCommTimeouts
... ... ... ...
End Sub
uj5u.com熱心網友回復：
注釋掉所有的MsgBox陳述句，此類中斷不宜在MsComm控制元件的OnComm時間中使用，會干擾串口正常的通信，屬于沒事找事。串口應該按資料幀完整接收后判斷進入資料處理。
uj5u.com熱心網友回復：
MsgBox關掉也是一樣的，似乎不是這個問題uj5u.com熱心網友回復：
串口應該按資料幀完整接收后判斷進入資料處理。uj5u.com熱心網友回復：
嚴格按照通信協議和資料幀約定撰寫代碼，完整接收后判斷進入資料處理。MscComm屬性Rhtreshold設定=1。
以下是應用于某個工業控制上位機的OmComm事件代碼。
Private Sub ctrMSComm_OnComm()
Dim bytInput As String
Select Case frmMain.ctrMSComm.CommEvent
Case comEvReceive
If blnReceiveFlag Then
If Not frmMain.ctrMSComm.PortOpen Then
frmMain.ctrMSComm.CommPort = intPort
frmMain.ctrMSComm.Settings = strSet
frmMain.ctrMSComm.PortOpen = True
End If
'此處添加處理接收的代碼
bytInput = frmMain.ctrMSComm.Input
strRec = bytInput '
Text2 = strRec
jscd = Len(Text2)
If Left(bytInput, 1) <> Chr(27) Or jscd > 21 Then '
fuweiTimer.Enabled = True
FrmRun.Label7.BackColor = vbRed
FrmRun.Label7.ForeColor = vbWhite
FrmRun.Label7.Caption = "接收信號出錯!"
frmMain.Label3.BackColor = vbRed
frmMain.Label3.ForeColor = vbWhite
frmMain.Label3.Caption = "接收信號出錯!"
ElseIf Left(bytInput, 1) = Chr(27) And Mid(Text2, 21, 1) = Chr(13) Then
Dim i As Long
Dim sumLng As Long
Dim sumLng1 As Long
For i = 2 To Len(strRec) - 3
sumLng = sumLng + Asc(Mid(strRec, i, 1))
Next
sumLng1 = Val("&H" & Mid(strRec, Len(strRec) - 2, 2))
If (sumLng Mod 256) = sumLng1 Then
frmMain.Label3.BackColor = vbGreen
frmMain.Label3.ForeColor = vbBlack
frmMain.Label3.Caption = "接收信號正常!"
FrmRun.Label7.BackColor = vbGreen
FrmRun.Label7.ForeColor = vbBlack
FrmRun.Label7.Caption = "接收信號正常!"
If Left(bytInput, 6) = Chr(27) & "R0032" And jscd = 21 Then
' If Val(fa2) >= 0 And Len(fa2) = 4 Then
' 'fa2 = "0" & Mid(fa2, 2, 3)
' End If
If FrmProgInput.Option1.Value = True Then
txtSend = gy_ml
lenTxtSend = Len(txtSend) '
If lenTxtSend = 129 Then
Call commFasong
End If
Else
txtSend = fa0 & fa1 & fa5 & zhenkong & fa2 & fa3 & fa4 '& Chr(13)
lenTxtSend = Len(txtSend)
If lenTxtSend = 25 Then
Call commFasong
Else
FrmRun.Label7.BackColor = vbRed
FrmRun.Label7.ForeColor = vbWhite
FrmRun.Label7.Caption = "發送信號出錯!"
frmMain.Label3.BackColor = vbRed
frmMain.Label3.ForeColor = vbWhite
frmMain.Label3.Caption = "發送信號出錯!"
End If
End If
blL1 = Mid$(bytInput, 11, 2)
If blL1 = "01" Then
record_jmm(0) = Format(pcsz_sj(0) * -1 + Val(Mid$(Text2, 13, 4)) / 10, "##.0") '板程溫度
ElseIf blL1 = "02" Then
record_jmm(1) = Format(pcsz_sj(1) * -1 + Val(Mid$(Text2, 13, 4)) / 10, "##.0") '02捕水器1溫度*
ElseIf blL1 = "03" Then
record_jmm(2) = Format(pcsz_sj(2) * -1 + Val(Mid$(Text2, 13, 4)) / 10, "##.0") '03捕水器2溫度*
ElseIf blL1 = "04" Then
record_jmm(3) = Format(pcsz_sj(3) * -1 + Val(Mid$(Text2, 13, 4)) / 10, "##.0") '04捕水器3溫度*
ElseIf blL1 = "05" Then
record_jmm(12) = Format(pcsz_sj(5) * -1 + Val(Mid$(Text2, 13, 4)) / 10, "##.0") '11捕水器4溫度*
'15 2010-03-16
ElseIf blL1 = "06" Then
record_jmm(16) = Format(pcsz_sj(6) * -1 + Val(Mid$(Text2, 13, 4)) / 10, "##.0") '制品2溫度*
ElseIf blL1 = "07" Then
record_jmm(6) = Format(pcsz_sj(7) * -1 + Val(Mid$(Text2, 13, 4)) / 10, "##.0") '制品3溫度*
ElseIf blL1 = "08" Then
record_jmm(7) = Format(pcsz_sj(8) * -1 + Val(Mid$(Text2, 13, 4)) / 10, "##.0") '制品4溫度*
ElseIf blL1 = "09" Then
record_jmm(8) = Format(pcsz_sj(9) * -1 + Val(Mid$(Text2, 13, 4)) / 10, "##.0") '制品5溫度*
ElseIf blL1 = "10" Then
record_jmm(9) = Format(pcsz_sj(10) * -1 + Val(Mid$(Text2, 13, 4)) / 10, "##.0") '制品6溫度*
ElseIf blL1 = "11" Then
record_jmm(4) = Format(pcsz_sj(4) * -1 + Val(Mid$(Text2, 13, 4)) / 10, "##.0") ''制品1溫度*
ElseIf blL1 = "12" Then
record_jmm(13) = Format(pcsz_sj(11) * -1 + Val(Mid$(Text2, 13, 4)) / 10, "##.0") '14制品7溫度*
ElseIf blL1 = "13" Then
record_jmm(14) = Format(pcsz_sj(12) * -1 + Val(Mid$(Text2, 13, 4)) / 10, "##.0") '15制品8溫度*
ElseIf blL1 = "14" Then
record_jmm(15) = Format(pcsz_sj(13) * -1 + Val(Mid$(Text2, 13, 4)) / 10, "##.0") '16制品9溫度*
'06 2010-03-16
ElseIf blL1 = "15" Then
record_jmm(5) = Format(pcsz_sj(14) * -1 + Val(Mid$(Text2, 13, 4)) / 10, "##.0") '17制品10溫度*
ElseIf blL1 = "17" Then
record_jmm(10) = pcsz_sj(16) * -1 + Val(Mid$(Text2, 13, 4)) '11干箱真空*
ElseIf blL1 = "18" Then
record_jmm(11) = pcsz_sj(17) * -1 + Val(Mid$(Text2, 13, 4)) '12捕水器真空*
End If
FrmRun.Label2(0).Caption = record_jmm(0) & "℃" '板程溫度ok 01
FrmRun.Label2(12).Caption = record_jmm(12) & "℃" ''捕水器4溫度* 05
FrmRun.Label2(13).Caption = record_jmm(13) & "℃" '制品7溫度
FrmRun.Label2(14).Caption = record_jmm(14) & "℃" '制品8溫度
FrmRun.Label2(15).Caption = record_jmm(15) & "℃" '制品9溫度
FrmRun.Label2(16).Caption = record_jmm(16) & "℃" '制品10溫度 06
frmDazixs.Label1(0).Caption = record_jmm(3) & "℃"
frmDazixs.Label1(1).Caption = record_jmm(4) & "℃"
frmDazixs.Label1(2).Caption = record_jmm(5) & "℃"
frmDazixs.Label1(3).Caption = record_jmm(6) & "℃"
frmDazixs.Label1(4).Caption = record_jmm(0) & "℃"
frmDazixs.Label1(5).Caption = record_jmm(10) & "Pa"
record_jm(0) = Val(record_jmm(0)) '板程溫度
record_jm(1) = Val(record_jmm(1)) '捕水器溫度1
record_jm(11) = Val(record_jmm(11)) '捕水器真空
record_jm(12) = Val(record_jmm(12)) '制品溫度7
record_jm(13) = Val(record_jmm(13)) '制品溫度8
record_jm(14) = Val(record_jmm(14)) '制品溫度9
record_jm(15) = Val(record_jmm(15)) '制品溫度10
record_jm(16) = Val(record_jmm(16)) '捕水器4溫度
record_jm(17) = Val(record_jmm(17)) '備用
ElseIf Mid(bytInput, 2, 1) = "U" And jscd = 21 Then '?疑為"U" 2010126
blL = Mid$(bytInput, 3, 9)
If blL <> blLOld Then
'Call Hex_bin '輸出口狀態鑒別
Call ZT_Panbie '輸出口狀態鑒別
End If
blLOld = blL
blLg = Mid$(bytInput, 12, 7)
If blLg <> blLgOld Then
Call hex_bin1 '輸出口故障狀態鑒別
End If
blLgOld = blLg
FrmRun.Text8 = blLgOld
txtSend = ""
ElseIf Mid(bytInput, 2, 3) = "W60" And jscd = 21 Then
txtSend = gy_ml
lenTxtSend = Len(txtSend)
If lenTxtSend = 129 Then
Call commFasong
End If
ElseIf Mid(bytInput, 2, 1) = "D" And jscd = 21 Then '2011129修改
riqi_run = Mid(bytInput, 6, 6)
Debug.Print riqi_run
'frmMain.txtSend = "Date" & riqi_run & gongyi_sj(0) & "123"
Unload frmchaxunRun
FrmRun.Text3 = "20" & Mid(riqi_run, 1, 2) & "-" & Mid(riqi_run, 3, 2) & "-" & Mid(riqi_run, 5, 2)
frmRef.Timer1.Enabled = False
Open App.Path & "\data\riqi_run.txt" For Output As #2
Print #2, riqi_run
Close
record_rq = riqi_run
SUM0 = 0
Open App.Path & "\data\zt2.txt" For Output As #2
Print #2, SUM0
Close
sum = 0
Unload frmRef
Load frmchaxunRun
End If
End If
End If
If Not blnAutoSendFlag And Not blnReceiveFlag Then
frmMain.ctrMSComm.PortOpen = False
End If
End If
End Select
End Sub
uj5u.com熱心網友回復：
如何上傳壓縮檔案啊，我想把整個檔案打包，傳上來讓大家看看，謝謝！uj5u.com熱心網友回復：
你登錄后，在“CSDN論壇首頁”左上角，有個“CSDN網盤”（其實是百度提供的），
你“點進去”后，新建一個檔案夾，再把你打包的工程上傳到里面，
然后進行“分享”，把分享鏈接貼出來，別人就可以下載、測驗了。
uj5u.com熱心網友回復：
在家好，我把程式 的下載連接發上來，感謝大家http://yun.baidu.com/xcloud/csdn/pan/share/link?shareid=1253483664&uk=2042050637
uj5u.com熱心網友回復：
http://download.csdn.net/detail/bakw/9902081改得好累啊，設計思路不同，估計還是不能用的。。。。
uj5u.com熱心網友回復：
是不是也得去掉，哪有通訊中插入人機界面操作的？uj5u.com熱心網友回復：
程式架構的問題。你在事件中加入 For 回圈，如果在這中間通訊中斷，必死無疑。改成狀態機架構。你的接收事件根據狀態進行資料處理。
uj5u.com熱心網友回復：
謝謝學長，我來改改看，uj5u.com熱心網友回復：
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/55857.html
標籤：控件