frmmainform.frm

modbus源代码

VERSION 5.00
Begin VB.Form frmMainForm 
   Caption         =   "Visual Basic Sample "
   ClientHeight    =   4965
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6405
   LinkTopic       =   "Form1"
   ScaleHeight     =   4965
   ScaleWidth      =   6405
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton cmdHangUp 
      Caption         =   "Hang Up"
      Height          =   375
      Left            =   120
      TabIndex        =   18
      Top             =   4440
      Width           =   2175
   End
   Begin VB.CommandButton cmdInitializeModem 
      Caption         =   "Initialize Modem && Dial"
      Height          =   375
      Left            =   120
      TabIndex        =   17
      Top             =   3840
      Width           =   2175
   End
   Begin VB.ListBox lstErros 
      Height          =   420
      Left            =   2880
      TabIndex        =   16
      Top             =   1800
      Width           =   3255
   End
   Begin VB.CommandButton cmdStartServer 
      Caption         =   "Connect with Serial Device"
      Height          =   375
      Left            =   120
      TabIndex        =   15
      Top             =   120
      Width           =   2415
   End
   Begin VB.CommandButton cmdConnectWithTcpServer 
      Caption         =   "Connect with TCP Server"
      Height          =   375
      Left            =   120
      TabIndex        =   14
      Top             =   1080
      Width           =   2415
   End
   Begin VB.CommandButton cmdCustomfunc 
      Caption         =   "Custom Modbus Function"
      Height          =   375
      Left            =   120
      TabIndex        =   13
      Top             =   2040
      Width           =   2415
   End
   Begin VB.TextBox txtAddress 
      Height          =   285
      Left            =   3720
      MaxLength       =   5
      TabIndex        =   10
      Text            =   "0"
      Top             =   3000
      Width           =   975
   End
   Begin VB.TextBox txtQuantity 
      Height          =   285
      Left            =   5640
      MaxLength       =   2
      TabIndex        =   8
      Text            =   "10"
      Top             =   3000
      Width           =   495
   End
   Begin VB.ComboBox cboReadFunction 
      Height          =   315
      Left            =   4080
      Style           =   2  'Dropdown List
      TabIndex        =   6
      Top             =   2640
      Width           =   2055
   End
   Begin VB.TextBox txtDevice 
      Height          =   285
      Left            =   3600
      MaxLength       =   2
      TabIndex        =   5
      Text            =   "1"
      Top             =   2640
      Width           =   375
   End
   Begin VB.CommandButton cmdStartStopPoll 
      Caption         =   "&Start"
      Height          =   375
      Left            =   2880
      TabIndex        =   3
      Top             =   3360
      Width           =   3135
   End
   Begin VB.Timer trmPollDevice 
      Enabled         =   0   'False
      Interval        =   1500
      Left            =   2640
      Top             =   1440
   End
   Begin VB.ListBox lstValues 
      Height          =   960
      Left            =   2880
      TabIndex        =   2
      Top             =   480
      Width           =   3255
   End
   Begin VB.CommandButton cmdNew 
      Caption         =   "New Form Instance"
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   1560
      Width           =   2415
   End
   Begin VB.CheckBox chkEnableTCPInterface 
      Caption         =   "Enable TCP Server Interface"
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Top             =   600
      Width           =   2415
   End
   Begin VB.Label Label5 
      Caption         =   $"frmMainForm.frx":0000
      Height          =   1095
      Left            =   2400
      TabIndex        =   19
      Top             =   3840
      Width           =   4095
   End
   Begin VB.Label lblStat 
      BorderStyle     =   1  'Fixed Single
      Height          =   255
      Left            =   2880
      TabIndex        =   12
      Top             =   120
      Width           =   3255
   End
   Begin VB.Label Label4 
      Caption         =   " See the functions ConnectWithSerialDevice() and ConnectUsingTCP_IP()  and change serial port or TCP/IP parameters"
      Height          =   1095
      Left            =   120
      TabIndex        =   11
      Top             =   2520
      Width           =   2415
   End
   Begin VB.Label Label3 
      Caption         =   "Start Addr."
      Height          =   375
      Left            =   2520
      TabIndex        =   9
      Top             =   3000
      Width           =   1095
   End
   Begin VB.Label Label2 
      Caption         =   "Quantity"
      Height          =   255
      Left            =   4800
      TabIndex        =   7
      Top             =   3000
      Width           =   735
   End
   Begin VB.Label Label1 
      Caption         =   "Poll Device"
      Height          =   375
      Left            =   2640
      TabIndex        =   4
      Top             =   2520
      Width           =   855
   End
