📄 form1.frm
字号:
BeginProperty DataFormat
Type = 1
Format = "0"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1045
SubFormatType = 1
EndProperty
Height = 285
Index = 11
Left = 1800
TabIndex = 18
Text = "0"
Top = 840
Width = 735
End
Begin VB.TextBox Text4
BeginProperty DataFormat
Type = 1
Format = "0"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1045
SubFormatType = 1
EndProperty
Height = 285
Index = 10
Left = 1800
TabIndex = 17
Text = "0"
Top = 480
Width = 735
End
Begin VB.TextBox Text4
BeginProperty DataFormat
Type = 1
Format = "0"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1045
SubFormatType = 1
EndProperty
Height = 285
Index = 9
Left = 480
TabIndex = 16
Text = "0"
Top = 3720
Width = 735
End
Begin VB.TextBox Text4
BeginProperty DataFormat
Type = 1
Format = "0"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1045
SubFormatType = 1
EndProperty
Height = 285
Index = 8
Left = 480
TabIndex = 15
Text = "0"
Top = 3360
Width = 735
End
Begin VB.TextBox Text4
BeginProperty DataFormat
Type = 1
Format = "0"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1045
SubFormatType = 1
EndProperty
Height = 285
Index = 7
Left = 480
TabIndex = 14
Text = "0"
Top = 3000
Width = 735
End
Begin VB.TextBox Text4
BeginProperty DataFormat
Type = 1
Format = "0"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1045
SubFormatType = 1
EndProperty
Height = 285
Index = 6
Left = 480
TabIndex = 13
Text = "0"
Top = 2640
Width = 735
End
Begin VB.TextBox Text4
BeginProperty DataFormat
Type = 1
Format = "0"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1045
SubFormatType = 1
EndProperty
Height = 285
Index = 5
Left = 480
TabIndex = 12
Text = "0"
Top = 2280
Width = 735
End
Begin VB.TextBox Text4
BeginProperty DataFormat
Type = 1
Format = "0"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1045
SubFormatType = 1
EndProperty
Height = 285
Index = 4
Left = 480
TabIndex = 11
Text = "0"
Top = 1920
Width = 735
End
Begin VB.TextBox Text4
BeginProperty DataFormat
Type = 1
Format = "0"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1045
SubFormatType = 1
EndProperty
Height = 285
Index = 3
Left = 480
TabIndex = 10
Text = "0"
Top = 1560
Width = 735
End
Begin VB.TextBox Text4
BeginProperty DataFormat
Type = 1
Format = "0"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1045
SubFormatType = 1
EndProperty
Height = 285
Index = 2
Left = 480
TabIndex = 9
Text = "0"
Top = 1200
Width = 735
End
Begin VB.TextBox Text4
BeginProperty DataFormat
Type = 1
Format = "0"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1045
SubFormatType = 1
EndProperty
Height = 285
Index = 0
Left = 480
TabIndex = 8
Text = "0"
Top = 480
Width = 735
End
Begin VB.TextBox Text4
BeginProperty DataFormat
Type = 1
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 registers"
Height = 495
Left = 2640
TabIndex = 6
Top = 5880
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 = 8160
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 = 6960
TabIndex = 2
Text = "0"
Top = 4800
Width = 975
End
Begin VB.CommandButton Command2
Caption = "Disconnect"
Height = 495
Left = 240
TabIndex = 1
Top = 5880
Width = 1455
End
Begin VB.CommandButton Command1
Caption = "Connect"
Height = 495
Left = 7800
TabIndex = 0
Top = 5880
Width = 1695
End
Begin VB.Label Label5
Caption = "Status"
Height = 255
Left = 2520
TabIndex = 73
Top = 4560
Width = 855
End
Begin VB.Label Label4
Caption = "Adrress IP"
ForeColor = &H80000008&
Height = 375
Left = 360
TabIndex = 71
Top = 4560
Width = 1335
End
Begin VB.Label Label2
Caption = "Length"
Height = 375
Left = 8160
TabIndex = 5
Top = 4560
Width = 1335
End
Begin VB.Label Label1
Caption = "Start register"
Height = 375
Left = 6960
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(255) 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 = Text1.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 to " + Text1.Text
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
Private Sub Command3_Click()
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) Mod 256
StartHigh = Val(Text2.Text) \ 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) = 1
MbusQuery(7) = 3
MbusQuery(8) = StartHigh
MbusQuery(9) = StartLow
MbusQuery(10) = LengthHigh
MbusQuery(11) = LengthLow
MbusRead = True
MbusWrite = False
'MbusQuery = Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(6) + Chr(1) + Chr(3) + Chr(StartHigh) + Chr(StartLow) + Chr(LengtHigh) + Chr(LengthLow)
Winsock1.SendData MbusQuery
ModbusWait = True
ModbusTimeOut = 0
Timer1.Enabled = True
Else
MsgBox ("Device not connected via TCP/IP")
End If
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) Mod 256
StartHigh = Val(Text2.Text) \ 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 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
For i = 1 To datalength
Winsock1.GetData b
MbusByteArray(i) = b
Next
j = 0
If MbusRead Then
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
Text5.Text = "Registers read"
Text5.BackColor = &HFF00&
For l = j To 61
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 + -