MSCom控件问题

Question

  请教大家一个问题：我用MSCOM控件进行通信，用MSCOM_OnCom事件接收，但出现以下两种情况，请大家帮忙分析一下：   private sub MSCOM_OnCom()
    with MSCOM
      select case .CommEvent
        case .ComEvReceive
          iData=.Input
          ....
          ....
        case else      end select
    end with
   end sub   1）只有在MSCOM_OnCom事件上打上断点，程序才会进入该事件，否则不触发该事件
   2）进入该事件后分明.CommEvent=2，应该进入.ComEvReceive，可是程序则跳过，根本不接收数据   谢谢各位了！

Answer 1

1）未见串口打开及设置MSCOM控件的属性RThreshold = 1，产生OnComm的必要条件
2）代码中Case .comEvReceive中的.必需去掉，应为Case comEvReceive
3）代码中Private   sub   MSCOM_OnCom()中 _OnCom应为OnComm
下列代码是按ASCII字符接收：Option ExplicitPrivate Sub MSCOM_OnComm()
    Dim idata As String
    Text1 = ""
    With MSCom
        Select Case .CommEvent
            Case comEvReceive
                idata = .Input
                Text1 = idata
            Case Else
        End Select
    End With
End SubPrivate Sub Form_Load()
    With MSCom
        .CommPort = 1
        .Settings = "9600,n,8,1"
        .RThreshold = 1
        .InputMode = comInputModeText
        .PortOpen = True
    End With
End Sub

Answer 2

谢谢zdingyun ，您说的三条都属于本人的笔误，在程序发送命令时我就已经对MSCOM控件的属性RThreshold置1了,并且也打开了串口，还有其他的原因吗？还请各位大侠赐教

Answer 3

  TO zdingyun  以下是我写的代码，请指点Private Sub Form_Load()
  Timer1.Enabled = True
End SubPrivate Sub MSCom_OnComm()
Static i As Single
    Dim iData() As Byte, strChars As String, dd As Boolean, sTimer As Single, lend As Integer
    With MSCom
        Select Case .CommEvent
        Case comEvReceive
              '=================================
              '如果不加以下代码的延时，就不会收到数据
                sTimer = Timer
                Do
                    DoEvents
                Loop Until Timer > sTimer + 0.03
              '==================================
                .InputMode = comInputModeBinary '16进制
                  iData = .Input
                lend = UBound(iData) + 1
                If lend < 128 Then
                   Exit Sub
                Else
                   lbl6 = lend
                   lbl5 = iData(0) & " " & iData(1) & " " & iData(2) & " " & iData(3) & " " &   iData(4) & " " & iData(5) & " " & iData(7) & " " & iData(8) & " " & iData(9) & " " & iData(10)
                   i = i + 1
                   lbl3 = i
                   lbl1 = (CLng(iData(7)) * 256 + iData(8)) * 0.001
                   lbl2 = iData(10) * 0.01
                End If
                        Case Else        End Select
    End With
End SubPrivate Sub Timer1_Timer()      'interval=3000
   SendCmd 2, 1
End SubPublic Sub SendCmd(TrAddress As Integer, ComPort As Integer)
On Error Resume Next
Dim byts(4) As Byte, BeforeTime As Single, strdata As String, iRecData As Integer
Dim sTimer As Single, dStart As Date, iData(129) As Byte, t As Integer, strChars As String
Dim i As Single, FF As Single, iCall As Integer, iRec As Integer        byts(0) = TrAddress
        byts(1) = 39
        byts(2) = 0
        byts(3) = 0
        byts(4) = byts(0) Xor byts(1) Xor byts(2) Xor byts(3)
    
        With MSCom
              If .PortOpen = True Then                '判断通信口是否打开
                 .PortOpen = False                    '关闭通信口
                End If
              .CommPort = ComPort
              .Settings = "19200,n,8,2"
              .SThreshold = 1
              .RThreshold = 1
              .PortOpen = True
              .OutBufferCount = 0                       ' 清空发送缓冲区
              .Output = byts
        End With
        
End Sub很奇怪，三秒间隔一次发送数据，在mscomm_oncomm事件中不加延时就不会接收到数据，波特率在写大一点，数据根本就收不到，如果我接受的数据是2k，接受上来的数据都是错误的，延时已经很长了，还是不行

Answer 4

Option Explicit
    Dim strData As StringPrivate Sub Form_Load()
    Timer1.Enabled = True
    MSCom.Settings = "9600,n,8,1"
    MSCom.RThreshold = 1
    MSCom.PortOpen = True
    Text1 = ""