End
Attribute VB_Name = "frmMainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim m_ModbusServer As ModbusSrv 'Modbus Server Object
Dim m_TcpServer As CTCPIPServer 'TCP Server used for starting TCP/Serial port Interface
'Dim m_DcomUtil As DCOMLib
Dim m_bServerStarted As Boolean
Dim m_lErrors As Long
Dim m_lNumPolls As Long


Function ConnectUsingTCP_IP() As Boolean
 On Error GoTo ErrorConnectUsingTCP_IP
  
  'Set m_DcomUtil = New DCOMLib 'Initialize object to use DCOM
  
  'You can use normal Vb object creation
  'if you not try to instanciate on another machine
  Set m_ModbusServer = New ModbusSrv
  
   'Set m_ModbusServer = m_DcomUtil.CreateRemoteObject("{B3DE3CC2-C629-11D1-8FE9-E4CD05C10000}", "", False)

   'Set parameters as your hardware requirements
   m_ModbusServer.OpenConnection "127.0.0.1:502", mbREMOTE
   m_ModbusServer.Host = "127.0.0.1"
   m_ModbusServer.TcpPort = 502
   m_ModbusServer.TimeOut = 2000
   
   m_ModbusServer.RaiseError = True
     
   If Not m_ModbusServer.Connect Then
      ConnectUsingTCP_IP = False
      MsgBox "Error connecting with TCP/IP Server. Try to change TCP/IP parameters, see the Function ConnectUsingTCP_IP"
   Else
      End If
   
   
   
Exit Function

ErrorConnectUsingTCP_IP:
 MsgBox "Error:" & CStr(Err) & " " & Err.Description
 ConnectUsingTCP_IP = False
Exit Function
End Function

Sub LoadContols()

   Me.cboReadFunction.AddItem "Read Output Registers"
   Me.cboReadFunction.AddItem "Read Input Registers"
   Me.cboReadFunction.AddItem "Read Output Status (Coils)"
   Me.cboReadFunction.AddItem "Read Input Status (Coils)"
   
   cboReadFunction.ListIndex = 0
End Sub

Sub ReadFunction()
  
  On Error GoTo ReadFunctionError
  
  Dim vValues As Variant
  Dim iDevice As Integer
  Dim iDataStart As Long
  Dim iQnt As Integer
  Dim i As Integer
  
  iDevice = Val(Me.txtDevice.Text)
  iDataStart = Val(Me.txtAddress.Text)
  iQnt = Val(Me.txtQuantity.Text)
  
  lblStat.Caption = CStr(m_lNumPolls) & " Errors = " & CStr(m_lErrors)
  Me.Caption = lblStat.Caption
  m_lNumPolls = m_lNumPolls + 1
  
  If iQnt > 0 Then
  
      Select Case Me.cboReadFunction.ListIndex
       
       Case 0
            m_ModbusServer.ReadOutputRegisters iDevice, iDataStart, iQnt, vValues, vbLong
            
            'Example reading Modbus Registers using floating point support
            'Note that when reading 1 float number is equivalent to read 2 registers
            'because you need 2 WORDS (Registers) to store a floating point number
            'double floating point number requires 4 Registers.
            
            'constants  mbREAL_NORMAL and mbREAL_REVERSE indicates if most significant part of
            'the real number is at the first register or the last register.
            
            'Read float
            'm_ModbusServer.ReadOutputRegisters iDevice, iDataStart, iQnt, vValues, vbSingle, mbREAL_NORMAL
            
            'Read float reversed
            'm_ModbusServer.ReadOutputRegisters iDevice, iDataStart, iQnt, vValues, vbSingle, mbREAL_REVERSE
            
            'Read double
            'm_ModbusServer.ReadOutputRegisters iDevice, iDataStart, iQnt, vValues, vbDouble, mbREAL_NORMAL
            
            'Read double reversed
            'm_ModbusServer.ReadOutputRegisters iDevice, iDataStart, iQnt, vValues, vbDouble, mbREAL_REVERSE
    
       
       Case 1
            m_ModbusServer.ReadInputRegisters iDevice, iDataStart, iQnt, vValues, vbLong