经典的串口调试工具源代码（二）

经典的串口调试工具源代码（二）

Private Sub cmdswitch_Click()

On Error GoTo Err

If MSComm.PortOpen = True Then

ComSwitch = True

Else

ComSwitch = False

End If

If ComSwitch = False Then

StatusBar1.Panels(1).Text = \ mnuconnect.Caption = \ OpenCom ' 打开串口

ComSwitch = True

Else

CloseCom ' 关闭串口

ComSwitch = False

StatusBar1.Panels(1).Text = \

mnuconnect.Caption = \

StatusBar1.Panels(2).Text = \

StatusBar1.Panels(3).Text = MSComm.Settings

If (OutputAscii) Then

StatusBar1.Panels(4) = \

Else

StatusBar1.Panels(4) = \

End If End If

Err: End Sub

Private Sub Form_Load()

On Error GoTo Err

lblWEB.FontUnderline = True ' WEB上加下划线 lblWEB.ForeColor = vbBlue ' 蓝色显示WEB

txtsend.Text = \' 载入发送信息

If MSComm.PortOpen = True Then MSComm.PortOpen = False ' 先判断串口是否打

开，如果打开则先关闭

' 初始化串口

Call Comm_initial(Val(Mid(cbocom.Text, 4, 1)), cbobaudrate.Text, Left(cboparitybit.Text, 1),

cbodatabit.Text, cbostopbit.Text)

' 数据位载入 cbodatabit.AddItem \ cbodatabit.AddItem \ cbodatabit.AddItem \

' 停止位载入 cbostopbit.AddItem \ cbostopbit.AddItem \ cbostopbit.AddItem \

Err: End Sub

Private Sub hexReceive()

On Error GoTo Err

Dim ReceiveArr() As Byte ' 接收数据数组 Dim receiveData As String ' 数据暂存 Dim Counter As Integer ' 接收数据个数计数器

Dim i As Integer ' 循环变量

If (MSComm.InBufferCount > 0) Then

Counter = MSComm.InBufferCount ' 读取接收数据个数

receiveData = \' 清缓冲

ReceiveArr = MSComm.Input ' 数据放入数组 For i = 0 To (Counter - 1) Step 1 ' 数据格式处理

If (ReceiveArr(i) < 16) Then

receiveData = receiveData & \' 小于16，前面加0

Else

receiveData = receiveData & Hex(ReceiveArr(i)) & Space(1) ' 加空格显示

End If Next i

TxtReceive.Text = TxtReceive.Text + receiveData ' 显示接收的十六进制数据

TxtReceive.SelStart = Len(TxtReceive.Text) ' 显示光标位置

End If

ReceiveCount = ReceiveCount + Counter ' 接收计数 txtRXcount.Text = \' 接收字节数显示

If chkautoclear.Value = 1 Then ' 自动清空判断

If ReceiveCount >= 65535 Then

TxtReceive.Text = \

End If End If Err: End Sub

Private Sub hexSend() On Error Resume Next

Dim outputLen As Integer ' 发送数据长度 Dim outData As String ' 发送数据暂存 Dim SendArr() As Byte ' 发送数组 Dim TemporarySave As String ' 数据暂存 Dim dataCount As Integer ' 数据个数计数

Dim i As Integer ' 局部变量

outData = UCase(Replace(txtsend.Text, Space(1), Space(0))) ' 先去掉空格，再转换为

大写字母

outData = UCase(outData) ' 转换成大写 outputLen = Len(outData) ' 数据长度

For i = 0 To outputLen

TemporarySave = Mid(outData, i + 1, 1) ' 取一位数据

If (Asc(TemporarySave) >= 48 And Asc(TemporarySave) <= 57) Or (Asc(TemporarySave) >= 65

And Asc(TemporarySave) <= 70) Then dataCount = dataCount + 1

Else Exit For Exit Sub End If Next

If dataCount Mod 2 <> 0 Then ' 判断十六进制数据是否为双数

dataCount = dataCount - 1 ' 不是双数，则减1

End If

outData = Left(outData, dataCount) ' 取出有效的十六进制数据

ReDim SendArr(dataCount / 2 - 1) ' 重新定义数组长度

For i = 0 To dataCount / 2 - 1

SendArr(i) = Val(\' 取出数据转换成十六进制并放入

数组中 Next

SendCount = SendCount + (dataCount / 2) ' 计算总发送数

txtTXcount.Text = \

MSComm.Output = SendArr ' 发送数据

End Sub

Private Sub OpenCom() '打开串口

On Error GoTo Err

If MSComm.PortOpen = True Then MSComm.PortOpen = False ' 先判断串口是否打

开，如果打开则先关闭

Call Comm_reSet(Val(Mid(cbocom.Text, 4, 1)), cbobaudrate.Text, Left(cboparitybit.Text, 1),

cbodatabit.Text, cbostopbit.Text) ' 串口设置

If MSComm.PortOpen = True Then

txtstatus.Text = \：\，\

Left(cboparitybit.Text, 1) & \

cmdswitch.Caption = \关闭串口\ mnuconnect.Caption = \

'ImgSwitch.Picture = LoadPicture(\我的VB\\串口调试软件\\图片\\kai.jpg\' 显示串口已经打开的

图标

ImgSwitchon.Visible = True

ImgSwitchoff.Visible = False

Else

txtstatus.Text = \：COM Port Cloced\' 串口状态显示

cmdswitch.Caption = \打开串口\ mnuconnect.Caption = \

'ImgSwitch.Picture = LoadPicture(\我的VB\\串口调试软件\\图片\\guan.jpg\' 显示串口已经关闭

的图标

ImgSwitchoff.Visible = True ImgSwitchon.Visible = False

End If Err: End Sub

Private Sub textReceive()

On Error GoTo Err

InputSignal = MSComm.Input

ReceiveCount = ReceiveCount + LenB(StrConv(InputSignal, vbFromUnicode)) ' 计算总接收数据

If DisplaySwitch = False Then ' 显示接收文本 TxtReceive.Text = TxtReceive.Text & InputSignal ' 单片机内存的值用

TextReceive显示出

TxtReceive.SelStart = Len(TxtReceive.Text) ' 显示光标位置

End If

txtRXcount.Text = \' 接收字节数显示

If chkautoclear.Value = 1 Then ' 自动清空判断

If ReceiveCount >= 65535 Then

TxtReceive.Text = \

End If End If Err: End Sub

Private Sub textSend() On Error GoTo Err If ModeSend = True Then

OutputSignal = FileData ' 发送文件

Else

OutputSignal = txtsend.Text ' 发送文本

End If

SendCount = SendCount + LenB(StrConv(OutputSignal, vbFromUnicode)) ' 计算总发送数

txtTXcount.Text = \' 发送字节数显示

Err:

End Sub

Private Sub Image1_Click()

End Sub

Private Sub mnuautosend_Click()

On Error GoTo Err

'If TmrAutoSend.Enabled = True Then ' 如果有效则，自动发送

If MSComm.PortOpen = True Then ' 串口状态判断

ChkAutoSend.Value = 1

TmrAutoSend.Interval = Val(TxtAutoSendTime) ' 设置自动发送时间

mnuautosend.Caption = \取消自动发送\

TmrAutoSend.Enabled = True ' 打开自动发送定时器

Else

mnuautosend.Caption = \自动发送\

ChkAutoSend.Value = 0 ' 串口没有打开去掉自动发送 MsgBox \串口没有打开，请打开串口\串口调试助手\' 如果串口没有被打开，提

示打开串口 End If

'ElseIf TmrAutoSend.Enabled = False Then ' 如果无效，不发送

' mnuautosend.Caption = \

' TmrAutoSend.Enabled = False ' 关闭自动发送定时器

'End If Err: End Sub

Private Sub mnucom_Click(Index As Integer)

Dim i As Integer Dim OldPort As Long

On Error Resume Next

With MSComm OldPort = .CommPort If MSComm.PortOpen Then

.PortOpen = False .CommPort = Index .PortOpen = True

If Err.Number <> 0 Then ' This should not happen... MsgBox \

vbCrLf & Err.Description

Err.Clear .CommPort = OldPort

Else For i = 1 To 4

mnucom(i).Checked = False

Next i

mnucom(Index).Checked = True

End If Else

.CommPort = Index For i = 1 To 4

mnucom(i).Checked = False

Next i

mnucom(Index).Checked = True

End If End With UpdateStatus

End Sub

Private Sub mnuconnect_Click() On Error Resume Next If MSComm.PortOpen = True Then

ComSwitch = True

Else

ComSwitch = False

End If With MSComm If .PortOpen = True Then .PortOpen = False

txtstatus.Text = \：COM Port Cloced\' 串口状态显示

cmdswitch.Caption = \打开串口\

'ImgSwitch.Picture = LoadPicture(\我的VB\\串口调试软件\\图片\\guan.jpg\' 显示串口已经关闭

的图标

ImgSwitchoff.Visible = True ImgSwitchon.Visible = False

Else

.PortOpen = True ComSwitch = True

txtstatus.Text = \：\，\

Left(cboparitybit.Text, 1) & \

cmdswitch.Caption = \关闭串口\

'ImgSwitch.Picture = LoadPicture(\我的VB\\串口调试软件\\图片\\kai.jpg\' 显示串口已经打开的

图标

ImgSwitchon.Visible = True ImgSwitchoff.Visible = False

If Err.Number <> 0 Then

MsgBox \

Err.Description

Err.Clear End If End If End With

UpdateStatus

End Sub

Private Sub mnusave_Click()

On Error GoTo Err ' 错误处理 SaveTextPath = txtsavepath ' 路径暂存 Open txtsavepath & \' 打开文件

' 不存在的话 会创建文件,如已存在 会覆盖

' output 改为append 为追加

' 改为input 则只读 Print #1, Year(Date) & \年\月\ \日\时\分\

\秒\' 把接收区的文本保存 文本前加上

保存时间 （0000年00月00日00时00分00秒）

' vbcrlf 为回车换行 Close #1 ' 关闭文件

txtsavepath = \' 提示保存成功

cmdsavedisp.Enabled = False

Savetime = Timer ' 记下开始的时间

While Timer < Savetime + 5 ' 循环等待 5 - 要延时的时间 DoEvents ' 转让控制权，以便让操作系统处理其它的事

件。 Wend

txtsavepath = SaveTextPath ' 显示保存路径

cmdsavedisp.Enabled = True

Err: End Sub

Private Sub MSComm_OnComm()

On Error GoTo Err

Select Case MSComm.CommEvent ' 每接收1个数就触发一次

Case comEvReceive

If ChkHexReceive.Value = 1 Then

Call hexReceive ' 十六进制接收

Else

Call textReceive ' 文本接收

End If

Case comEvSend ' 每发送1个数就触发一次

If ChkHexsend.Value = 1 Then

Else

Call textSend ' 文本发送

End If

Case Else End Select

Err: End Sub

Private Sub TmrAutoSend_Timer()

On Error GoTo Err

If txtsend.Text = \' 判断发送数据是否为空 ChkAutoSend.Value = 0 ' 关闭自动发送

MsgBox \发送数据不能为空\串口调试助手\' 发送数据为空则提示

Else

If ChkHexsend.Value = 1 Then ' 发送方式判断 MSComm.InputMode = comInputModeBinary ' 二进制发送

Call hexSend ' 发送十六进制数据

Else ' 按十六进制接收文本方式发送的数据时，文本也

要按二进制发送发送

If ChkHexReceive.Value = 1 Then

MSComm.InputMode = comInputModeBinary ' 二进制发送

Else

MSComm.InputMode = comInputModeText ' 文本发送

End If

MSComm.Output = Trim(txtsend.Text) ' 发送数据

ModeSend = False ' 设置文本发送方式

End If End If Err: End Sub

Private Sub TxtReceive_Change()

End Sub

本文来源：https://www.bwwdw.com/article/ef1w.html