📄 form1.frm
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 9105
ClientLeft = 60
ClientTop = 450
ClientWidth = 14055
LinkTopic = "Form1"
ScaleHeight = 9105
ScaleWidth = 14055
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton Command2
Caption = "Pause"
Height = 615
Left = 9960
TabIndex = 4
Top = 600
Width = 1575
End
Begin VB.CommandButton Command1
Caption = "Start"
Height = 615
Left = 2400
TabIndex = 1
Top = 600
Width = 1575
End
Begin VB.TextBox Text1
BackColor = &H80000007&
ForeColor = &H0000C000&
Height = 7095
Left = 600
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Top = 1680
Width = 12975
End
Begin MSCommLib.MSComm MSComm1
Left = 240
Top = 240
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = 0 'False
End
Begin VB.Label Label2
Caption = "Comm Settings"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4200
TabIndex = 3
Top = 720
Width = 1935
End
Begin VB.Label Label1
BorderStyle = 1 'Fixed Single
Caption = "Label1"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6480
TabIndex = 2
Top = 720
Width = 3255
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim sSerialSettings As String
Dim nWaitTime As Integer
Dim sInput As String
Dim n As Integer
Dim sHexInput As String
'Dim nTmp As Integer
'Dim sTmp As String
bRunning = True
For i = LBound(sBaudRates) To UBound(sBaudRates)
For j = LBound(sParitys) To UBound(sParitys)
For k = LBound(sDataBits) To UBound(sDataBits)
For l = LBound(sStopBits) To UBound(sStopBits)
'Process the Testing
MSComm1.Settings = sBaudRates(i) + "," + sParitys(j) + "," + sDataBits(k) + "," + sStopBits(l)
MSComm1.PortOpen = True
For m = LBound(sCommands) To UBound(sCommands)
While (bRunning <> True)
Call Sleep(1000)
Wend
MSComm1.Output = sCommands(m)
Call Sleep(200)
If (MSComm1.InBufferCount > 0) Then
'sHexInput = ""
'sInput = MSComm1.Input
'For n = 1 To LenB(sInput)
'sHexInput = Hex(Asc(Mid(sInput, n, 1)))
'sTmp = MidB(sInput, n, 1)
'nTmp = AscB(sTmp)
'sTmp = Hex(nTmp)
' sHexInput = sHexInput + Hex(AscB(MidB(sInput, n, 1))) + " "
'Next n
Label1.Caption = MSComm1.Settings
'Label1.Refresh
'Text1.Text = Text1.Text + MSComm1.Settings + ":" + ChrB(9) + "INPUT:[" + sInput + "]" + sHexInput + vbCrLf
'Text1.Refresh
End If
Next
MSComm1.PortOpen = False
Call Sleep(1000)
Next
Next
Next
Next
End Sub
Private Sub Command2_Click()
If bRunning = True Then
bRunning = False
Command2.Caption = "Restart"
Else
bRunning = True
Command2.Caption = "Pause"
End If
End Sub
Private Sub Form_Load()
'#################
'Init Variable
'#################
sBaudRates() = Split("19200;9600;1200;2400;4800;14400;38400;56000;57600;115200", ";")
sParitys() = Split("N;O;E;M;S", ";")
sDataBits() = Split("8;7;6", ";")
sStopBits() = Split("1;2", ";")
'for testing
'sBaudRates() = Split("9600;19200", ";")
'sParitys() = Split("N", ";")
'sDataBits() = Split("8", ";")
'sStopBits() = Split("1", ";")
'Init the Modbus Commands
sCommands(0) = "#01RD" + vbCr
sCommands(1) = "#01RH+" + vbCr
sCommands(2) = "#01RL-" + vbCr
'MSComm settings Init
MSComm1.CommPort = 1
MSComm1.InputLen = 0
MSComm1.InputMode = 1
MSComm1.InBufferSize = 256
MSComm1.OutBufferSize = 256
'MSComm1.SThreshold = 1
'MSComm1.RThreshold = 1
Text1.Text = " Serial Port Tester " + vbCrLf
Label1.Caption = ""
bRunning = False
'bStart = False
End Sub
Private Sub MSComm1_OnComm()
Dim i As Integer
Dim sHexInput As Integer
Select Case MSComm1.CommEvent
Case comEvReceive
sHexInput = ""
For i = 0 To LenB(MSComm1.Input)
sHexInput = sHexInput + Hex(AscB(MidB(MSComm1.Input, i))) + " "
Next
Text1.Text = Text1.Text + MSComm1.Settings + ":" + vbTab + "INPUT:[" + sHexInput + "]" + vbCrLf
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -