一个用MSComm编写的串口通信程序问题

Question

我遇到个麻烦的问题，请高手指教：
    我用MSComm控件实现了串口传送文本文件，文件的传送与接收的功能都顺利完成，但，现遇到的问题是，怎样能在文件传送或接收过程中断开数据传输的进程，简单的说，我想用一个命令按钮实现中断文件的传送或接收。
    我试过用下面的程序来实现中断，但是在文件传输过程中，点击“中断”按钮，程序根本没有反应，等文件传输完了后，才有用。    Private Sub Command4_Click()
        MSComm(MachineIndex).PortOpen = False
    End Sub   请问该怎么解决.........?????

Answer 1

你在开始的时候不是要配置MSComm的参数吗?
重新配置一下就可了

Answer 2

下面是叶帆的程序Option Explicit
Private Declare Function GetCurrentTime Lib "kernel32" Alias "GetTickCount" () As Long'*************************************************************************
Private Sub cmdSend_Click()
  Dim bytData(10) As Byte
  bytData(0) = &HA                           'Êý¾Ý
  txtMsg.Text = SendData(1, bytData, 1)      '·¢ËÍÃüÁî
End Sub'*************************************************************************
Private Sub Form_Load()
   OpenPort 1            '´ò¿ª´®¿Ú
End Sub'*************************************************************************
Public Function OpenPort(PortNo As Integer, Optional InBufferSize As Integer = 1024, Optional OutBufferSize As Integer = 512) As Long
   On Error GoTo ErrExit
    MSComm1.CommPort = PortNo                   '²ÉÓÃCOM¶Ë¿Ú
    MSComm1.Settings = "9600,n,8,1"
    MSComm1.InputMode = comInputModeBinary      '²ÉÓöþ½øÖÆ´«Êä
    MSComm1.NullDiscard = False                 'NULL×Ö·û´Ó¶Ë¿Ú´«Ë͵½½ÓÊÜ»º³åÇø
    MSComm1.DTREnable = False                   'DTRÏßÎÞЧ
    MSComm1.EOFEnable = False                   '²»Ñ°ÕÒEOF·û
    MSComm1.RTSEnable = False                   'RTSÏßÎÞЧ
    MSComm1.InBufferCount = 0                   'Çå¿Õ½ÓÊÜ»º³åÇø
    MSComm1.OutBufferCount = 0                  'Çå¿Õ´«Ê仺³åÇø
    MSComm1.SThreshold = 1                      'Èç¹û´«Ê仺³åÇøÍêÈ«¿Õʱ²úÉúMSCommʼþ
    MSComm1.RThreshold = 0                      '²»²úÉúMSCommʼþ
    MSComm1.InBufferSize = InBufferSize         '½ÓÊÕ»º³åÇø  Ä¬ÈÏΪ1024¸ö×Ö½Ú
    MSComm1.OutBufferSize = OutBufferSize       '·¢ËÍ»º³åÇø  Ä¬ÈÏΪ512¸ö×Ö½Ú
    MSComm1.PortOpen = True                     '´ò¿ª¶Ë¿Ú
    OpenPort = 0
   Exit Function
ErrExit:
   OpenPort = 1
End Function'*************************************************************************
Public Sub ClosePort()
   On Error GoTo ErrExit
     MSComm1.PortOpen = False                      '¹Ø±Õ¶Ë¿Ú
   Exit Sub
ErrExit:
   
End Sub'*************************************************************************
Public Function SendData(bytAddr As Byte, bytData() As Byte, Optional bytNum As Byte = 1) As Long
    On Error GoTo ErrExit    Dim bytSendArray() As Byte                     '·¢ËÍÊý¾Ý»º³åÇø
    Dim intGetDataLen As Integer                   'Òª½ÓÊÕµÄÊý¾Ý³¤¶È
    Dim sngTimeSpace As Single                     'ÑÓʱʱ¼ä
    Dim sngTime As Single
    Dim bytReceiveArray() As Byte                  '½ÓÊÕµÄÊý¾Ý
    Dim VarReceiveData As Variant                  '½ÓÊյıäÌåÊý¾Ý    Dim i As Long    ReDim bytSendArray(0 To bytNum * 2 + 2) As Byte  '·¢ËÍÊý¾Ý»º³åÇø    bytSendArray(0) = &HAC                         'ͬ²½×ÖÍ·
    bytSendArray(1) = bytAddr                      'ÏÂλ»úµØÖ·
    bytSendArray(2) = bytAddr                      '¸±±¾    'Êý¾Ý
    For i = 0 To bytNum * 2 - 1 Step 2
        bytSendArray(i + 3) = bytData(i / 2)
        bytSendArray(i + 4) = bytData(i / 2)
    Next   
    MSComm1.InBufferCount = 0                      'Çå¿Õ½ÓÊÕ»º³åÇø
    MSComm1.Output = bytSendArray                  '·¢ËÍÊý¾Ý    Do
        DoEvents
    Loop Until MSComm1.OutBufferCount = 0          'µÈ´ý£¬Ö±µ½Êý¾Ý·¢ËÍÍê±Ï    intGetDataLen = 5       sngTimeSpace = intGetDataLen * (11000# / 9600#) * 10#    sngTime = GetCurrentTime()                          '    Do While True                                  'Êý¾Ý½ÓÊÕ        DoEvents
        If MSComm1.InBufferCount >= intGetDataLen Then Exit Do        If Abs(GetCurrentTime() - sngTime) > sngTimeSpace Then    '³¬Ê±
            SendData = 1
            Exit Function
        End If    Loop    VarReceiveData = MSComm1.Input
    bytReceiveArray = VarReceiveData    '·µ»Ø֡УÑé
    SendData = 2                        'Ïȸ³Öµ½ÓÊÕµÄÊý¾Ý´íÎó
    If bytReceiveArray(0) = &HAC Then   
        If bytReceiveArray(1) = bytReceiveArray(2) And bytReceiveArray(3) = bytReceiveArray(4) Then
            If bytReceiveArray(1) = bytSendArray(1) And bytReceiveArray(3) = &HAA Then
                SendData = 0                'ÃüÁîÕýÈ·
            End If
        End If
    End IfExit FunctionErrExit:
    SendData = 3
