串口通信示例

时间：2009-09-21 点击：次来源：本站原创作者：佚名 - 小 + 大

源码下载地址：http://blog.csdn.net/yefanqiu 【叶帆源码】[009]串口通信示例

'*************************************************************************
'**                   叶帆源码     CSDN：yefanqiu
'**-----------------------------------------------------------------------
'**叶帆源码：http://blog.csdn.net/yefanqiu  -->[叶帆源码]
'**          XP窗体界面
'**          串口通信示例
'**          任意透明窗体
'**          ...
'**叶帆软件：http://blog.csdn.net/yefanqiu  -->[叶帆软件]
'**          API 浏览器
'**          VB源码之友
'**
'**更多软件，更多源码请关注【叶帆Blog】
'**叶帆Blog：http://blog.csdn.net/yefanqiu
'*************************************************************************
'*************************************************************************
'**模块名：frmMain
'**说    明：YFHome 版权所有2004 - 2005(C)
'**创建人：叶帆
'**日    期：2004-09-19
'**修改人：
'**日    期：
'**描    述：串口通信示例（CSDN 开源）
'**        ：-------------------------------------------------------
'**        ：示例说明
'**        ：�
'**        ：该示例程序模拟PC机与一终端（下位机）串口通信，PC机先向下位机发送五个字节，下位机
'**        ：收到数据后也返回送五个字节的确认命令
'**        ：�
'**        ：         字头  站号  副本  命令  副本�
'**        ：帧结构：AC    01    01    0A    0A           正副本校验方式
'**        ：
'**        ：返回帧：AC    01    01    AA    AA           响应命令，表示终端接收到数据
'**        ：-------------------------------------------------------
'**版    本：V1.0.0
'*************************************************************************
Option Explicit
Private Declare Function GetCurrentTime Lib "kernel32" Alias "GetTickCount" () As Long

'*************************************************************************
'**函数名：cmdSend_Click
'**输    入：无
'**输    出：无
'**功能描述：发送命令
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2004-09-19
'**修改人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Private Sub cmdSend_Click()
  Dim bytData(10) As Byte
  bytData(0) = &HA                           '数据
  txtMsg.Text = SendData(1, bytData, 1)      '发送命令
End Sub

'*************************************************************************
'**函数名：Form_Load
'**输    入：无
'**输    出：无
'**功能描述：串口初始化
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2004-09-19
'**修改人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Private Sub Form_Load()
   OpenPort 1            '打开串口
End Sub

'*************************************************************************
'**函数名：OpenPort
'**输    入：PortNo(Integer)                       - 串口号 1，2，3...
'**        ：Optional InBufferSize(Integer = 1024) - 接收缓冲区  默认为1024个字节
'**        ：Optional OutBufferSize(Integer = 512) - 发送缓冲区  默认为512个字节
'**输    出：0 打开串口成功 1 打开串口失败
'**功能描述：打开串口
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2003年12月17日
'**修改人：
'**日    期：
'**版    本：V1.0
'*************************************************************************
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
'*************************************************************************
'**函数名：ClosePort
'**输    入：无
'**输    出：无
'**功能描述：关闭串口
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2003年12月15日
'**修改人：
'**日    期：
'**版    本：V1.0
'*************************************************************************
Public Sub ClosePort()
   On Error GoTo ErrExit
     MSComm1.PortOpen = False                      '关闭端口
   Exit Sub
ErrExit:

End Sub

'*************************************************************************
'**函数名：SendData
'**输    入：bytAddr(Byte)   - 设备地址(0～255)
'**        ：bytData()(byte) - 数据数组
'**        ：bytNum(byte)    - 数据个数(1～256/数据类型的长度)
'**输    出：(Long) - 0 成功 1 －超时  2 －接收的数据有误  3 - 其它未知错误
'**功能描述：发送数据
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2004年05月19日
'**修改人：
'**日    期：
'**版    本：V1.0
'*************************************************************************
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

    '超时时间计算:字节数×每个字节的传输时间×10             9600为波特率请根据实际设定
    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 If

Exit Function

ErrExit:
    SendData = 3
End Function

'*************************************************************************
'**函数名：Form_Unload
'**输    入：Cancel(Integer) -
'**输    出：无
'**功能描述：结束处理
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2004-09-19
'**修改人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Private Sub Form_Unload(Cancel As Integer)
   ClosePort  '关闭串口
End Sub

上一篇：MSComm控件进行串口编程的基本步骤

下一篇：五六电子网