VB 串口调试助手源代码

 

Option Explicit                             '变量显示
'----------------------------------
'          变量定义申明
'----------------------------------
Public blnComOpen As Boolean                '串口状态
'----------------------------------
'          过程、函数定义
'----------------------------------
'----------------------------------
'             串口状态
'----------------------------------
Public Sub ComStatus()
    If frmMain.MSComm.PortOpen = False Then
        frmCom.shpComLed.BackColor = vbRed
        frmCom.cmdComSwitch.Caption = "打开串口"    ' 串口状态显示
        frmMain.StatusBar.Panels(3).Text = "COM Port Cloced"
        blnZigbeeModuleConnect = False
    ElseIf frmMain.MSComm.PortOpen = True Then
        frmCom.shpComLed.BackColor = vbGreen
        frmCom.cmdComSwitch.Caption = "关闭串口"
        frmMain.StatusBar.Panels(3).Text = "" & frmCom.cboCOM.Text & " OPEND," & frmCom.cboBaudRate.Text & "," & _
            "" & Mid(frmCom.cboParityBit.Text, 2, 1) & "," & frmCom.cboDataBit.Text & "," & frmCom.cboStopBit.Text
    End If
End Sub
'----------------------------------
'            打开串口
'----------------------------------
Public Sub ComOpen()
On Error GoTo Err
    If frmMain.MSComm.PortOpen = True Then
        frmMain.MSComm.PortOpen = False             ' 先判断串口是否打开，如果打开则先关闭
    End If
   
    Call Com_reSet(Val(Mid(frmCom.cboCOM.Text, 4, 1)), Val(frmCom.cboBaudRate.Text), Mid(frmCom.cboParityBit.Text, 2, 1), Val(frmCom.cboDataBit.Text), Val(frmCom.cboStopBit.Text)) '串口设置
   
    If frmMain.MSComm.PortOpen = True Then
        blnComOpen = True
    Else
        blnComOpen = False
    End If
    Call Status
Err:
End Sub
'----------------------------------
'            关闭串口
'----------------------------------
Public Sub ComClose()
On Error GoTo Err
    If frmMain.MSComm.PortOpen = True Then
        frmMain.MSComm.PortOpen = False                 ' 先判断串口是否打开，如果打开则先关闭
    End If
   
    blnComOpen = False
    Call Status
Err:
End Sub
'----------------------------------
'           串口初始化
'----------------------------------
Public Sub Com_initial(Port As Double, BaudRate As Double, ParityBit As String, DataBit As Double, StopBit As Double)
On Error GoTo ErrorTrap                                     ' 错误则跳往错误处理
    If frmMain.MSComm.PortOpen = True Then
        frmMain.MSComm.PortOpen = False                      ' 先判断串口是否打开，如果打开则先关闭
    End If
    frmMain.MSComm.InputMode = comInputModeBinary                                           ' 二进制发送
    frmMain.MSComm.CommPort = Port                                                          ' 设定端口
    frmMain.MSComm.Settings = BaudRate & "," & ParityBit & "," & DataBit & "," & StopBit    ' 设置波特率，无校验，8位数据位，1位停止位
    frmMain.MSComm.InBufferSize = 1024                                                      ' 设置接收缓冲区为1024字节
    frmMain.MSComm.OutBufferSize = 4096                                                     ' 设置发送缓冲区为4096字节
    frmMain.MSComm.InBufferCount = 0                                                        ' 清空输入缓冲区
    frmMain.MSComm.OutBufferCount = 0                                                       ' 清空输出缓冲区
    frmMain.MSComm.SThreshold = 1                                                           ' 发送缓冲区空触发发送事件
    frmMain.MSComm.RThreshold = 1                                                           ' 每X个字符到接收缓冲区引起触发接收事件
    frmMain.MSComm.OutBufferCount = 0                                                       ' 清空发送缓冲区
    frmMain.MSComm.InBufferCount = 0                                                        ' 清空接收缓冲区
    frmMain.MSComm.PortOpen = True                                                          ' 打开串口
   
    If frmMain.MSComm.PortOpen = True Then
        blnComOpen = True
    Else
        blnComOpen = False
    End If
    Call Status
    Exit Sub
ErrorTrap:                                                                                  ' 错误处理
    Select Case Err.Number
        Case comPortAlreadyOpen                                                             ' 如果串口已经打开，则提示
            If MsgBox("没有发现串口或被占用", vbOKOnly + vbExclamation, "警告") = vbOK Then
                Call ComClose
            End If
        Case Else
            If MsgBox("没有发现串口或被占用", vbOKOnly + vbExclamation, "警告") = vbOK Then
                Call ComClose
            End If
    End Select
    Err.Clear                                                                               ' 清除 Err 对象的属性
End Sub
'----------------------------------
'           串口号重设
'----------------------------------
Public Sub Com_reSet(Port As Double, BaudRate As Double, ParityBit As String, DataBit As Double, StopBit As Double)
On Error GoTo ErrorHint                                      ' 错误则跳往错误处理
    If frmMain.MSComm.PortOpen = True Then
        frmMain.MSComm.PortOpen = False                      ' 先判断串口是否打开，如果打开则先关闭
    End If
   
    frmMain.MSComm.CommPort = Port                                                          ' 设定端口
    frmMain.MSComm.Settings = BaudRate & "," & ParityBit & "," & DataBit & "," & StopBit    ' 设置波特率，无校验，8位数据位，1位停止位
    frmMain.MSComm.PortOpen = True                                                          ' 打开串口

    If frmMain.MSComm.PortOpen = True Then
        blnComOpen = True
    Else
        blnComOpen = False
    End If
    Call Status
    Exit Sub
ErrorHint:                                                                                  ' 错误处理
    Select Case Err.Number
        Case comPortAlreadyOpen                                                             ' 如果串口已经打开，则提示
            If MsgBox("没有发现串口或被占用", vbOKOnly + vbExclamation, "警告") = vbOK Then
                Call ComClose
            End If
        Case Else
            If MsgBox("没有发现串口或被占用", vbOKOnly + vbExclamation, "警告") = vbOK Then
                Call ComClose
            End If
    End Select
    Err.Clear                                                                               ' 清除 Err 对象的属性
End Sub
'----------------------------------
'         串口配置初始化
'----------------------------------
Public Sub Com_Init()
    blnComOpen = False
    frmCom.shpComLed.BackColor = &H0&
    frmCom.cmdComSwitch.Caption = "打开串口"
    frmCom.cboCOM = "COM1"
    frmCom.cboBaudRate = "38400"
    frmCom.cboParityBit = "无NONE"
    frmCom.cboDataBit = "8"
    frmCom.cboStopBit = "1"
   
    Call Com_initial(Val(Mid(frmCom.cboCOM.Text, 4, 1)), Val(frmCom.cboBaudRate.Text), Mid(frmCom.cboParityBit.Text, 2, 1), Val(frmCom.cboDataBit.Text), Val(frmCom.cboStopBit.Text)) '串口设置
End Sub
'----------------------------------
'        复位MSComm
'----------------------------------
Public Sub reSetMSComm()
On Error GoTo Err
    frmMain.MSComm.PortOpen = False
    frmMain.MSComm.InputMode = comInputModeBinary   ' 二进制发送
    frmMain.MSComm.InputLen = 0                     ' 设置接收缓冲区为0字节
    frmMain.MSComm.InBufferCount = 0                ' 滑空接收缓冲
    frmMain.MSComm.RThreshold = 1                   ' 每X个字符到接收缓冲区引起触发接收事件
    frmMain.MSComm.PortOpen = True
Err:
End Sub
'----------------------------------
'           End Of File
'----------------------------------

Option Explicit                             '变量显示
'----------------------------------
'          窗体导入卸载
'----------------------------------
Private Sub Form_Load()
    frmCom.Caption = GS_SYSTEMTITLE & "__串口配置"
   
    frmCom.Height = 3840
    frmCom.Width = 5350
End Sub

Private Sub Form_Unload(Cancel As Integer)
    frmMain.Enabled = True
    frmMain.SetFocus
End Sub
'----------------------------------
'         串口配置选择
'----------------------------------
Private Sub cboCOM_Click()
    Call Com_reSet(Val(Mid(frmCom.cboCOM.Text, 4, 1)), Val(frmCom.cboBaudRate.Text), Mid(frmCom.cboParityBit.Text, 2, 1), Val(frmCom.cboDataBit.Text), Val(frmCom.cboStopBit.Text)) '串口设置
End Sub

Private Sub cboBaudRate_Click()
    Call Com_reSet(Val(Mid(frmCom.cboCOM.Text, 4, 1)), Val(frmCom.cboBaudRate.Text), Mid(frmCom.cboParityBit.Text, 2, 1), Val(frmCom.cboDataBit.Text), Val(frmCom.cboStopBit.Text)) '串口设置
End Sub

Private Sub cboParityBit_Click()
    Call Com_reSet(Val(Mid(frmCom.cboCOM.Text, 4, 1)), Val(frmCom.cboBaudRate.Text), Mid(frmCom.cboParityBit.Text, 2, 1), Val(frmCom.cboDataBit.Text), Val(frmCom.cboStopBit.Text)) '串口设置
End Sub

Private Sub cboDataBit_Click()
    Call Com_reSet(Val(Mid(frmCom.cboCOM.Text, 4, 1)), Val(frmCom.cboBaudRate.Text), Mid(frmCom.cboParityBit.Text, 2, 1), Val(frmCom.cboDataBit.Text), Val(frmCom.cboStopBit.Text)) '串口设置
End Sub

Private Sub cboStopBit_Click()
    Call Com_reSet(Val(Mid(frmCom.cboCOM.Text, 4, 1)), Val(frmCom.cboBaudRate.Text), Mid(frmCom.cboParityBit.Text, 2, 1), Val(frmCom.cboDataBit.Text), Val(frmCom.cboStopBit.Text)) '串口设置
End Sub
'----------------------------------
'             串口打开
'----------------------------------
Private Sub cmdComSwitch_Click()
On Error GoTo Err:
    frmCom.cmdComSwitch.Enabled = False
    Call Delay(50)
    frmCom.cmdComSwitch.Enabled = True
    If frmMain.MSComm.PortOpen = True Then
        blnComOpen = True
        Call ComClose                       ' 关闭串口
    Else
        blnComOpen = False
        Call ComOpen                        ' 打开串口
        blnComOpen = True
        '当窗体不是，设置串口时串口窗体能自动关闭
        If (frmMain.MSComm.PortOpen = True And blnZigbeeModuleSelect = True) Then
            Unload Me
        End If
    End If
Err:
End Sub
'----------------------------------
'          End Of File
'----------------------------------
'----------------------------------
'     MSComm核心程序(串口通信)
'----------------------------------
Public Sub MSComm_OnComm()
On Error GoTo Err
    Select Case frmMain.MSComm.CommEvent            ' 每接收1个数就触发一次
        Case comEvReceive
                      接收程序
            Else
                Call reSetMSComm                    ' 复位MSComm
            End If
    End Select
Err:
End Sub