End Function'*************************************************************************
Private Sub Form_Unload(Cancel As Integer)
   ClosePort  End Sub

Answer 3

谢谢各位的帮助，问题已经解决了，重新配置MSCOMM控件参数的方法是可行的，不过还必须在发送数据的循坏语句中加上DoEvents才能实现调用中断程序。
可否再请教个问题：
    我想用Shape控件制作的指示灯来显示串口通讯的状态，想用OnComm事件来控制，想在文件传输时让指示灯闪烁，但是写了下面的代码，运行发送和接收文件时一点反映都没有，不知道问题出在哪里？？？
     Private Sub MSComm_OnComm(Index As Integer)
Select Case MSComm(MachineIndex).CommEvent
 Case comEvCD
    If MSComm(MachineIndex).CDHolding Then               '检测DCD脚位电位
      shapeDCD.BackColor = "&H000000C0"        '改变指示灯为红灯
      Else
      shapeDCD.BackColor = "&H80000005"    '指示灯灭掉
    End If
    
 Case comEvCTS
    If MSComm(MachineIndex).CTSHolding Then              '检测CTS脚位电位
      shapeCTS.BackColor = "&H000000C0"    '改变指示灯为红灯
    Else
      shapeCTS.BackColor = "&H80000005"        '指示灯灭掉
    End If
    
 Case comEvDSR
     If MSComm(0).DSRHolding Then              '检测DSR脚位电位
       shapeDSR.BackColor = "&H000000C0" '改变指示灯为红灯      
    Else      
      shapeDSR.BackColor = "&H80000005" '指示灯灭掉
    End If
 Case comEvRing 
 Case comEvReceive
 Case comEvSend 
End Select
End Sub

Answer 4

在你的传输文件的代码中加入 DoEvent 可随时跳出

Answer 5

谢谢各位的帮助，问题已经解决了，重新配置MSCOMM控件参数的方法是可行的，不过还必须在发送数据的循坏语句中加上DoEvents才能实现调用中断程序。  
可否再请教个问题：  
       我想用Shape控件制作的指示灯来显示串口通讯的状态，想用OnComm事件来控制，想在文件传输时让指示灯闪烁，但是写了下面的代码，运行发送和接收文件时一点反映都没有，不知道问题出在哪里？？？  期待高手的指点...........
           
 
Private  Sub  MSComm_OnComm(Index  As  Integer)  
Select  Case  MSComm(MachineIndex).CommEvent  
 Case  comEvCD  
       If  MSComm(MachineIndex).CDHolding  Then                              '检测DCD脚位电位  
           shapeDCD.BackColor  =    "&H000000C0  "                '改变指示灯为红灯  
           Else  
           shapeDCD.BackColor  =    "&H80000005  "        '指示灯灭掉  
       End  If  
         
 Case  comEvCTS  
       If  MSComm(MachineIndex).CTSHolding  Then                            '检测CTS脚位电位  
           shapeCTS.BackColor  =    "&H000000C0  "        '改变指示灯为红灯  
       Else  
           shapeCTS.BackColor  =    "&H80000005  "                '指示灯灭掉  
       End  If  
         
 Case  comEvDSR  
         If  MSComm(0).DSRHolding  Then                            '检测DSR脚位电位  
             shapeDSR.BackColor  =    "&H000000C0  "  '改变指示灯为红灯              
       Else              
           shapeDSR.BackColor  =    "&H80000005  "  '指示灯灭掉  
       End  If  
 Case  comEvRing    
 Case  comEvReceive  
 Case  comEvSend    
End  Select  
End  Sub