📄 test.frm
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1
Caption = "通讯测试"
ClientHeight = 4890
ClientLeft = 60
ClientTop = 450
ClientWidth = 8145
Icon = "Test.frx":0000
LinkTopic = "Form1"
ScaleHeight = 4890
ScaleWidth = 8145
StartUpPosition = 3 '窗口缺省
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 500
Left = 6960
Top = 4320
End
Begin VB.Frame Frame2
Caption = "端口设置"
Height = 3135
Left = 5640
TabIndex = 3
Top = 120
Width = 2415
Begin VB.ComboBox ComBaud
Height = 300
ItemData = "Test.frx":08CA
Left = 360
List = "Test.frx":08CC
Style = 2 'Dropdown List
TabIndex = 9
Top = 1920
Width = 1575
End
Begin VB.CommandButton Command1
Caption = "打开端口"
Height = 495
Left = 480
TabIndex = 7
Top = 2400
Width = 1455
End
Begin VB.Frame Frame1
Caption = "端口选择"
Height = 735
Left = 240
TabIndex = 4
Top = 480
Width = 1935
Begin VB.OptionButton Option1
Caption = "COM1"
Height = 255
Index = 0
Left = 120
TabIndex = 6
Top = 360
Value = -1 'True
Width = 735
End
Begin VB.OptionButton Option1
Caption = "COM2"
Height = 255
Index = 1
Left = 1080
TabIndex = 5
Top = 360
Width = 735
End
End
Begin VB.Label Label1
Caption = "通讯波特率:"
Height = 255
Left = 360
TabIndex = 8
Top = 1440
Width = 1215
End
End
Begin VB.CommandButton Command2
Caption = "发 送"
Height = 375
Left = 5760
TabIndex = 2
Top = 4320
Width = 1335
End
Begin VB.TextBox InText
Height = 3735
Left = 120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 1
Top = 120
Width = 5415
End
Begin VB.TextBox OutText
Height = 375
Left = 120
TabIndex = 0
Top = 4320
Width = 5415
End
Begin MSCommLib.MSComm MSComm1
Left = 7440
Top = 4200
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
InputMode = 1
End
Begin VB.Label Label4
Caption = "www.hbkj.com.cn"
Height = 375
Left = 6000
TabIndex = 11
Top = 3720
Width = 2055
End
Begin VB.Label Label2
Caption = "十六进制命令输入区：(不要填写CRC部分，发送时软件自动添加CRC值)"
Height = 375
Left = 120
TabIndex = 10
Top = 4080
Width = 5655
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************Copyright (c)**************************************************
'** Beijing HBKJ Development Co.,LTD.
'** http://www.hbkj.com.cn
'**
'**--------------File Info-------------------------------------------------------------------------------
'** File name: pycomvb
'** Last modified Date: 2006-2-13
'** Last Version: 1.0
'** Descriptions: HBKJ系列仪表通讯VB6.0代码读、写例程，内含CRC16的计算，符合标准的MODBUS_RTU通信格式
'**------------------------------------------------------------------------------------------------------
'** Created by: Gao Wei
'** Created date: 2006-2-13
'** Version: 1.0
'**------------------------------------------------------------------------------------------------------
'** Modified by:
'** Modified date:
'** Version:
'** Descriptions:
'**------------------------------------------------------------------------------------------------------
'** 技术支持：
'** QQ: 270991828
'** Email: gwemail@126.com
'********************************************************************************************************
Function CRC16(data() As Byte, n As Byte) As Long
Dim CRC16Lo As Byte, CRC16Hi As Byte
Dim CL As Byte, CH As Byte
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)
For Flag = 0 To 7
SaveHi = CRC16Hi
SaveLo = CRC16Lo
CRC16Hi = CRC16Hi \ 2
CRC16Lo = CRC16Lo \ 2
If ((SaveHi And &H1) = &H1) Then
CRC16Lo = CRC16Lo Or &H80
End If
If ((SaveLo And &H1) = &H1) Then
CRC16Hi = CRC16Hi Xor CH
CRC16Lo = CRC16Lo Xor CL
End If
Next Flag
Next i
If n = 0 Then
CRC16 = CRC16Lo
Else
CRC16 = CRC16Hi
End If
End Function
Private Sub ComBaud_Change()
Select Case ComBaud.ListIndex
Case 0
MSComm1.Settings = "1200,n,8,1"
Case 1
MSComm1.Settings = "2400,n,8,1"
Case 2
MSComm1.Settings = "4800,n,8,1"
Case Else
MSComm1.Settings = "9600,n,8,1"
End Select
End Sub
Private Sub Command1_Click()
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
Command1.Caption = "关闭端口"
Else
MSComm1.PortOpen = False
Command1.Caption = "打开端口"
End If
End Sub
Private Sub Command2_Click()
Dim i%, j%, k%, Buf$
Dim OutByte() As Byte
Dim OutB() As Byte
Buf = Trim(OutText.Text)
i = Len(Buf)
k = 1
If i Mod 2 <> 0 Or i < 1 Then
MsgBox "请输入两位十六进制！不要加空格！", vbExclamation + vbOKOnly, "输入信息"
Else
ReDim OutB(i / 2 - 1)
ReDim OutByte(i / 2 + 1)
j = 0
Do While i > 0
OutB(j) = CByte("&H" & Mid(Buf, k, 2))
k = k + 2
i = i - 2
j = j + 1
Loop
For i = 0 To (j - 1)
OutByte(i) = OutB(i)
Next i
OutByte(j) = CRC16(OutB, 0) '校验和低位
OutByte(j + 1) = CRC16(OutB, 1) '校验和高位
MSComm1.InBufferCount = 0
MSComm1.Output = OutByte
Timer1.Enabled = True
End If
End Sub
Private Sub Form_Load()
ComBaud.AddItem "1200"
ComBaud.AddItem "2400"
ComBaud.AddItem "4800"
ComBaud.AddItem "9600"
ComBaud.ListIndex = 3
MSComm1.Settings = "9600,n,8,1"
MSComm1.PortOpen = True
Command1.Caption = "关闭端口"
End Sub
Private Sub Option1_Click(Index As Integer)
'On Error Resume Next
MSComm1.PortOpen = False
MSComm1.CommPort = Index + 1
If MSComm1.PortOpen Then
MsgBox "所选的端口被占用！", vbExclamation + vbOKOnly, "通讯端口信息"
Exit Sub
Else
MSComm1.PortOpen = True
End If
End Sub
Private Sub Timer1_Timer()
Dim InByte() As Byte
Dim i%, Buf$
Timer1.Enabled = False
InByte = MSComm1.Input
For i = LBound(InByte) To UBound(InByte)
Buf = Buf + Hex(InByte(i)) + Chr(32)
Next i
InText.Text = InText.Text + Buf
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -