VERSION 5.00 Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX" Begin VB.Form Form1 Caption = "Modbus TCP" ClientHeight = 5505 ClientLeft = 60 ClientTop = 345 ClientWidth = 13665 Icon = "Form1.frx":0000 LinkTopic = "Form1" ScaleHeight = 5505 ScaleWidth = 13665 StartUpPosition = 3 'Windows Default Begin VB.Frame Frame2 Caption = "Frame2" Height = 5295 Left = 120 TabIndex = 0 Top = 0 Width = 11295 Begin VB.TextBox Text1 Height = 285 Left = 1680 TabIndex = 27 Text = "502" Top = 1200 Width = 615 End Begin VB.TextBox txtIP Height = 285 Left = 360 TabIndex = 24 Text = "192.168.1.20" Top = 1200 Width = 1215 End Begin VB.CommandButton cmdConnect Caption = "Connect" Height = 375 Left = 360 TabIndex = 23 Top = 1680 Width = 855 End Begin VB.CommandButton cmdDisconnect Caption = "Disconnect" Enabled = 0 'False Height = 375 Left = 1320 TabIndex = 22 Top = 1680 Width = 975 End Begin VB.TextBox txtStartReg Height = 285 Left = 1680 TabIndex = 21 Text = "2000" Top = 2520 Width = 615 End Begin VB.TextBox txtLengthReg Height = 285 Left = 1680 TabIndex = 20 Text = "16" Top = 3000 Width = 615 End Begin VB.Frame Frame1 Caption = "Data" Height = 3495 Left = 2400 TabIndex = 3 Top = 360 Width = 1935 Begin VB.TextBox txtReg Height = 285 Index = 0 Left = 840 TabIndex = 11 Top = 360 Width = 855 End Begin VB.TextBox txtReg Height = 285 Index = 1 Left = 840 TabIndex = 10 Top = 720 Width = 855 End Begin VB.TextBox txtReg Height = 285 Index = 2 Left = 840 TabIndex = 9 Top = 1080 Width = 855 End Begin VB.TextBox txtReg Height = 285 Index = 3 Left = 840 TabIndex = 8 Top = 1440 Width = 855 End Begin VB.TextBox txtReg Height = 285 Index = 4 Left = 840 TabIndex = 7 Top = 1800 Width = 855 End Begin VB.TextBox txtReg Height = 285 Index = 5 Left = 840 TabIndex = 6 Top = 2160 Width = 855 End Begin VB.TextBox txtReg Height = 285 Index = 6 Left = 840 TabIndex = 5 Top = 2520 Width = 855 End Begin VB.TextBox txtReg Height = 285 Index = 7 Left = 840 TabIndex = 4 Top = 2880 Width = 855 End Begin VB.Label lbReg Caption = "0000" Height = 255 Index = 0 Left = 120 TabIndex = 19 Top = 360 Width = 615 End Begin VB.Label lbReg Caption = "0000" Height = 255 Index = 1 Left = 120 TabIndex = 18 Top = 720 Width = 615 End Begin VB.Label lbReg Caption = "0000" Height = 255 Index = 2 Left = 120 TabIndex = 17 Top = 1080 Width = 615 End Begin VB.Label lbReg Caption = "0000" Height = 255 Index = 3 Left = 120 TabIndex = 16 Top = 1440 Width = 615 End Begin VB.Label lbReg Caption = "0000" Height = 255 Index = 4 Left = 120 TabIndex = 15 Top = 1800 Width = 615 End Begin VB.Label lbReg Caption = "0000" Height = 255 Index = 5 Left = 120 TabIndex = 14 Top = 2160 Width = 615 End Begin VB.Label lbReg Caption = "0000" Height = 255 Index = 6 Left = 120 TabIndex = 13 Top = 2520 Width = 615 End Begin VB.Label lbReg Caption = "0000" Height = 255 Index = 7 Left = 120 TabIndex = 12 Top = 2880 Width = 615 End End Begin VB.CommandButton cmdRead Caption = "TX" Height = 375 Left = 360 TabIndex = 2 Top = 3480 Width = 855 End Begin VB.CommandButton cmdRealtime Caption = "Realtime" Height = 375 Left = 1320 TabIndex = 1 Top = 3480 Width = 975 End Begin VB.Label lblStatus Height = 375 Left = 360 TabIndex = 28 Top = 480 Width = 1935 End Begin VB.Label Label1 Caption = "Start Address:" Height = 255 Left = 240 TabIndex = 26 Top = 2520 Width = 1095 End Begin VB.Label Label2 Caption = "Length:" Height = 255 Left = 240 TabIndex = 25 Top = 3000 Width = 1095 End End Begin VB.Timer TimerRead Enabled = 0 'False Interval = 250 Left = 1440 Top = 4320 End Begin VB.Timer TimerTO Enabled = 0 'False Interval = 1000 Left = 840 Top = 4320 End Begin MSWinsockLib.Winsock Winsock1 Left = 240 Top = 4320 _ExtentX = 741 _ExtentY = 741 _Version = 393216 RemotePort = 502 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 Dim MbusByteArray(255) As Byte Dim MbusResponse As String Dim ModbusTimeOut As Integer Dim MbusRead As Boolean Dim MbusWrite As Boolean Dim ModbusWait As Boolean Private Sub cmdConnect_Click() Me.MousePointer = vbHourglass Winsock1.RemoteHost = txtIP.Text Winsock1.Connect Dim StartTime StartTime = Timer Do While ((Timer < StartTime + 2) And (Winsock1.State <> 7)) DoEvents Loop If (Winsock1.State = 7) Then lblStatus.Caption = "Connected" lblStatus.BackColor = vbGreen cmdConnect.Enabled = False cmdDisconnect.Enabled = True Else lblStatus.Caption = "Can't connect to " + txtIP.Text lblStatus.BackColor = vbYellow End If Me.MousePointer = vbDefault End Sub Private Sub cmdDisconnect_Click() Me.MousePointer = vbHourglass If TimerRead.Enabled = True Then TimerRead.Enabled = False If (Winsock1.State <> sckClosed) Then Winsock1.Close End If Dim StartTime StartTime = Timer Do While ((Timer < StartTime + 2) And (Winsock1.State <> sckClosed)) DoEvents Loop If (Winsock1.State = sckClosed) Then lblStatus.Caption = "Disconnected" lblStatus.BackColor = vbRed cmdConnect.Enabled = True cmdDisconnect.Enabled = False Else lblStatus.Caption = "Error disconnect!" lblStatus.BackColor = vbYellow End If Me.MousePointer = vbDefault End Sub Private Sub cmdRead_Click() Call ReadHolding End Sub Private Sub cmdRealtime_Click() If cmdRealtime.Caption = "Realtime Monitoring ON" Then TimerRead.Enabled = True cmdRealtime.Caption = "Realtime Monitoring OFF" Else TimerRead.Enabled = False cmdRealtime.Caption = "Realtime Monitoring ON" End If End Sub Private Sub Form_Load() For i = 0 To 7 lbReg(i).Caption = txtStartReg + i Next i End Sub Private Sub TimerRead_Timer() Call cmdRead_Click End Sub Private Sub TimerTO_Timer() ModbusTimeOut = ModbusTimeOut + 1 If ModbusTimeOut > 2 Then ModbusWait = False ModbusTimeOut = 0 lblStatus.Caption = "Modbus Time Out!" lblStatus.BackColor = vbYellow TimerTO.Enabled = False End If End Sub Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) Dim bData As Byte Dim j As Byte Dim k As Integer For i = 1 To bytesTotal Winsock1.GetData bData MbusByteArray(i) = bData Next j = 0 If MbusByteArray(8) = 3 Then '(3)read Holding registers For i = 10 To MbusByteArray(9) + 9 Step 2 txtReg(j).Text = (MbusByteArray(i) * 256) + MbusByteArray(i + 1) j = j + 1 Next i End If lblStatus.Caption = "RX" lblStatus.BackColor = vbGreen For k = j To 7 txtReg(k).Text = "" Next k ModbusWait = False ModbusTimeOut = 0 TimerTO.Enabled = False End Sub Sub ReadHolding() lblStatus.Caption = "TX" 'cek if length is more than 16 If Val(txtLengthReg.Text) > 7 Then txtLengthReg.Text = 7 'MsgBox "Can not read more than 16 registers!" Exit Sub End If Dim StartLow As Byte Dim StartHigh As Byte Dim LengthLow As Byte Dim LengthHigh As Byte If (Winsock1.State = 7) Then StartLow = Val(txtStartReg.Text - 1) Mod 256 StartHigh = Val(txtStartReg.Text) \ 256 LengthLow = Val(txtLengthReg.Text) Mod 256 LengthHigh = Val(txtLengthReg.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 Winsock1.SendData MbusQuery ModbusWait = True ModbusTimeOut = 0 TimerTO.Enabled = True Else MsgBox ("Device not connected via TCP/IP!") End If End Sub