实例介绍
【实例简介】串口调试助手的源代码，可以实现数据的接收和发送；二是实现点击某个按钮发送指定数据的应用程序的源代码。代码都是含有详细的中文注释，可以直接编译通过，且内含可执行文件都是可以直接运行的。适合作为串口助手开发与原理了解的参考，希望本资源对您有用！
【实例截图】
【核心代码】
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1
Caption = "串口"
ClientHeight = 5760
ClientLeft = 60
ClientTop = 450
ClientWidth = 7155
Icon = "串口.frx":0000
LinkTopic = "Form1"
ScaleHeight = 5760
ScaleWidth = 7155
StartUpPosition = 3 '窗口缺省
Begin MSCommLib.MSComm MSComm1
Left = 5640
Top = 3960
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin VB.CommandButton Command7
Caption = "退出"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 360
TabIndex = 20
Top = 5160
Width = 735
End
Begin VB.CommandButton Command6
Caption = "发送"
Height = 375
Left = 1080
TabIndex = 19
Top = 4680
Width = 615
End
Begin VB.TextBox Text2
Height = 1335
Left = 1680
MultiLine = -1 'True
TabIndex = 18
Top = 4200
Width = 5415
End
Begin VB.CommandButton Command5
Caption = "清空重填"
Height = 375
Left = 0
TabIndex = 15
Top = 4320
Width = 1095
End
Begin VB.CommandButton Command4
Caption = "保存显示数据"
Height = 375
Left = 0
TabIndex = 13
Top = 3360
Width = 1335
End
Begin VB.CommandButton Command3
Caption = "停止显示"
Height = 375
Left = 0
TabIndex = 12
Top = 2640
Width = 1095
End
Begin VB.CommandButton Command2
Caption = "清空接收区"
Height = 375
Left = 0
TabIndex = 11
Top = 2160
Width = 1095
End
Begin VB.TextBox Text1
Height = 3855
Left = 1680
MultiLine = -1 'True
TabIndex = 10
Top = 240
Width = 5415
End
Begin VB.CommandButton Command1
Caption = "关闭串口"
Height = 375
Left = 600
TabIndex = 9
Top = 1680
Width = 1095
End
Begin VB.OptionButton Option1
BackColor = &H000000FF&
Height = 255
Left = 240
TabIndex = 8
Top = 1680
Value = -1 'True
Width = 255
End
Begin VB.ComboBox Combo4
Height = 300
ItemData = "串口.frx":030A
Left = 840
List = "串口.frx":0314
TabIndex = 7
Text = " 1"
Top = 1320
Width = 855
End
Begin VB.ComboBox Combo3
Height = 300
ItemData = "串口.frx":0320
Left = 840
List = "串口.frx":032D
TabIndex = 5
Text = " 8"
Top = 960
Width = 855
End
Begin VB.ComboBox Combo2
Height = 300
ItemData = "串口.frx":033D
Left = 840
List = "串口.frx":0362
TabIndex = 3
Text = "9600"
Top = 600
Width = 855
End
Begin VB.ComboBox Combo1
Height = 300
ItemData = "串口.frx":03AC
Left = 840
List = "串口.frx":03BC
TabIndex = 1
Text = "COM1"
Top = 240
Width = 855
End
Begin VB.Label Label9
Caption = "十六进制"
Height = 255
Left = 240
TabIndex = 22
Top = 3120
Width = 855
End
Begin VB.Label Label8
Caption = "十六进制"
Height = 255
Left = 240
TabIndex = 21
Top = 4800
Width = 855
End
Begin VB.Label Label7
BorderStyle = 1 'Fixed Single
Caption = "发送区"
Height = 255
Left = 1080
TabIndex = 17
Top = 4320
Width = 615
End
Begin VB.Label Label6
Caption = "C:\COMDATA"
Height = 255
Left = 120
TabIndex = 16
Top = 3840
Width = 1215
End
Begin VB.Label Label5
BorderStyle = 1 'Fixed Single
Caption = "接收区"
Height = 255
Left = 1080
TabIndex = 14
Top = 2400
Width = 615
End
Begin VB.Label Label4
Caption = "停止位"
Height = 255
Left = 240
TabIndex = 6
Top = 1320
Width = 615
End
Begin VB.Label Label3
Caption = "数据位"
Height = 255
Left = 240
TabIndex = 4
Top = 960
Width = 735
End
Begin VB.Label Label2
Caption = "波特率"
Height = 255
Left = 240
TabIndex = 2
Top = 600
Width = 615
End
Begin VB.Label Label1
Caption = "串口"
Height = 255
Left = 360
TabIndex = 0
Top = 240
Width = 495
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Base 1
'Download by http://www.codefans.net
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim comport As Byte
Dim rate As Long
Dim data_cnt As Integer
Dim stop_cnt As Integer
Dim disp_on As Integer
'Dim mut As Boolean
Dim bMSCommOpen As Boolean '串口打开标志
Private Sub com_change()
Dim flag As Boolean
On Error Resume Next
Err.Clear
If bMSCommOpen = False Then Exit Sub '初始化完成前本过程无效
flag = MSComm1.PortOpen
If flag Then MSComm1.PortOpen = False '已打开先关闭
MSComm1.CommPort = comport '设置串行端口
MSComm1.Settings = CStr(rate) ",N," CStr(data_cnt) "," CStr(stop_cnt) '设置波特率及数据帧格式
MSComm1.PortOpen = True
If Err.Number Then
If Err.Number = 8002 Then MsgBox "串口" CStr(comport) "不存在！", vbOKOnly, "警告"
If Err.Number = 8005 Then MsgBox "串口" CStr(comport) "已打开！", vbOKOnly, "警告"
Option1.BackColor = RGB(0, 0, 0)
Command1.Enabled = False
Command6.Enabled = False
Err.Clear
Else
Option1.BackColor = RGB(255, 0, 0)
Command1.Enabled = True
Command1.Caption = "关闭串口"
Command6.Enabled = True
End If
End Sub
Private Sub Combo1_click()
comport = Combo1.ListIndex 1
com_change
End Sub
Private Sub Combo2_click()
Select Case Combo2.ListIndex
Case 0
rate = 300
Case 1
rate = 600
Case 2
rate = 1200
Case 3
rate = 2400
Case 4
rate = 4800
Case 5
rate = 9600
Case 6
rate = 19200
Case 7
rate = 38400
Case 8
rate = 56000
Case 9
rate = 57600
Case 10
rate = 115200
End Select
com_change
End Sub
Private Sub Combo3_click()
data_cnt = 8 - Combo3.ListIndex
com_change
End Sub
Private Sub Combo4_click()
stop_cnt = 1 Combo4.ListIndex
com_change
End Sub
Private Sub Command1_Click()
If Command1.Caption = "关闭串口" Then
MSComm1.PortOpen = False
Command1.Caption = "打开串口"
Option1.BackColor = RGB(0, 0, 0)
Else
MSComm1.PortOpen = True
Command1.Caption = "关闭串口"
Option1.BackColor = RGB(255, 0, 0)
End If
End Sub
Private Sub Command2_Click()
Text1.Text = ""
End Sub
Private Sub Command3_Click()
Static f2 As Byte
If f2 = 0 Then
disp_on = 0
f2 = 1
Command3.Caption = "继续显示"
Else
disp_on = 0
f2 = 0
Command3.Caption = "停止显示"
End If
End Sub
Private Sub Command4_Click()
Dim time As Date
time = Now()
Open "c:\comdata.txt" For Output As #5
Print #5, time
Print #5, Text1.Text
Close #5
End Sub
Private Sub Command5_Click()
Text2.Text = ""
End Sub
Public Function IsHex(c As String) As Integer
If c >= "0" And c <= "9" Then
IsHex = Val(c) - Val("0")
ElseIf c >= "a" And c <= "f" Then
IsHex = Asc(c) - Asc("a") 10
ElseIf c >= "A" And c <= "F" Then
IsHex = Asc(c) - Asc("A") 10
Else
IsHex = 16
End If
End Function
Private Sub Command6_Click()
'Dim s As String
'Dim l As Integer
'Dim i As Integer, j As Integer, cnt As Integer
'Dim a As Integer
'
'Dim send_buf() As Byte
'
'ReDim send_buf(1024)
'
'cnt = 0
's = Trim(Text2.Text)
'l = Len(s)
'Do While (l)
' Do Until IsHex(Left(s, 1)) <> 16
' l = l - 1
' If l = 0 Then Exit Do
' s = Right(s, l)
' Loop
' a = IsHex(Left(s, 1))
'
' l = l - 1
' s = Right(s, l)
'
' If l <> 0 And IsHex(Left(s, 1)) <> 16 Then
' a = a * 16 IsHex(Left(s, 1))
' l = l - 1
' s = Right(s, l)
' End If
' cnt = cnt 1
' send_buf(cnt) = a
'Loop
'
'If cnt > 128 Then cnt = 128
'ReDim Preserve send_buf(cnt)
MSComm1.Output = "?" 'send_buf()
MSComm1.Output = vbCr
End Sub
Private Sub Command7_Click()
Unload Me
End Sub
Private Sub Form_Activate()
On Error Resume Next
bMSCommOpen = False
Combo1.ListIndex = 3
Combo2.ListIndex = 10
Combo3.ListIndex = 0
Combo4.ListIndex = 0
bMSCommOpen = True
MSComm1.PortOpen = True
If Err.Number Then
MsgBox "串口1已打开！", vbOKOnly, "警告"
Option1.BackColor = RGB(0, 0, 0)
Command1.Enabled = False
Command6.Enabled = False
Err.Clear
End If
'Command1.SetFocus
End Sub
Private Sub Form_Load()
MSComm1.CommPort = 1 '设置串行端口com1
MSComm1.Settings = "9600,N,8,1" '设置波特率及数据帧格式
MSComm1.InputLen = 0 '读取接收缓冲区的所有字符
MSComm1.InBufferSize = 4000 '数据接受缓冲区大小为4000字节
MSComm1.OutBufferSize = 4000 '数据发送缓冲区大小为4000字节
MSComm1.RThreshold = 1 '每10位数据到接收缓冲区都触发接收事件
MSComm1.SThreshold = 1 '发送缓冲区空触发发送事件
MSComm1.InputMode = comInputModeText '字节模式
'MSComm1.InputMode = comInputModeBinary'设定 InputMode 以读取二进位资料
disp_on = 1
comport = 1
rate = 9600
data_cnt = 8
stop_cnt = 1
End Sub
Private Sub MSComm1_OnComm()
Static cnt As Integer
Dim receive_cnt As Integer
Dim i As Integer
Dim Buffer As Variant
Dim Arr() As Byte
Dim s As String
'Select Case MSComm1.CommEvent
'Case comEvReceive
'receive_cnt = MSComm1.InBufferCount '接收缓冲区的字节数
' 往暂存区存二进位资料
'Buffer = MSComm1.Input
' 指定给位元组阵列以便处理
'Arr = Buffer
'
's = ""
'For i = 0 To receive_cnt - 1
'
'If Arr(i) > 15 Then
's = s Hex(Arr(i)) " "
'Else
's = s "0" Hex(Arr(i)) " "
'End If
'
'cnt = cnt 1
'
'Next i
Text1.Text = MSComm1.Input 'Text1.Text & s
'If cnt >= 300 Then
' Text1.Text = ""
' cnt = 0
' Exit Sub
'End If
'Case comEvSend
'
'End Select
End Sub
好例子网口号：伸出你的我的手 — 分享！
网友评论
小贴士
感谢您为本站写下的评论，您的评论对其它用户来说具有重要的参考价值，所以请认真填写。
- 类似“顶”、“沙发”之类没有营养的文字，对勤劳贡献的楼主来说是令人沮丧的反馈信息。
- 相信您也不想看到一排文字/表情墙，所以请不要反馈意义不大的重复字符，也请尽量不要纯表情的回复。
- 提问之前请再仔细看一遍楼主的说明，或许是您遗漏了。
- 请勿到处挖坑绊人、招贴广告。既占空间让人厌烦，又没人会搭理，于人于己都无利。
关于好例子网
本站旨在为广大IT学习爱好者提供一个非营利性互相学习交流分享平台。本站所有资源都可以被免费获取学习研究。本站资源来自网友分享，对搜索内容的合法性不具有预见性、识别性、控制性，仅供学习研究，请务必在下载后24小时内给予删除，不得用于其他任何用途，否则后果自负。基于互联网的特殊性，平台无法对用户传输的作品、信息、内容的权属或合法性、安全性、合规性、真实性、科学性、完整权、有效性等进行实质审查；无论平台是否已进行审查，用户均应自行承担因其传输的作品、信息、内容而可能或已经产生的侵权或权属纠纷等法律责任。本站所有资源不代表本站的观点或立场，基于网友分享，根据中国法律《信息网络传播权保护条例》第二十二与二十三条之规定，若资源存在侵权或相关问题请联系本站客服人员，点此联系我们。关于更多版权及免责申明参见 版权及免责申明
支持(0) 盖楼(回复)
支持(0) 盖楼(回复)