End SubPrivate Sub MSCom_OnComm()
    Static i As Single
    Dim iData() As Byte
    Dim strChars As String
    Dim dd As Boolean
    Dim sTimer As Single
    Dim lend As Integer
    Dim intInputLen As Integer
    With MSCom
            Select Case .CommEvent
                Case comEvReceive
                    '=================================
                    '如果不加以下代码的延时，就不会收到数据
                    sTimer = Timer
                    Text1 = sTimer
                    Do
                        DoEvents
                    Loop Until Timer > sTimer + 0.03
                    Text2 = Timer
                            '==================================
                        .InputMode = comInputModeBinary
                    intInputLen = Me.MSCom.InBufferCount
                    ReDim iData(intInputLen)
                    '16进制
                    iData = .Input
                    Dim j As Integer
                    For j = 0 To UBound(iData)
                        If Len(Hex(iData(j))) = 1 Then
                            strData = strData & "0" & Hex(iData(j))
                        Else
                            strData = strData & Hex(iData(j))
                        End If
                    Next
                    Text3 = strData
                    '    lend = UBound(iData) + 1
                    '    If lend < 1 Then
                    '        Exit Sub
                    '    Else
                    '        lbl6 = lend
                    '        lbl5 = iData(0) & "   " & iData(1) & "   " & iData(2) & "   " & iData(3) & "   " & iData(4) & "   " & iData(5) & "   " & iData(7) & "   " & iData(8) & "   " & iData(9) & "   " & iData(10)
                    '        i = i + 1
                    '        lbl3 = i
                    '        lbl1 = (CLng(iData(7)) * 256 + iData(8)) * 0.001
                    '        lbl2 = iData(10) * 0.01
                    '    End If
            Case Else
        End Select
    End With
End Sub
其它部分代码来不及研究，以上代码能接收数据。

Answer 5

Option Explicit
    Dim strdata As StringPrivate Sub Form_Load()
    Timer1.Enabled = True
    MSCom.Settings = "9600,n,8,1"
    MSCom.RThreshold = 1
    MSCom.PortOpen = True
    Text1 = " "
    MSCom1.CommPort = 3 'ComPort
    MSCom1.Settings = "9600,n,8,1"
    MSCom1.SThreshold = 1
    MSCom1.RThreshold = 1
    MSCom1.PortOpen = True
    MSCom1.OutBufferCount = 0                                                   '   清空发送缓冲区
End SubPrivate Sub MSCom_OnComm()
    Static i As Single
    Dim iData() As Byte
    Dim strChars As String
    Dim dd As Boolean
    Dim sTimer As Single
    Dim lend As Integer
    Dim intInputLen As Integer
        With MSCom
            Select Case .CommEvent
                Case comEvReceive
                    '=================================
                    '如果不加以下代码的延时，就不会收到数据
                    sTimer = Timer
                    Text1 = sTimer
                    Do
                        DoEvents
                    Loop Until Timer > sTimer + 0.03
                    Text2 = Timer
                    '==================================
                    .InputMode = comInputModeBinary
                    intInputLen = .InBufferCount
                    ReDim iData(intInputLen)
                    '16进制
                    iData = .Input
                    Dim j As Integer
                    For j = 0 To UBound(iData)
                        If Len(Hex(iData(j))) = 1 Then
                            strdata = strdata & "0" & Hex(iData(j))
                        Else
                            strdata = strdata & Hex(iData(j))
                        End If
                    Next
                    Text3 = strdata
                    lend = UBound(iData) + 1
                    'If lend < 128 Then
                    '    Exit Sub
                    'Else
                        'lbl6 = lend
                        'lbl5 = iData(0) & "   " & iData(1) & "   " & iData(2) & "   " & iData(3) & "   " & iData(4) & "   " & iData(5) & "   " & iData(7) & "   " & iData(8) & "   " & iData(9) & "   " & iData(10)
                        'i = i + 1
                        'lbl3 = i
                        'lbl1 = (CLng(iData(7)) * 256 + iData(8)) * 0.001
                        'lbl2 = iData(10) * 0.01
                    'End If
                Case Else
            End Select
        End With
