经典的串口调试工具源代码(二)

经典的串口调试工具源代码（二）
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 = "Connected"
mnuconnect.Caption = "Dis&connect"
OpenCom ' 打开串口
ComSwitch = True
Else
CloseCom ' 关闭串口
ComSwitch = False
StatusBar1.Panels(1).Text = "Disconnected"
mnuconnect.Caption = "&Connect"
StatusBar1.Panels(2).Text = "COM" & mPort StatusBar1.Panels(3).Text = MSComm.Settings
If (OutputAscii) Then
StatusBar1.Panels(4) = "ASCII"
Else
StatusBar1.Panels(4) = "HEX"
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 "8"
cbodatabit.AddItem "7"
cbodatabit.AddItem "6"
' 停止位载入
cbostopbit.AddItem "1"
cbostopbit.AddItem "1.5"
cbostopbit.AddItem "2"
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 & "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 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 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 = "关闭串口"
mnuconnect.Caption = "disconnect"
'ImgSwitch.Picture = LoadPicture("f:\我的VB\串口调试软件\图片\kai.jpg") ' 显示串口已经打开的
图标
ImgSwitchon.Visible = True
ImgSwitchoff.Visible = False
Else
txtstatus.Text = "STATUS：COM Port Cloced" ' 串口状态显示
cmdswitch.Caption = "打开串口"
mnuconnect.Caption = "connect"
'ImgSwitch.Picture = LoadPicture("f:\我的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 = "RX:" & ReceiveCount ' 接收字节数显示
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 = "TX:" & SendCount ' 发送字节数显示
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 "串口没有打开，请打开串口", 48, "串口调试助手" ' 如果串口没有被打开，提
示打开串口
End If
'ElseIf TmrAutoSend.Enabled = False Then ' 如果无效，不发送
' mnuautosend.Caption = "autosend"
' 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 "Com" & Index & " is not available." & _
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 = "STATUS：COM Port Cloced" ' 串口状态显示
cmdswitch.Caption = "打开串口"
'ImgSwitch.Picture = LoadPicture("f:\我的VB\串口调试软件\图片\guan.jpg") ' 显示串口已经关闭
的图标
ImgSwitchoff.Visible = True
ImgSwitchon.Visible = False
Else
.PortOpen = True
ComSwitch = True
txtstatus.Text = "STATUS：" & cbocom.Text & " OPEND，" & cbobaudrate.Text & "," & Left(cboparitybit.Text, 1) & "," & cbodatabit.Text & "," & cbostopbit.Text
cmdswitch.Caption = "关闭串口"
'ImgSwitch.Picture = LoadPicture("f:\我的VB\串口调试软件\图片\kai.jpg") ' 显示串口已经打开的
图标
ImgSwitchon.Visible = True
ImgSwitchoff.Visible = False
If Err.Number <> 0 Then
MsgBox "Com" & .CommPort & " is not available." & vbCrLf & _
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 & "\1.txt" For Output As #1 ' 打开文件
' 不存在的话会创建文件,如已存在会覆盖
' output 改为append 为追加
' 改为input 则只读
Print #1, Year(Date) & "年" & Month(Date) & "月" & Day(Date) & _
"日" & Hour(Time) & "时" & Minute(Time) & "分" & Second(Time) & _
"秒" & vbCrLf & TxtReceive.Text + vbCrLf ' 把接收区的文本保存文本前加上保存时间（0000年00月00日00时00分00秒）
' vbcrlf 为回车换行
Close #1 ' 关闭文件
txtsavepath = "OK,1.txt Save" ' 提示保存成功
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 mEvent ' 每接收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 = "" Then ' 判断发送数据是否为空ChkAutoSend.Value = 0 ' 关闭自动发送MsgBox "发送数据不能为空", 16, "串口调试助手" ' 发送数据为空则提示
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。