📄 收发程序.frm
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 7200
ClientLeft = 60
ClientTop = 450
ClientWidth = 8100
LinkTopic = "Form1"
ScaleHeight = 11010
ScaleWidth = 15240
Begin VB.OptionButton Option1
Caption = "自动回发 "
Height = 375
Left = 8760
TabIndex = 13
Top = 10560
Width = 1695
End
Begin VB.Frame Frame1
Caption = "数据重发"
Height = 2655
Left = 840
TabIndex = 7
Top = 1680
Width = 3735
Begin VB.TextBox Text2
Height = 615
Left = 1800
TabIndex = 11
Text = "1"
Top = 1440
Width = 1215
End
Begin VB.TextBox Text1
Height = 495
Left = 1800
TabIndex = 9
Text = "5"
Top = 600
Width = 1455
End
Begin VB.Label Label5
Caption = "秒"
Height = 495
Left = 3120
TabIndex = 12
Top = 1560
Width = 375
End
Begin VB.Label Label4
Caption = "间隔时间"
Height = 375
Left = 240
TabIndex = 10
Top = 1560
Width = 855
End
Begin VB.Label Label3
Caption = "重发次数"
Height = 375
Left = 240
TabIndex = 8
Top = 600
Width = 975
End
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 1000
Left = 5400
Top = 4680
End
Begin VB.TextBox txtRcv
Height = 6495
Left = 8040
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 6
Text = "收发程序.frx":0000
Top = 3840
Width = 6615
End
Begin VB.CommandButton Command2
Caption = "退出"
Height = 495
Left = 5280
TabIndex = 5
Top = 7200
Width = 1455
End
Begin MSCommLib.MSComm MSComm1
Left = 5760
Top = 3360
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
BaudRate = 38400
End
Begin VB.ComboBox Combo1
Height = 300
Left = 840
Style = 2 'Dropdown List
TabIndex = 4
Top = 6600
Width = 1935
End
Begin VB.CommandButton Commandsend
Caption = "发送"
Height = 615
Left = 13080
TabIndex = 3
Top = 2160
Width = 1335
End
Begin VB.TextBox txtSend
Height = 735
Left = 8040
TabIndex = 1
Top = 2160
Width = 4815
End
Begin VB.Label Label6
Caption = "端口选择"
Height = 495
Left = 840
TabIndex = 14
Top = 6000
Width = 1815
End
Begin VB.Label Label2
Caption = "发送数据"
Height = 495
Left = 8040
TabIndex = 2
Top = 1560
Width = 3735
End
Begin VB.Label Label1
Caption = "接收数据"
Height = 495
Left = 8040
TabIndex = 0
Top = 3240
Width = 1815
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public times As Integer '数据重发循环指针
Public retran As Integer '数据重发次数
Public inteval As Single '数据重发时间间隔
Private Sub Combo1_click()
Commandsend.Enabled = False '端口号改变，必须点击“端口设置”键才可收发
port = IIf(Combo1.Text = "", 1, Val(Combo1.Text))
If MSComm1.CommPort = port Then 'if 语句为了防止端口号重至,报错
GoTo continue
Else
MSComm1.PortOpen = False
MSComm1.CommPort = port
End If
continue:
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
End If
Commandsend.Enabled = True
End Sub
Private Sub Command2_Click()
End
End Sub
Private Sub Commandrec_Click()
Dim Rcvdat As String
Dim dattemp As Variant
Dim i As Integer
Dim lgg As Integer '保存要接收数据长度
Commandrec.Enabled = False '使按钮失效
If MSComm1.PortOpen = False Then '设置端口打开
MSComm1.PortOpen = True
End If
MSComm1.InputMode = comInputModeText '从串行口读取文本格式数据
Do Until MSComm1.InBufferCount >= 1 '查询方式，等待接收到6个字节
DoEvents
Loop
For i = 1 To 1000 '时间延时，为了接收到所有发送数据
For j = 1 To 1000
Next j
Next i
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
' Text2.Text = MSComm1.InputMode
dattemp = MSComm1.Input '从串口读取数据至变体变量
' txtRcv.Text = MSComm1.InBufferCount
' Rcvdat = dattemp '数据送至接收二进制数组
'lgg = IIf(dattemp = "", 1, Val(dattemp))
'Do Until MSComm1.InBufferCount >= lgg
' DoEvents
' Loop
'dattemp = MSComm1.Input
txtRcv = dattemp
' For i = 0 To 5 '接收数据送至接收文本框txtRcv显示
' txtRcv.Text = Hex(Rcvdat)
' Next i
MSComm1.InBufferCount = 0 '清除接收缓冲区
' MSComm1.PortOpen = False '关闭串行口
Commandrec.Enabled = True '使能按钮
End Sub
Private Sub Commandsend_Click()
times = 0
Timer1.Enabled = True
Timer1.Interval = inteval * 1000
Do Until times = retran
DoEvents
Loop
times = 0
Timer1.Enabled = False
Commandsend.Enabled = True '使能按钮
End Sub
Private Sub Form_Load()
Form1.Width = Screen.Width
Form1.Height = Screen.Height
Commandsend.Enabled = False
'端口号选择设置
Dim port As Integer
Combo1.AddItem "1"
Combo1.AddItem "2"
Combo1.AddItem "3"
Combo1.AddItem "4"
Combo1.AddItem "5"
txtRcv.Text = " "
retran = 5
inteval = 1
'MSComm1.CommPort = 2
MSComm1.OutBufferSize = 512
MSComm1.PortOpen = True '端口设置时，初始选择应设备打开，否则报错
MSComm1.RThreshold = 1
End Sub
Private Sub MSComm1_OnComm()
Select Case MSComm1.CommEvent
Case comEvReceive
'读取串口数据
If MSComm1.PortOpen = False Then '设置端口打开
MSComm1.PortOpen = True
End If
MSComm1.InputMode = comInputModeText '从串行口读取文本格式数据
Do Until MSComm1.InBufferCount >= 1 '查询方式，等待接收到6个字节
DoEvents
Loop
For i = 1 To 1000 '时间延时，为了接收到所有发送数据
For j = 1 To 1000
Next j
Next i
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
dattemp = MSComm1.Input '从串口读取数据至变体变量
txtRcv = txtRcv + Chr(13) + Chr(10) + dattemp
MSComm1.InBufferCount = 0 '清除接收缓冲区
If Option1.Value = True Then
MSComm1.Output = dattemp '发送数据
MSComm1.OutBufferCount = 0
End If
Case comEvSend
End Select
End Sub
Private Sub Text1_Change()
retran = IIf(Text1.Text = "", 1, Val(Text1.Text))
End Sub
Private Sub Text2_Change()
inteval = IIf(Text2.Text = "", 1, Val(Text2.Text))
End Sub
Private Sub Timer1_Timer()
Dim Senddat As String
Dim dattemp As Variant
Dim i As Integer
Dim lg As Integer 'lg 是输入文本框中的字符数
Commandsend.Enabled = False '按钮失效
If MSComm1.PortOpen = False Then '设置端口打开
MSComm1.PortOpen = True
End If
Commandsend.Enabled = False '使按钮失效
'%%%%%%%%%%%%%%%%%%%%%发送数据%%%%%%%%%%%%%%%%%%%%%%%%%%
If txtSend.Text = "" Then '在发送数据文本框为空时，提示
MsgBox ("请输入发送数据")
End If
lg = Len(txtSend.Text) '得到发送数据的长度，所用函数有问题，不能区分汉字和数字？
If lg >= 1024 Then
MsgBox ("一次输入字节数不能超过1024")
End If
Senddata = txtSend.Text ' 把发送数据存到Senddata中
For i = 0 To (8 - lg + Fix(lg / 8) * 8 - 1) '给最后不足8个字节数据补空格
Senddata = Senddata + " "
Next i
'MSComm1.Output = CStr(lg) '发送要传输数据个数
' Do Until MSComm1.InBufferCount >= 1 '等待接收应答信号
' DoEvents
' Loop
'MSComm1.InBufferCount = 0 '清除接收缓冲区
MSComm1.Output = Senddata '发送数据
'MSComm1.PortOpen = False '关闭串行口
times = times + 1
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -