看看这个对你有没有用
用了mscommPrivate Static Sub MSComm1_OnComm()
Dim tt As Integer
Dim pok As Integer
Dim EVMsg$
Dim ERMsg$
Dim buffer As Variant
Dim nn_user_id As String
Dim mm_user_id As String
Dim tt_1 As Integer
Dim tt_2 As Integer
Dim tt_f As Integer
Dim i As Integer
Select Case MSComm1.CommEvent
Case comEvReceive
MSComm1.InputMode = comInputModeText
MSComm1.InputLen = 1
buffer = MSComm1.Input
If buffer = Chr$(2) Then
txtTerm.Text = ""
Text2.Text = ""
End If
If Asc(buffer) = 21 Then
txtTerm.Text = ""
txtTerm.Text = "二道数据出错"
Text2.Text = ""
Text2.Text = "三道数据出错"
wrf = True
Exit Sub
End If
'Debug.Print "Receive - " & StrConv(buffer, vbUnicode)
If buffer <> Chr$(2) And buffer <> Chr$(3) Then
If buffer = ";" Then
wt.Value = False
End If
If buffer = "+" Then
wt.Value = True
End If
If wt.Value = False Then
ShowData txtTerm, StrConv(buffer, vbUnicode)
If buffer = "?" Then
If txtTerm.Text = "" Then
txtTerm.Text = ""
txtTerm.Text = "二道数据为空"
End If
End If
Else
ShowData Text2, StrConv(buffer, vbUnicode)
If buffer = "?" Then
If Text2.Text = "" Then
Text2.Text = ""
Text2.Text = "三道数据为空"
End If
End If
End If
End If
Case comEvSend
Case comEvCTS
Case comEvDSR
Case comEvCD
Case comEvRing
Case comEvEOF
Case comBreak
Case comCDTO
Case comCTSTO
Case comDCB
Case comDSRTO
Case comFrame
Case comOverrun
Case comRxOver
Case comRxParity
Case comTxFull
Case Else
End Select
If Len(EVMsg$) Then
Timer2.Enabled = True
ElseIf Len(ERMsg$) Then
Beep
Ret = MsgBox(ERMsg$, 1, "Click Cancel to quit, OK to ignore.")
If Ret = 2 Then
MSComm1.PortOpen = False ' Close the port and quit.
End If
Timer2.Enabled = True
End If
End SubPrivate Static Sub ShowData(Term As Control, Data As String)
On Error GoTo Handler
Const MAXTERMSIZE = 16000
Dim TermSize As Long, i
' Make sure the existing text doesn't get too large.
TermSize = Len(Term.Text)
If TermSize > MAXTERMSIZE Then
Term.Text = Mid$(Term.Text, 4097)
'返回指定为4097个字符
TermSize = Len(Term.Text)
End If ' Point to the end of Term's data.
Term.SelStart = TermSize ' Filter/handle BACKSPACE characters.
Do
i = InStr(Data, Chr$(8))
If i Then
If i = 1 Then
Term.SelStart = TermSize - 1
Term.SelLength = 1
Data = Mid$(Data, i + 1)
Else
Data = Left$(Data, i - 2) & Mid$(Data, i + 1)
End If
End If
Loop While i ' Eliminate line feeds.
Do
i = InStr(Data, Chr$(10))
If i Then
Data = Left$(Data, i - 1) & Mid$(Data, i + 1)
End If
Loop While i ' Make sure all carriage returns have a line feed.
i = 1
Do
i = InStr(i, Data, Chr$(13))
If i Then
Data = Left$(Data, i) & Chr$(10) & Mid$(Data, i + 1)
i = i + 1
End If
Loop While i Term.SelText = Data
If hLogFile Then
i = 2
Do
Err = 0
Put hLogFile, , Data
If Err Then
i = MsgBox(Error$, 21)
If i = 2 Then
End If
End If
Loop While i <> 2
End If
Term.SelStart = Len(Term.Text)
Exit SubHandler:
MsgBox Error$
Resume Next
End Sub
用了mscommPrivate Static Sub MSComm1_OnComm()
Dim tt As Integer
Dim pok As Integer
Dim EVMsg$
Dim ERMsg$
Dim buffer As Variant
Dim nn_user_id As String
Dim mm_user_id As String
Dim tt_1 As Integer
Dim tt_2 As Integer
Dim tt_f As Integer
Dim i As Integer
Select Case MSComm1.CommEvent
Case comEvReceive
MSComm1.InputMode = comInputModeText
MSComm1.InputLen = 1
buffer = MSComm1.Input
If buffer = Chr$(2) Then
txtTerm.Text = ""
Text2.Text = ""
End If
If Asc(buffer) = 21 Then
txtTerm.Text = ""
txtTerm.Text = "二道数据出错"
Text2.Text = ""
Text2.Text = "三道数据出错"
wrf = True
Exit Sub
End If
'Debug.Print "Receive - " & StrConv(buffer, vbUnicode)
If buffer <> Chr$(2) And buffer <> Chr$(3) Then
If buffer = ";" Then
wt.Value = False
End If
If buffer = "+" Then
wt.Value = True
End If
If wt.Value = False Then
ShowData txtTerm, StrConv(buffer, vbUnicode)
If buffer = "?" Then
If txtTerm.Text = "" Then
txtTerm.Text = ""
txtTerm.Text = "二道数据为空"
End If
End If
Else
ShowData Text2, StrConv(buffer, vbUnicode)
If buffer = "?" Then
If Text2.Text = "" Then
Text2.Text = ""
Text2.Text = "三道数据为空"
End If
End If
End If
End If
Case comEvSend
Case comEvCTS
Case comEvDSR
Case comEvCD
Case comEvRing
Case comEvEOF
Case comBreak
Case comCDTO
Case comCTSTO
Case comDCB
Case comDSRTO
Case comFrame
Case comOverrun
Case comRxOver
Case comRxParity
Case comTxFull
Case Else
End Select
If Len(EVMsg$) Then
Timer2.Enabled = True
ElseIf Len(ERMsg$) Then
Beep
Ret = MsgBox(ERMsg$, 1, "Click Cancel to quit, OK to ignore.")
If Ret = 2 Then
MSComm1.PortOpen = False ' Close the port and quit.
End If
Timer2.Enabled = True
End If
End SubPrivate Static Sub ShowData(Term As Control, Data As String)
On Error GoTo Handler
Const MAXTERMSIZE = 16000
Dim TermSize As Long, i
' Make sure the existing text doesn't get too large.
TermSize = Len(Term.Text)
If TermSize > MAXTERMSIZE Then
Term.Text = Mid$(Term.Text, 4097)
'返回指定为4097个字符
TermSize = Len(Term.Text)
End If ' Point to the end of Term's data.
Term.SelStart = TermSize ' Filter/handle BACKSPACE characters.
Do
i = InStr(Data, Chr$(8))
If i Then
If i = 1 Then
Term.SelStart = TermSize - 1
Term.SelLength = 1
Data = Mid$(Data, i + 1)
Else
Data = Left$(Data, i - 2) & Mid$(Data, i + 1)
End If
End If
Loop While i ' Eliminate line feeds.
Do
i = InStr(Data, Chr$(10))
If i Then
Data = Left$(Data, i - 1) & Mid$(Data, i + 1)
End If
Loop While i ' Make sure all carriage returns have a line feed.
i = 1
Do
i = InStr(i, Data, Chr$(13))
If i Then
Data = Left$(Data, i) & Chr$(10) & Mid$(Data, i + 1)
i = i + 1
End If
Loop While i Term.SelText = Data
If hLogFile Then
i = 2
Do
Err = 0
Put hLogFile, , Data
If Err Then
i = MsgBox(Error$, 21)
If i = 2 Then
End If
End If
Loop While i <> 2
End If
Term.SelStart = Len(Term.Text)
Exit SubHandler:
MsgBox Error$
Resume Next
End Sub
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货