End SubPublic Sub SendCmd(TrAddress As Integer, ComPort As Integer)
    On Error Resume Next
    Dim byts(4) As Byte
    Dim BeforeTime As Single
    Dim strdata As String
    Dim iRecData As Integer
    Dim sTimer As Single
    Dim dStart As Date
    Dim iData(129) As Byte
    Dim t As Integer
    Dim strChars As String
    Dim i As Single
    Dim FF As Single
    Dim iCall As Integer
    Dim iRec As Integer
    byts(0) = TrAddress
    byts(1) = 39
    byts(2) = 0
    byts(3) = 0
    byts(4) = byts(0) Xor byts(1) Xor byts(2) Xor byts(3)
    With MSCom1
        .CommPort = ComPort
        .Settings = "9600,n,8,1"
        .SThreshold = 1
        .RThreshold = 1
        .PortOpen = True
        '.OutBufferCount = 0                                                   '   清空发送缓冲区
        .Output = byts
    End With
End SubPrivate Sub Timer1_Timer()
    SendCmd 2, 3
End Sub

Answer 6

代码修改如下,经VB6调试无误:Option Explicit
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Dim strData As String
    Dim lbl5 As String
    Dim lbl3 As Integer
    Dim lbl1 As Single
    Dim lbl2 As IntegerPrivate Sub Form_Load()
    Timer1.Enabled = True
    MSCom.Settings = "19200,n,8,2"
    MSCom.RThreshold = 1
    MSCom.PortOpen = True
    Text1 = ""
    'Timer2.Interval = 200
End SubPrivate Sub MSCom_OnComm()
    Static i As Single
    Dim iData() As Byte
    Dim strChars As String
    Dim dd As Boolean
    Dim sTimer As Single
    Dim lend As Integer
    Dim intInputLen As Integer
        With MSCom
            Select Case .CommEvent
                Case comEvReceive
                    '延时用Sleep函数，用Timer函数会堆栈溢出
                    Sleep (10)
                    .InputMode = comInputModeBinary
                    intInputLen = .InBufferCount
                    ReDim iData(intInputLen)
                    '16进制
                    iData = .Input
                    Dim j As Integer
                    For j = 0 To UBound(iData)
                        If Len(Hex(iData(j))) = 1 Then
                            strData = strData & "0" & Hex(iData(j))
                        Else
                            strData = strData & Hex(iData(j))
                        End If
                    Next
                    Text3 = strData
                    If Len(strData) \ 2 < 128 Then
                        Exit Sub
                    Else
                        'lbl6 = lend
                        lbl5 = Val("&H" & Mid(strData, 1, 2)) & " " & Val("&H" & Mid(strData, 3, 2)) & _
                        " " & Val("&H" & Mid(strData, 5, 2)) & " " & Val("&H" & Mid(strData, 7, 2)) & _
                        " " & Val("&H" & Mid(strData, 9, 2)) & " " & Val("&H" & Mid(strData, 11, 2)) & _
                        " " & Val("&H" & Mid(strData, 15, 2)) & " " & Val("&H" & Mid(strData, 17, 2)) & _
                        " " & Val("&H" & Mid(strData, 19, 2)) & " " & Val("&H" & Mid(strData, 21, 2))
                        i = i + 1
                        lbl3 = i
                        lbl1 = (CLng(Val("&H" & Mid(strData, 15, 2))) * 256 + Val("&H" & Mid(strData, 17, 2))) * 0.001
                        lbl2 = Val("&H" & Mid(strData, 21, 2)) * 0.01
                    End If
                    Label2 = lbl6
                    Label3 = lbl5
                    Label4 = lbl3
                    Label5 = lbl1
                    Label6 = lbl6
                'Case Else
            End Select
        End With
End SubPublic Sub SendCmd(TrAddress As Integer, ComPort As Integer)
    On Error Resume Next
    Dim byts(4) As Byte
    Dim BeforeTime As Single
    Dim strData As String
    Dim iRecData As Integer
    Dim sTimer As Single
    Dim dStart As Date
    Dim iData(129) As Byte
    Dim t As Integer
    Dim strChars As String
    Dim i As Single
    Dim FF As Single
    Dim iCall As Integer
    Dim iRec As Integer
    byts(0) = TrAddress
    byts(1) = 39
    byts(2) = 0
    byts(3) = 0
    byts(4) = byts(0) Xor byts(1) Xor byts(2) Xor byts(3)
    With MSCom
        .CommPort = ComPort
        .Settings = "19200,n,8,2"
        .SThreshold = 1
        .RThreshold = 1
        .PortOpen = True
        .OutBufferCount = 0                                                   '   清空发送缓冲区
        .Output = byts
    End With
End SubPrivate Sub Timer1_Timer()
    SendCmd 2, 1
End Sub'Private Sub Timer2_Timer()'考虑用于清除接收内容
'    strData = ""
'End Sub

Answer 7

我在c++中遇到同样的问题，愁啊 、解决了没有，通知一下。就是怎么oncom函数外检测oncomm的状态属性