📄 form1.frm
字号:
Format = "0"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1045
SubFormatType = 1
EndProperty
Height = 285
Index = 1
Left = 480
TabIndex = 7
Text = "0"
Top = 840
Width = 735
End
Begin VB.CommandButton Command3
Caption = "Read "
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3960
TabIndex = 6
Top = 5520
Width = 1455
End
Begin VB.TextBox Text3
BeginProperty DataFormat
Type = 1
Format = "0"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1045
SubFormatType = 1
EndProperty
Height = 285
Left = 8040
TabIndex = 4
Text = "10"
Top = 4800
Width = 615
End
Begin VB.TextBox Text2
BeginProperty DataFormat
Type = 1
Format = "0"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1045
SubFormatType = 1
EndProperty
Height = 285
Left = 6480
TabIndex = 2
Text = "100"
Top = 4800
Width = 975
End
Begin VB.CommandButton Command2
Caption = "Disconnect"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2040
TabIndex = 1
Top = 5520
Width = 1455
End
Begin VB.CommandButton Command1
Caption = "Connect"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 6000
TabIndex = 0
Top = 5520
Width = 1695
End
Begin VB.Label Label7
Caption = "Data type"
Height = 375
Left = 11040
TabIndex = 108
Top = 4560
Width = 1335
End
Begin VB.Label Label6
Caption = "Device address"
Height = 375
Left = 9360
TabIndex = 107
Top = 4560
Width = 1335
End
Begin VB.Label Label3
Caption = "port"
Height = 375
Left = 3000
TabIndex = 105
Top = 4560
Width = 855
End
Begin VB.Label Label5
Caption = "Status"
Height = 255
Left = 4320
TabIndex = 73
Top = 4560
Width = 855
End
Begin VB.Label Label4
Caption = "Adrress IP"
ForeColor = &H80000008&
Height = 375
Left = 1320
TabIndex = 71
Top = 4560
Width = 1335
End
Begin VB.Label Label2
Caption = "Length"
Height = 375
Left = 8040
TabIndex = 5
Top = 4560
Width = 1335
End
Begin VB.Label Label1
Caption = "Start register"
Height = 375
Left = 6480
TabIndex = 3
Top = 4560
Width = 1575
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim MbusQuery(11) As Byte
Public MbusResponse As String
Dim MbusByteArray(500) 'As Byte
Public MbusRead As Boolean
Public MbusWrite As Boolean
Dim ModbusTimeOut As Integer
Dim ModbusWait As Boolean
Private Sub Command1_Click()
Dim StartTime
If (Winsock1.State <> sckClosed) Then
Winsock1.Close
End If
Winsock1.RemoteHost = ip.Text
Winsock1.RemotePort = port.Text
Winsock1.Connect
StartTime = Timer
Do While ((Timer < StartTime + 2) And (Winsock1.State <> 7))
DoEvents
Loop
If (Winsock1.State = 7) Then
Text5.Text = "Connected"
Text5.BackColor = &HFF00&
Else
Text5.Text = "Can't connect"
Text5.BackColor = &HFF
End If
End Sub
Private Sub Command2_Click()
If (Winsock1.State <> sckClosed) Then
Winsock1.Close
End If
Do While (Winsock1.State <> sckClosed)
DoEvents
Loop
Text5.Text = "Disconnected"
Text5.BackColor = &HFF
End Sub
Public Function read_dat()
Dim StartLow As Byte
Dim StartHigh As Byte
Dim LengthLow As Byte
Dim LengthHigh As Byte
If (Winsock1.State = 7) Then
StartLow = Val(Text2.Text - 1) Mod 256
StartHigh = Val(Text2.Text - 1) \ 256
LengthLow = Val(Text3.Text) Mod 256
LengthHigh = Val(Text3.Text) \ 256
MbusQuery(0) = 0
MbusQuery(1) = 0
MbusQuery(2) = 0
MbusQuery(3) = 0
MbusQuery(4) = 0
MbusQuery(5) = 6
MbusQuery(6) = Val(Text1.Text)
MbusQuery(7) = 3
MbusQuery(8) = StartHigh
MbusQuery(9) = StartLow
MbusQuery(10) = LengthHigh
MbusQuery(11) = LengthLow
MbusRead = True
MbusWrite = False
Winsock1.SendData MbusQuery
ModbusWait = True
ModbusTimeOut = 0
Timer1.Enabled = True
'Else
'MsgBox ("Device not connected via TCP/IP")
End If
End Function
Private Sub Command3_Click()
Call read_dat
End Sub
Private Sub VScroll1_Change()
End Sub
Private Sub Command4_Click()
Dim MbusWriteCommand As String
Dim StartLow As Byte
Dim StartHigh As Byte
Dim ByteLow As Byte
Dim ByteHigh As Byte
Dim i As Integer
If (Winsock1.State = 7) Then
StartLow = Val(Text2.Text - 1) Mod 256
StartHigh = Val(Text2.Text - 1) \ 256
LengthLow = Val(Text3.Text) Mod 256
LengthHigh = Val(Text3.Text) \ 256
MbusWriteQuery = Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(7 + 2 * Val(Text3.Text)) + Chr(1) + Chr(16) + Chr(StartHigh) + Chr(StartLow) + Chr(0) + Chr(Val(Text3.Text)) + Chr(2 * Val(Text3.Text))
For i = 0 To Val(Text3.Text) - 1
ByteLow = Val(Text4(i).Text) Mod 256
ByteHigh = Val(Text4(i).Text) \ 256
MbusWriteQuery = MbusWriteQuery + Chr(ByteHigh) + Chr(ByteLow)
Next i
MbusRead = False
MbusWrite = True
Winsock1.SendData MbusWriteQuery
ModbusWait = True
ModbusTimeOut = 0
Timer1.Enabled = True
Else
MsgBox ("Device not connected via TCP/IP")
End If
End Sub
Private Sub Command5_Click()
Dim i
Open "d:\LTP.txt" For Output As #1
For i = 0 To 89
'Print #1, NO; Str(i + 1); Text4(i).Text
Write #1, Val(Text4(i).Text)
Next i
'Print #1, "浓度"
Close #1
Call save
End Sub
Public Function save()
On Error GoTo pj1
pj2: Open "c:\tcp_set.ini" For Output As #1
Print #1, ip.Text
Print #1, port.Text
Print #1, Text2.Text
Print #1, Text3.Text
Print #1, Text1.Text
Print #1, Check.Value
Close #1
Exit Function
pj1: Close #1
GoTo pj2
End Function
Private Sub Form_Load()
Dim tem As String
On Error GoTo xt1
xt2: Open "c:\tcp_set.ini" For Input As #1
Line Input #1, tem '
ip.Text = tem
Line Input #1, tem
port.Text = tem
Line Input #1, tem
Text2.Text = tem
Line Input #1, tem
Text3.Text = tem
Line Input #1, tem
Text1.Text = tem
Line Input #1, tem
Check.Value = Val(tem)
'On Error GoTo xt1
Close #1
'Call Command1_Click
'Call Command3_Click
'Call Command5_Click
'Unload Me
Exit Sub
xt1: Close #1
Open "c:\tcp_set.ini" For Output As #1
Print #1, "192.168.1.103"
Print #1, "502"
Print #1, "100"
Print #1, "10"
Print #1, "1"
Print #1, "1"
Close #1
GoTo xt2
End Sub
Private Sub Timer1_Timer()
ModbusTimeOut = ModbusTimeOut + 1
If ModbusTimeOut > 2 Then
ModbusWait = False
ModbusTimeOut = 0
Text5.Text = "Modbus Time Out"
Text5.BackColor = &HFF
Timer1.Enabled = False
End If
End Sub
Private Sub Winsock1_DataArrival(ByVal datalength As Long)
Dim b As Byte
Dim j As Byte
Dim fl As Double
For i = 1 To datalength
Winsock1.GetData b
MbusByteArray(i) = b
Next
j = 0
If MbusRead Then
If Check.Value Then
For i = 10 To MbusByteArray(9) + 9 Step 4
Text4(j).Text = hex2float(MbusByteArray(i), MbusByteArray(i + 1), MbusByteArray(i + 2), MbusByteArray(i + 3))
j = j + 1
Next i
Else
For i = 10 To MbusByteArray(9) + 9 Step 2
'For i = 1 To datalength
'Text1.Text = Str(j) + ": " + " [ " + Str((MbusByteArray(i) * 255) + MbusByteArray(i + 1)) + " ]"
'Text1.Text = Str(j) + ": " + " [ " + Str(MbusByteArray(i)) + " ]"
'List1.AddItem (Text1.Text)
Text4(j).Text = Str((MbusByteArray(i) * 256) + MbusByteArray(i + 1))
j = j + 1
Next i
End If
Text5.Text = "Registers read"
Text5.BackColor = &HFF00&
For l = j To 89
Text4(l).Text = "*****"
Next l
ModbusWait = False
ModbusTimeOut = 0
Timer1.Enabled = False
End If
If MbusWrite Then
If (MbusByteArray(8) = 16) And (MbusByteArray(12) = Val(Text3.Text)) Then
Text5.Text = "Registers written"
Text5.BackColor = &HFF00&
ModbusWait = False
ModbusTimeOut = 0
Timer1.Enabled = False
Else
Text5.Text = "Error writting registers"
Text5.BackColor = &HFF
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -