经典的串口调试助手源代码(一)

Dim OutputAscii As Boolean
Dim InputString As String
Dim OutputString As String
'=====================================================================================
'                  变量定义
'=====================================================================================
Option Explicit                                                                    ' 强制显式声明
Dim ComSwitch As Boolean                                                            ' 串口开关状态判断
Dim FileData As String                                                              ' 要发送的文件暂存
Dim SendCount As Long                                                              ' 发送数据字节计数器
Dim ReceiveCount As Long                                                            ' 接收数据字节计数器
Dim InputSignal As String                                                          ' 接收缓冲暂存
Dim OutputSignal As String                                                          ' 发送数据暂存
Dim DisplaySwitch As Boolean                                                        ' 显示开关
Dim ModeSend As Boolean                                                            ' 发送方式判断
Dim Savetime As Single                                                              ' 时间数据暂存 延时用
Dim SaveTextPath As String                                                          ' 保存文本路径
' 网页超链接申明
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Sub CloseCom()  '关闭串口
On Error GoTo Err
    If MSComm.PortOpen = True Then MSComm.PortOpen = False                          ' 先判断串口是否打开,如果打开则先关闭
   
    txtstatus.Text = "STATUSCOM Port Cloced"                                      ' 串口状态显示
    mnuconnect.Caption = "断开串口"
    cmdswitch.Caption = "打开串口"
   
    'ImgSwitch.Picture = LoadPicture("f:\我的VB\串口调试软件\图片\guan.jpg")        ' 显示串口已经关闭的图标
    ImgSwitchoff.Visible = True
    ImgSwitchon.Visible = False
Err:
   
End Sub
Private Sub UpdateStatus()
    If MSComm.PortOpen Then
        StatusBar1.Panels(1).Text = "Connected"
            mnuautosend.Caption = "自动发送"
        mnuconnect.Caption = "断开串口"
    Else
        StatusBar1.Panels(1).Text = "断开串口"
            mnuautosend.Caption = "disautosend"
        mnuconnect.Caption = "打开串口"
    End If
    StatusBar1.Panels(2).Text = "COM" & MSComm.CommPort
    StatusBar1.Panels(3).Text = MSComm.Settings
    If (OutputAscii) Then
        StatusBar1.Panels(4) = "ASCII"
    Else
        StatusBar1.Panels(4) = "HEX"
  End If
  '
  On Error GoTo Err
    If ChkAutoSend.Value = 1 Then                                                  ' 如果有效则,自动发送
        If MSComm.PortOpen = True Then                                              ' 串口状态判断
            mnuautosend.Caption = "Dis&autosend"
            TmrAutoSend.Interval = Val(TxtAutoSendTime)                            ' 设置自动发送时间
            TmrAutoSend.Enabled = True                                              ' 打开自动发送定时器
        Else
            mnuautosend.Caption = "autosend"
            ChkAutoSend.Value = 0                                                  ' 串口没有打开去掉自动发送
            MsgBox "串口没有打开,请打开串口", 48, "串口调试助手"                  ' 如果串口没有被打开,提示打开串口
        End If
    ElseIf ChkAutoSend.Value = 0 Then                                              ' 如果无效,不发送
            mnuautosend.Caption = "autosend"
            TmrAutoSend.Enabled = False                                            ' 关闭自动发送定时器
    End If
Err:
 
End Sub
Private Sub CmdSendFile_Click() '发送文件
   
On Error GoTo Err
    If MSComm.PortOpen = True Then                                                  ' 如果串口打开了,则可以发送数据
        If FileData = "" Then                                                      ' 判断发送数据是否为空
            MsgBox "发送的文件为空", 16, "串口调试助手"                            ' 发送数据为空则提示
        Else
            If ChkHexReceive.Value = 1 Then                                        ' 如果按十六进制接收时,按二进制发送,否则按文本发送
unicode在线工具                MSComm.InputMode = comInputModeBinary                              ' 二进制发送
            Else
                MSComm.InputMode = comInputModeText                                ' 文本发送
            End If
           
            MSComm.Output = Trim(FileData)                                          ' 发送数据
           
            ModeSend = True                                                        ' 设置文本发送方式
        End If
    Else
        MsgBox "串口没有打开,请打开串口", 48, "串口调试助手"                      ' 如果串口没有被打开,提示打开串口
    End If
Err:
 
End Sub
Private Sub Comm_initial(Port As Byte, BaudRate As String, ParityBit As String, DataBit As Integer, StopBit As Integer)
    On Error GoTo ErrorTrap                  ' 错误则跳往错误处理
   
    If MSComm.PortOpen = True Then MSComm.PortOpen = False                          ' 先判断串口是否打开,如果打开则先关闭
   
    MSComm.CommPort = Port                                                          ' 设定端口
    MSComm.Settings = BaudRate & "," & ParityBit & "," & DataBit & "," & StopBit    ' 设置波特率,无校验,8位数据位,1位停止位
    MSComm.InBufferSize = 1024                                                      ' 设置接收缓冲区为1024字节
    MSComm.OutBufferSize = 4096                                                    ' 设置发送缓冲区为4096字节
    MSComm.InBufferCount = 0                                                        ' 清空输入缓冲区
    MSComm.OutBufferCount = 0                                                      ' 清空输出缓冲区
    MSComm.SThreshold = 1                                                          ' 发送缓冲区空触发发送
事件
    MSComm.RThreshold = 1                                                          ' X个字符到接收缓冲区引起触发接收事件
    MSComm.OutBufferCount = 0                                                      ' 清空发送缓冲区
    MSComm.InBufferCount = 0                                                        ' 滑空接收缓冲
    MSComm.PortOpen = True                                                          ' 打开串口
   
    If MSComm.PortOpen = True Then
        txtstatus.Text = "STATUS" & cbocom.Text & " OPEND" & cbobaudrate.Text & "," & Left(cboparitybit.Text, 1) & "," & cbodatabit.Text & "," & cbostopbit.Text
    Else
        txtstatus.Text = "STATUSCOM Port Cloced"                                  ' 串口没打开时,提示串口关闭状态
    End If
    Exit Sub
   
ErrorTrap:                                                                          ' 错误处理
    Select Case Err.Number
    Case comPortAlreadyOpen                                                        ' 如果串口已经打开,则提示
        MsgBox "没有发现此串口或被占用", 49, "串口调试助手"
        CloseCom
    Case Else
        MsgBox "没有发现此串口或被占用", 49, "串口调试助手"
        CloseCom
End Select
    Err.Clear
   
End Sub
Private Sub Comm_reSet(Port As Byte, BaudRate As String, ParityBit As String, DataBit As Integer, StopBit As Integer)

版权声明:本站内容均来自互联网,仅供演示用,请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198,我们将在24小时内删除。