经典的串口调试助手源代码(一)
2011年04月26日
经典的串口调试助手源代码(一)VB在单片机中的应用
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 = "STATUS:COM 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 ' 如果按十六进制接收时,按二进制发送,否则按文本发送
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 = "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") ' 显示串口已经打开的图标
ImgSwitchoff.Visible = False
mnuconnect.Caption = "disconnect"
ImgSwitchon.Visible = True
txtstatus.Text = "STATUS:" & cbocom.Text & " OPEND," & cbobaudrate.Text & "," & Left(cboparitybit.Text, 1) & "," & cbodatabit.Text & "," & cbostopbit.Text
Else
cmdswitch.Caption = "打开串口"
'ImgSwitch.Picture = LoadPicture("f:\我的VB\串口调试软件\图片\guan.jpg") ' 显示串口已经关闭的图标
ImgSwitchon.Visible = False
ImgSwitchoff.Visible = True
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 Command1_Click()
End Sub
Private Sub cbobaudrate_Change()
Call Comm_reSet(Val(Mid(cbocom.Text, 4, 2)), cbobaudrate.Text, Left(cboparitybit.Text, 1), cbodatabit.Text, cbostopbit.Text) '串口设置
End Sub
Private Sub cbocom_Change()
Call Comm_reSet(Val(Mid(cbocom.Text, 4, 2)), cbobaudrate.Text, Left(cboparitybit.Text, 1), cbodatabit.Text, cbostopbit.Text) '串口设置
End Sub
Private Sub cbodatabit_Change()
Call Comm_reSet(Val(Mid(cbocom.Text, 4, 2)), cbobaudrate.Text, Left(cboparitybit.Text, 1), cbodatabit.Text, cbostopbit.Text) '串口设置
End Sub
Private Sub cboparitybit_Change()
Call Comm_reSet(Val(Mid(cbocom.Text, 4, 2)), cbobaudrate.Text, Left(cboparitybit.Text, 1), cbodatabit.Text, cbostopbit.Text) '串口设置
End Sub
Private Sub cbostopbit_Change()
Call Comm_reSet(Val(Mid(cbocom.Text, 4, 2)), cbobaudrate.Text, Left(cboparitybit.Text, 1), cbodatabit.Text, cbostopbit.Text) '串口设置
End Sub
Private Sub chkautosend_Click()
On Error GoTo Err
If ChkAutoSend.Value = 1 Then ' 如果有效则,自动发送
If MSComm.PortOpen = True Then ' 串口状态判断
mnuautosend.Caption = "取消自动发送"
TmrAutoSend.Interval = Val(TxtAutoSendTime) ' 设置自动发送时间
TmrAutoSend.Enabled = True ' 打开自动发送定时器
Else
ChkAutoSend.Value = 0 ' 串口没有打开去掉自动发送
MsgBox "串口没有打开,请打开串口", 48, "串口调试助手" ' 如果串口没有被打开,提示打开串口
End If
ElseIf ChkAutoSend.Value = 0 Then ' 如果无效,不发送
mnuautosend.Caption = "自动发送数据"
TmrAutoSend.Enabled = False ' 关闭自动发送定时器
End If
Err:
End Sub
Private Sub cmdamend_Click()
Dim spShell As Object ' 定义存放引用对象的变量
Dim spFolder As Object ' 定义存放引用对象的变量
Dim spFolderItem As Object ' 定义存放引用对象的变量
Dim spPath As String ' 定义存放的变量
On Error GoTo Err ' 错误处理,防止取消打开文件夹时报错
Const WINDOW_HANDLE = 0
Const NO_OPTIONS = 0
Set spShell = CreateObject("Shell.Application")
Set spFolder = spShell.BrowseForFolder(WINDOW_HANDLE, "选择目录:", NO_OPTIONS, "C:\Scripts")
Set spFolderItem = spFolder.Self
spPath = spFolderItem.Path
spPath = Replace(spPath, "\", "\") ' Replace函数的返回值是一个字符串
txtsavepath.Text = spPath ' 把文件夹路径显示在标签上
SaveTextPath = txtsavepath.Text ' 路径暂存
Err:
End Sub
Private Sub CmdClearCounter_Click()
On Error GoTo Err
SendCount = 0 ' 发送计数器清零
ReceiveCount = 0 ' 接收计数器清零
txtRXcount.Text = "RX:" & 0 ' 接收计数
txtTXcount.Text = "TX:" & 0 ' 发送计数
Err:
End Sub
Private Sub cmdclearrecieve_Click()
TxtReceive.Text = ""
End Sub
Private Sub cmdclearsend_Click()
txtsend.Text = ""
End Sub
Private Sub CmdHelp_Click()
FrmHelp.Show
End Sub
Private Sub CmdQuit_Click()
If MSComm.PortOpen = True Then MSComm.PortOpen = False ' 先判断串口是否打开,如果打开则先关闭
Unload Me ' 卸载窗体,并退出程序
End
End Sub
Private Sub cmdsavedisp_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 CmdSelectFile_Click() ' 选择要发送的文件
On Error GoTo Err ' 错误处理
CommonDialog1.Flags = cdlCFBoth
CommonDialog1.ShowOpen
TxtSendPath.Text = CommonDialog1.FileName ' 把打开的文件名给于TxtSendPath
Open TxtSendPath.Text For Input As 1 ' 打开选择的文件
FileData = StrConv(InputB$(LOF(1), 1), vbUnicode) ' 显示打开的文件
Close 1 ' 关闭文件
Err:
End Sub
Private Sub cmdsend_Click()
On Error GoTo Err
If MSComm.PortOpen = True Then ' 如果串口打开了,则可以发送数据
If txtsend.Text = "" Then ' 判断发送数据是否为空
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
Else
MsgBox "串口没有打开,请打开串口", 48, "串口调试助手" ' 如果串口没有被打开,提示打开串口
End If
Err:
End Sub
Private Sub cmdstopdisp_Click()
On Error GoTo Err
If DisplaySwitch = False Then
DisplaySwitch = True ' 关闭显示
cmdstopdisp.Caption = "继续显示"
Else
DisplaySwitch = False ' 开启显示
cmdstopdisp.Caption = "停止显示"
End If
Err:
End Sub
发表评论
-
C和C++之间库的互相调用
2012-01-20 12:20 643C和C++之间库的互相调用 2011年01月19日 1. ... -
linux文件缓冲区
2012-01-20 12:20 989linux文件缓冲区 2011年01 ... -
字母大小写转换可以不用循环吗
2012-01-20 12:20 716字母大小写转换可以不用循环吗 2011年03月22日 2 ... -
VC6下将ANSI程序转化为UNICODE基本步骤
2012-01-20 12:20 1219VC6下将ANSI程序转化为UNI ... -
Linux0.11内核--汇编和C语言混合编程之参数传递
2012-01-20 12:20 767Linux0.11内核--汇编和C语言混合编程之参数传递 2 ... -
3月编程语言排行榜:C#超Python和PHP
2012-01-19 17:01 8043月编程语言排行榜:C#超Python和PHP 2011年0 ... -
python os模块
2012-01-19 17:01 1013python os模块 2011年05月22日 os.l ... -
2010年IT薪酬报告:java,apex,python,windows技术最赚钱
2012-01-19 17:01 7722010年IT薪酬报告:java,apex ... -
python 实现多台UNIX服务器自动巡检
2012-01-19 17:01 1828python 实现多台UNIX服务器自动巡检 2012年01 ... -
初学Python有感!!!
2012-01-19 17:01 566初学Python有感!!! 2011年01月25日 ... -
VC++6.0实现超链接
2012-01-17 06:46 1203VC++6.0实现超链接 2011年 ... -
经典的串口调试助手源代码(一)
2012-01-17 06:46 838经典的串口调试助手源代码(一) 2011年05月26日 ... -
转 Windows API 函数在VFP中的运用
2012-01-17 06:46 1177转 Windows API 函数在VFP中的运用 2010年 ... -
VB-2.1
2012-01-17 06:46 678VB-2.1 2011年09月26日 Option E ... -
越南攻略
2012-01-16 05:36 565越南攻略 2010年07月02日 ... -
去越南相亲吧~~~~~
2012-01-16 05:36 587去越南相亲吧~~~~~ 2011年05月04日 越南,一 ... -
谷歌找客户的方法
2012-01-16 05:35 565谷歌找客户的方法 2011年12月16日 Wind怎么利 ...
相关推荐
串口调试助手源码,单片机程序调试,小巧好用
基于VB6.0平台编写的串口调试助手源代码(附exe文件),供新手学习开发调试使用,可以参考和借鉴来开发自己的程序。
该资源有两个,一是串口调试助手的源代码,可以实现数据的接收和发送;二是实现点击某个按钮发送指定数据的应用程序的源代码。代码都是含有详细的中文注释,可以直接编译通过,且内含可执行文件都是可以直接运行的。...
C++编写的串口助手源代码,实测很好用。VS可以直接打开测试
串口调试助手源代码
VS2010下,使用MSComm开发的串口调试助手源代码。 添加了很多说明,适合新手使用 由于vs2010默认条件下是没有mscomm的,因此需要首先安装mscomm控件。 在本网站也可以搜索到。
用Visual C++编写的串口调试助手 源代码
VB编写的串口调试助手源代码,供新手学习开发调试使用。 可以借鉴用来开发自己的程序,达到开发的效果。
vb源代码,串口调试助手代码,没经过测试,不知道能不能用。
串口调试助手C#代码,串口调试助手C#代码,
串口调试助手及源码 CSerialPort 定时自动发送 发送txt文件
VB编程 串口调试助手 源代码.。。。。。。。。。
串口调试助手源代码,在原来的功能基础上增加了发送时间,时间到毫秒级,可以知道串口接收要用多少时间。
串口精灵源代码,写上位机的初学者们 不妨进来看看,会对你有所帮助的.
利用MATLAB书写的一个串口调试助手,不仅可以实现在线串口调试功能,而且是各位学习GUIDE界面很好的一个学习题材,希望此文档能够对您在MATLAB学习中起到帮助。
C# 串口调试助手,工程源码程序,VS2017版本,包括打包程序
VC串口调试软件的源代码,还可以,挺好用