📄
字号:
On Error GoTo Err
If ModeSend = True Then
OutputSignal = FileData ' 发送文件
Else
OutputSignal = TxtSend.Text ' 发送文本
End If
SendCount = SendCount + LenB(StrConv(OutputSignal, vbFromUnicode)) ' 计算总发送数
TxtTXCount.Text = "TX:" & SendCount ' 发送字节数显示
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("&H" + Mid(outData, i * 2 + 1, 2)) ' 取出数据转换成十六进制并放入数组中
Next
SendCount = SendCount + (dataCount / 2) ' 计算总发送数
TxtTXCount.Text = "TX:" & SendCount
MSComm.Output = SendArr ' 发送数据
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 & "0" + Hex(ReceiveArr(i)) & Space(1) ' 小于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 = "RX:" & ReceiveCount ' 接收字节数显示
If ChkAutoClear.Value = 1 Then ' 自动清空判断
If ReceiveCount >= 65535 Then
TxtReceive.Text = ""
End If
End If
Err:
End Sub
'=====================================================================================
' 串口开关
'=====================================================================================
Private Sub CmdSwitch_Click() ' 串口开关按钮
On Error GoTo Err
If MSComm.PortOpen = True Then
ComSwitch = True
Else
ComSwitch = False
End If
If ComSwitch = False Then
OpenCom ' 打开串口
ComSwitch = True
Else
CloseCom ' 关闭串口
ComSwitch = False
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 = "STATUS：COM 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)
On Error GoTo ErrorHint ' 错误则跳往错误处理
If MSComm.PortOpen = True Then MSComm.PortOpen = False ' 先判断串口是否打开，如果打开则先关闭
MSComm.CommPort = Port ' 设定端口
MSComm.Settings = BaudRate & "," & ParityBit & "," & DataBit & "," & StopBit ' 设置波特率，无校验，8位数据位，1位停止位
MSComm.PortOpen = True ' 打开串口
If MSComm.PortOpen = True Then
CmdSwitch.Caption = "关闭串口"
'ImgSwitch.Picture = LoadPicture("f:\我的VB\串口调试软件\图片\kai.jpg") ' 显示串口已经打开的图标
ImgSwitchOn.Visible = True
ImgSwitchOff.Visible = False
TxtStatus.Text = "STATUS：" & CboCom.Text & " OPEND，" & CboBaudrate.Text & "," & Left(CboParitybit.Text, 1) & "," & CboDatabit.Text & "," & CboStopbit.Text
Else
CmdSwitch.Caption = "打开串口"
ImgSwitchOn.Visible = False
ImgSwitchOff.Visible = True
'ImgSwitch.Picture = LoadPicture("f:\我的VB\串口调试软件\图片\guan.jpg") ' 显示串口已经关闭的图标
TxtStatus.Text = "STATUS：COM Port Cloced"
End If
Exit Sub
ErrorHint: ' 错误处理
Select Case Err.Number
Case comPortAlreadyOpen ' 如果串口已经打开，则提示
MsgBox "没有成功，请重试", vbExclamation, "串口调试助手"
CloseCom ' 调用关闭串口函数
Case Else
MsgBox "没有成功，请重试", vbExclamation, "串口调试助手"
CloseCom ' 调用关闭串口函数
End Select
Err.Clear ' 清除 Err 对象的属性
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 = "STATUS：" & CboCom.Text & " OPEND，" & CboBaudrate.Text & "," & Left(CboParitybit.Text, 1) & "," & CboDatabit.Text & "," & CboStopbit.Text
CmdSwitch.Caption = "关闭串口"
ImgSwitchOn.Visible = True ' 显示串口已经打开的图标
ImgSwitchOff.Visible = False
Else
TxtStatus.Text = "STATUS：COM Port Cloced" ' 串口状态显示
CmdSwitch.Caption = "打开串口"
'ImgSwitch.Picture = LoadPicture("f:\我的VB\串口调试软件\图片\guan.jpg") ' 显示串口已经关闭的图标
ImgSwitchOff.Visible = True
ImgSwitchOn.Visible = False
End If
Err:
End Sub
Private Sub CloseCom() '关闭串口
On Error GoTo Err
If MSComm.PortOpen = True Then MSComm.PortOpen = False ' 先判断串口是否打开，如果打开则先关闭
TxtStatus.Text = "STATUS：COM Port Cloced" ' 串口状态显示
CmdSwitch.Caption = "打开串口"
'ImgSwitch.Picture = LoadPicture("f:\我的VB\串口调试软件\图片\guan.jpg") ' 显示串口已经关闭的图标
ImgSwitchOn.Visible = False
ImgSwitchOff.Visible = True
Err:
End Sub
'=====================================================================================
' 显示时间
'=====================================================================================
Private Sub TmrNowTime_Timer()
LblNewDate.Caption = Date ' 显示时间
LblNowTime.Caption = Time ' 显示系统时间
End Sub
'=====================================================================================
' 程序退出
'=====================================================================================
Private Sub CmdQuit_Click() ' 退出程序
If MSComm.PortOpen = True Then MSComm.PortOpen = False ' 先判断串口是否打开，如果打开则先关闭
Unload Me ' 卸载窗体，并退出程序
End
End Sub
'=====================================================================================
' 帮助信息
'=====================================================================================
Private Sub CmdHelp_Click() ' 载入帮助信息窗口
FrmHelp.Show
End Sub
'--------------- 程序结束 ------------------
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -