📄 fmian.frm
字号:
Case comEvDSR ' Change in the DSR line.
Case comEvRing ' Change in the Ring Indicator.
Case comEvReceive ' Received RThreshold # of
' chars.
'If firstr = False Then
'NOTE.Text = NOTE.Text & "Data Receive:"
'firstr = True
'Else
'List1.AddItem Counts
'Counts = Counts + 1
Delay 0.02 'delay 过小几乎没作用#24 似乎有点说不过去 为 0。001 的时候 和0。002 结果就不一样
'而这时间差引起的差异似乎不能用下面的观点来解释。。。
'
'DEBUG 0.00195-0.00196 就产生了差距 是处理时间差？ 差 0.00001...
'
'
'
'MsgBox "':::L"
'问题也许出在收发的时候 加上时间延迟 就能取走全部数据 不延迟 数据过长时候不过全部获得
'代码执行速度快于从缓冲中获得数据时间#？？？？？？？
'用延迟的效果和一个弹出对话框被确定后的数据采集
'相当于 产生ONCOMM 事件时候 数据并未稳定在线路上而 这时候数据采集 只采集到部分 程序执行速度过快
'遗漏数据的在后面事件到达时候被采集？调试的错误似乎证明这点。
'另一个问题就是延迟后产生许多 ONCOMM 事件 其实是空的 用 NUM=0 判断是“系统异常”ONCOMM 事件
'。。。。。捆饶好久的问题#75 为什么会产生多的ONCOMM 事件#24。，，》？？？？？
'虽然我没统计出现ONCOMM 事件个数 大概推测下： 是WINDOWS 消息队列 在DELAY 时候 后面的消息未
'被处理 因为来一个字符产生一个ONCOMM 事件 所以 后面字符在相继到来后触发多个ONCOMM 事件
' N=？？？？？？？？ 后面的事件被保存在消息队列中 而字符已经进入缓冲区 所以 第一次读就全部读出来了
'有时间调试下 到底出现多少个ONCOMM 事件 验证下
'以下 CASE 0 情况的新代码本机调试通过 不过 10的时候的代码本机调试也是通过的#8 伤心啊
'上机就不对了 当然我并未发现 数据超长引发的数据丢失问题 这点现在才发现
'但是为什么 CASE 10 情况在不同系统中调试出现的 多个CHR（13）被检测出并显示异常
'SUCH AS REC：AREC：AREC：A。。。。。。
'AND REC：AAAAAAREC：AAAAAAREC：AAAAAA。。。。OR REC：111111111111REC：11111111111REC：11111111。。。
'数据不能正确接收！！！！！！！？？？？？？？？？？？？？
'是计算机处理速度问题#？/？/？？？？/
'debug
Select Case IS_ARQ
Case True
Select Case MSComm.Tag
Case 0 '接收端
num = MSComm.InBufferCount
Do
DoEvents
data = data & MSComm.Input
num = num - Len(data)
Loop Until num = 0
If data <> "" Then
'check if is a data
Replay = Left(data, 4)
If CONREQ = False Then '有数据到达 但是并非所期望
If InStr(Replay, "ACK") Then '
ReplayID = CInt(Right(data, 1))
'期待 ID=0 的出现
If ReplayID = EXPID Then
CONREQ = True
Fmain.MSComm.Output = "ACK" & Chr(EXPID)
End If
'NOTE.Text = NOTE.Text & "REC:" & ReplayID & vbCrLf
End If
Else
If InStr(Replay, EOT) Then
Else
'getreplayID
Do While ReplayID <> EXPID
DoEvents
Delay (1)
OUTREQTIME = OUTREQTIME + 1
If OUTREQTIME = 10 Then
Fmain.MSComm.Output = "ACK" & Chr(EXPID)
Exit Sub
End If
Loop
End If
End If
End If
Case 1 '发送端
num = MSComm.InBufferCount
Do
DoEvents
data = data & MSComm.Input
num = num - Len(data)
Loop Until num = 0
If data <> "" Then
Replay = Left(data, 4)
If CONREQ = False Then '有数据到达 但是并非所期望 但是可以假定已经得到客户响应
If InStr(Replay, "ACK") Then '非 ACK 信息 系统的SENDNEXT 为假 一直循环
ReplayID = CInt(Right(data, 1))
'期待 ID=0 的出现
If ReplayID = EXPID Then
CONREQ = True
SENDNEXT = True
EXPID = (EXPID + 1) Mod 2
NOTE.Text = NOTE.Text & "REC:" & data & vbCrLf
Else
'重发数据
Fmain.MSComm.Output = packold
End If
'NOTE.Text = NOTE.Text & "REC:" & ReplayID & vbCrLf
Else
Fmain.MSComm.Output = "ENQ"
NOTE.Text = NOTE.Text & "SND:ENQ " & vbCrLf
Do While CONREQ <> True
DoEvents
Delay (1)
OUTREQTIME = OUTREQTIME + 1
If OUTREQTIME = 10 Then
NOTE.Text = NOTE.Text & "接收端未响应 超时退出" & vbCrLf
Exit Sub
End If
Loop
End If
Else
If InStr(Replay, "ACK") Then '非 ACK 信息 系统的SENDNEXT 为假 一直循环
ReplayID = CInt(Right(data, 1))
'期待 ID=0 的出现
If ReplayID = EXPID Then
CONREQ = True
SENDNEXT = True
EXPID = (EXPID + 1) Mod 2
NOTE.Text = NOTE.Text & "REC:" & data & vbCrLf
Else
'重发数据
Fmain.MSComm.Output = packold
End If
'NOTE.Text = NOTE.Text & "REC:" & ReplayID & vbCrLf
End If
End If
End If
End Select
Case False
'非 ARQ 模式时候
Select Case Me.MSComm.InputMode
Case 30
Do
DoEvents
buffer$ = buffer$ & MSComm.Input
Loop Until InStr(buffer$, "OK" & vbCrLf)
NOTE.Text = NOTE.Text & "REC:" & buffer$ & vbCrLf
Case 0
num = MSComm.InBufferCount
Do
DoEvents
data = data & MSComm.Input
num = num - Len(data)
Loop Until num = 0
If data <> "" Then
NOTE.Text = NOTE.Text & "REC:" & data & vbCrLf
End If
If InStr(data, "ENQ") Then
MSComm.Tag = 0
M_ARQ_Click
Fmain.MSComm.Output = "ACK0"
End If
NOTE.SetFocus
SendKeys "{PGDN}"
SendKeys "{PGDN}"
'Tsend.SetFocus
SendKeys "{TAB}"
Case 220
MSComm.InputLen = 0
num = MSComm.InBufferCount
If num <> 0 Then
'data = Space(num)
data = MSComm.Input
Debug.Print num
'MsgBox CStr(num) & "/" & data
MSComm.InBufferCount = 0
NOTE.Text = NOTE.Text & "REC:" & data & vbCrLf
'哈哈 小徐发明的技巧
NOTE.SetFocus
SendKeys "{PGDN}"
SendKeys "{PGDN}"
'Tsend.SetFocus
SendKeys "{TAB}"
End If
Case 1
MSComm.InputLen = 0
num = MSComm.InBufferCount
If num <> 0 Then
'data = Space(num)
data = MSComm.Input
Debug.Print num
'MsgBox CStr(num) & "/" & data
MSComm.InBufferCount = 0
NOTE.Text = NOTE.Text & "Rec：" & data & vbCrLf
'哈哈 小徐发明的技巧
NOTE.SetFocus
SendKeys "{PGDN}"
SendKeys "{PGDN}"
'Tsend.SetFocus
SendKeys "{TAB}"
End If
Case 10 'Debug old edition
'这代码在数据短时本机调试通过 数据过长出问题 为什么？
'在上机调试 无数据接收；；；；；
MSComm.InputLen = 0
charc = MSComm.Input
If Asc(charc) <> 13 Then
bufferr = bufferr & charc
Else
NOTE.Text = NOTE.Text & "Rec：" & bufferr & vbCrLf
bufferr = ""
End If
MSComm.InBufferCount = 0
Case 110 'Debug old edition
MSComm.InputLen = 0
charc = MSComm.Input
If Asc(charc) <> 13 Then
bufferr = bufferr & charc
Else
NOTE.Text = NOTE.Text & "Rec：" & bufferr & vbCrLf
bufferr = ""
End If
MSComm.InBufferCount = 0
Case 11
MSComm.InputLen = 0
charb = MSComm.Input
If AscB(charb) <> 13 Then
bufferr = bufferr & charb 'Chr(Left(Asc(charb), 2)) & Chr(Right(Asc(charb), 2))
Else
NOTE.Text = NOTE.Text & "Receive：" & bufferr & vbCrLf
bufferr = ""
End If
MSComm.InBufferCount = 0
End Select
End Select
'bufferr = ""
'firstr = False
'End If
'
'MsgBox "q"
Case comEvSend ' There are SThreshold number of
' characters in the transmit
' buffer.
Case comEvEOF ' An EOF charater was found in
' the input stream
End Select
'debug
't2 = Timer
'Debug.Print t2
End Sub
Private Sub SENDEVENT_CONREQA(CONREQA As Boolean)
DoEvents
If CONREQ Then CONREQA = True
End Sub
Private Sub SENDEVENT_SENDNEXTA(SENDNEXTA As Boolean)
DoEvents
If SENDNEXT Then SENDNEXTA = True
End Sub
Private Sub Tsend_KeyPress(KeyAscii As Integer)
'ARQMODE CHOICE
If IS_ARQ = False Then
If KeyAscii = 13 Then
If is_cominuse = True Then
'ind = 0
buffer1 = Tsend.Text
MSComm.Output = buffer1 & Chr$(13)
NOTE.Text = NOTE.Text & "SND:" & Tsend.Text & vbCrLf
Tsend.Text = ""
KeyAscii = 0
Else
NOTE.Text = NOTE.Text & "当前未连接!数据发送无效!" & vbCrLf
Tsend.Text = ""
End If
Else
'BUFFER(ind) = Chr$(KeyAscii)
'MSComm.OutBufferCount = Len(Tsend.Text)
'ind = ind + 1
End If
Else
'ARQ MODE
End If
End Sub
Public Sub send(filename As String, msglen As Long)
SENDEVENT.SendFile filename, msglen
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -