📄 form1.frm
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1
BackColor = &H00FFC0C0&
Caption = "串口通讯及校验"
ClientHeight = 6765
ClientLeft = 60
ClientTop = 450
ClientWidth = 11010
Icon = "Form1.frx":0000
LinkTopic = "Form1"
ScaleHeight = 6765
ScaleWidth = 11010
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command3
Caption = "打开串口"
Height = 495
Left = 2880
TabIndex = 26
Top = 960
Width = 1215
End
Begin MSCommLib.MSComm MSComm1
Left = 600
Top = 4320
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin VB.TextBox Text6
Enabled = 0 'False
Height = 735
Left = 2640
MousePointer = 12 'No Drop
TabIndex = 23
Top = 5400
Width = 5655
End
Begin VB.TextBox wordlen
Height = 375
Left = 1320
TabIndex = 19
Top = 3000
Width = 8895
End
Begin VB.TextBox CRCHi
Enabled = 0 'False
Height = 375
Left = 9000
MousePointer = 12 'No Drop
TabIndex = 17
Top = 1680
Width = 975
End
Begin VB.TextBox CRCLo
Enabled = 0 'False
Height = 375
Left = 6600
MousePointer = 12 'No Drop
TabIndex = 16
Top = 1680
Width = 975
End
Begin VB.TextBox func
Height = 375
Left = 3960
TabIndex = 13
Top = 1680
Width = 1095
End
Begin VB.TextBox address
Height = 375
Left = 1320
TabIndex = 11
Top = 1680
Width = 1215
End
Begin VB.ComboBox stopbits
Height = 300
Left = 9960
TabIndex = 8
Top = 480
Width = 855
End
Begin VB.ComboBox parity
Height = 300
Left = 7800
TabIndex = 6
Top = 480
Width = 1095
End
Begin VB.ComboBox bitsper
Height = 300
Left = 5640
TabIndex = 5
Top = 480
Width = 855
End
Begin VB.ComboBox databit
Height = 300
Left = 3600
TabIndex = 3
Top = 480
Width = 975
End
Begin VB.ComboBox Combo1
Height = 300
ItemData = "Form1.frx":038A
Left = 1320
List = "Form1.frx":038C
TabIndex = 0
Top = 480
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "数据发送"
Height = 495
Left = 2760
TabIndex = 20
Top = 3960
Width = 1095
End
Begin VB.CommandButton Command2
Caption = "清空输入区"
Height = 495
Left = 6120
TabIndex = 21
Top = 3960
Width = 1095
End
Begin VB.Label Label13
BackColor = &H00FFFFFF&
Height = 255
Left = 1320
TabIndex = 25
Top = 1080
Width = 975
End
Begin VB.Label Label12
BackColor = &H00FFC0C0&
Caption = "串口状态"
Height = 255
Left = 240
TabIndex = 24
Top = 1080
Width = 855
End
Begin VB.Label Label11
BackColor = &H00FFC0C0&
Caption = "数据返回区"
Height = 255
Left = 1320
TabIndex = 22
Top = 5760
Width = 1095
End
Begin VB.Label Label10
BackColor = &H00FFC0C0&
Caption = "数据数"
Height = 255
Left = 600
TabIndex = 18
Top = 3120
Width = 855
End
Begin VB.Label Label9
BackColor = &H00FFC0C0&
Caption = "CRC低位"
Height = 255
Left = 7920
TabIndex = 15
Top = 1800
Width = 975
End
Begin VB.Label Label8
BackColor = &H00FFC0C0&
Caption = "CRC高位"
Height = 255
Left = 5520
TabIndex = 14
Top = 1800
Width = 855
End
Begin VB.Label Label7
BackColor = &H00FFC0C0&
Caption = "功能码"
Height = 255
Left = 3000
TabIndex = 12
Top = 1800
Width = 855
End
Begin VB.Label Label6
BackColor = &H00FFC0C0&
Caption = "地址"
Height = 255
Left = 720
TabIndex = 10
Top = 1800
Width = 735
End
Begin VB.Label Label5
BackColor = &H00FFC0C0&
Caption = "停止位选择"
Height = 255
Left = 9000
TabIndex = 9
Top = 480
Width = 975
End
Begin VB.Label Label4
BackColor = &H00FFC0C0&
Caption = "奇偶校验选择"
Height = 255
Left = 6600
TabIndex = 7
Top = 480
Width = 1095
End
Begin VB.Label Label3
BackColor = &H00FFC0C0&
Caption = "波特率选择"
Height = 255
Left = 4680
TabIndex = 4
Top = 480
Width = 1095
End
Begin VB.Label Label2
BackColor = &H00FFC0C0&
Caption = "数据位选择"
Height = 255
Left = 2640
TabIndex = 2
Top = 480
Width = 1215
End
Begin VB.Label Label1
BackColor = &H00FFC0C0&
Caption = "通讯串口选择"
Height = 255
Left = 120
TabIndex = 1
Top = 480
Width = 1335
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private datalen As String
Private RTUCRC As String
'通讯串口选择
Private Sub Combo1_Click()
MSComm1.CommPort = Combo1.ListIndex + 1
End Sub
Private Sub Command2_Click()
wordlen.Text = ""
address.Text = ""
func.Text = ""
End Sub
'数据位选择
Private Sub databit_Click()
Call setting
End Sub
'波特率选择
Private Sub bitsper_Click()
Call setting
End Sub
'奇偶校验选择
Private Sub parity_Click()
Call setting
End Sub
'停止位选择
Private Sub stopbits_Click()
Call setting
End Sub
Private Sub setting()
MSComm1.Settings = CStr(bitsper.Text) & "," & CStr(parity.Text) & "," & CStr(databit.Text) _
& "," & CStr(stopbits.Text)
End Sub
Private Sub Command1_Click()
Dim hexchrlen, hexchr As String
Dim hexcyc As Byte
Dim MyString() As Byte
Dim hexmid As Byte
Dim x As Integer
Dim ccc As Integer
Dim a() As Long
Dim i As Integer
Dim datalen As String
Dim ads As Variant
Dim asd, crc As Byte
x = 0
datalen = wordlen.Text
hexchrlen = Len(datalen)
For hexcyc = 1 To hexchrlen '检查Text1文本框内数值是否合适
hexchr = Mid(datalen, hexcyc, 1)
If InStr("0123456789ABCDEFabcdef ,", hexchr) = 0 Then
MsgBox "无效的数值，请重新输入", , "错误信息"
Exit Sub
Else
If (MSComm1.PortOpen = False) Then
MsgBox ("请先打开通讯串口")
Else
End If
End If
Next
Dim st1 As String
'Do Until InStr(datalen, " ") = 0
'st1 = Mid(datalen, InStr(datalen, ",") + 1)
'x = x + 1
'Loop
'ads = Split(datalen, " ")
'asd = Len(ads)
ReDim MyString(1 To hexchrlen \ 2) As Byte
For hexcyc = 1 To hexchrlen Step 2
hexchr = Mid(datalen, hexcyc, 2)
i = i + 1
hexmid = Val("&H" & CStr(hexchr))
MyString(i) = hexmid
MSComm1.Settings = CStr(bitsper.Text) & "," & CStr(parity.Text) & "," & CStr(databit.Text) _
& "," & CStr(stopbits.Text)
'ReDim a(x) As Long
'MyString() = Split(datalen, , -1, 1)
'MsgBox (MyString(0))
'For ccc = 0 To x
'a(ccc) = CLng("&H" & MyString(ccc))
MSComm1.Output = MyString
crc = CRC16(MyString(i))
Next
End Sub
Function CRC16(data() As Long) As String
Dim CRC16Lo As Byte, CRC16Hi As Byte 'CRC寄存器
Dim CL As Byte, CH As Byte '多项式码&HA001
Dim SaveHi As Byte, SaveLo As Byte
Dim i As Integer
Dim Flag As Integer
CRC16Lo = &HFF
CRC16Hi = &HFF
CL = &H1
CH = &HA0
For i = 0 To UBound(data)
CRC16Lo = CRC16Lo Xor data(i) '每一个数据与CRC寄存器进行异或
For Flag = 0 To 7
SaveHi = CRC16Hi
SaveLo = CRC16Lo
CRC16Hi = CRC16Hi \ 2 '高位右移一位
CRC16Lo = CRC16Lo \ 2 '低位右移一位
If ((SaveHi And &H1) = &H1) Then '如果高位字节最后一位为1
CRC16Lo = CRC16Lo Or &H80 '则低位字节右移后前面补1
End If '否则自动补0
If ((SaveLo And &H1) = &H1) Then '如果LSB为1，则与多项式码进行异或
CRC16Hi = CRC16Hi Xor CH
CRC16Lo = CRC16Lo Xor CL
End If
Next Flag
Next i
Dim ReturnData(1) As Byte
ReturnData(0) = CRC16Hi 'CRC高位
ReturnData(1) = CRC16Lo 'CRC低位
CRC16 = ReturnData
CRCHi.Text = Hex(CRC16Hi)
CRCLo.Text = Hex(CRC16Lo)
End Function
Private Sub Command3_Click()
On Error Resume Next
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
Else
MSComm1.PortOpen = False
End If
If MSComm1.PortOpen = True Then '打开关闭按钮显示文字及combo1使能
Command3.Caption = "关闭串口"
Combo1.Enabled = False
Label13.Caption = "串口已打开"
Command1.Enabled = True
Else
Command3.Caption = "打开串口"
Combo1.Enabled = True
Label13.Caption = "串口未打开"
Command1.Enabled = False
End If
If Err Then '打开串口失败，则显示出错信息
MsgBox Error$, 48, "错误信息"
Exit Sub
End If
End Sub
Private Sub Form_Load()
Dim d As Integer
For d = 1 To 16
Combo1.AddItem ("COM" & CStr(d))
Next
Combo1.ListIndex = 0
databit.AddItem "6"
databit.AddItem "7"
databit.AddItem "8"
databit.ListIndex = 2
bitsper.AddItem "110"
bitsper.AddItem "330"
bitsper.AddItem "1200"
bitsper.AddItem "2400"
bitsper.AddItem "4800"
bitsper.AddItem "9600"
bitsper.AddItem "19200"
bitsper.AddItem "38400"
bitsper.AddItem "56000"
bitsper.AddItem "57600"
bitsper.AddItem "115200"
bitsper.ListIndex = 5
parity.AddItem "n"
parity.AddItem "o"
parity.AddItem "e"
parity.ListIndex = 0
stopbits.AddItem "1"
stopbits.AddItem "2"
stopbits.ListIndex = 0
If (MSComm1.PortOpen = False) Then
Label13.Caption = "串口未打开"
Command3.Caption = "打开串口"
Command1.Enabled = False
Else
Label13.Caption = "串口已打开"
Command3.Caption = "关闭串口"
Command1.Enabled = True
Command1.Enabled = True
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -