frmmodbusplat.frm

一个modbus的测试工具

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmModbusPlat 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Modbus客户仿真机"
   ClientHeight    =   6195
   ClientLeft      =   45
   ClientTop       =   735
   ClientWidth     =   10695
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   9.75
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmModbusPlat.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   6195
   ScaleWidth      =   10695
   StartUpPosition =   2  'CenterScreen
   Begin VB.Timer tmrTime 
      Interval        =   500
      Left            =   360
      Top             =   4200
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   480
      Top             =   4800
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
   Begin MSComctlLib.StatusBar stbStatus 
      Align           =   2  'Align Bottom
      Height          =   375
      Left            =   0
      TabIndex        =   0
      Top             =   5820
      Width           =   10695
      _ExtentX        =   18865
      _ExtentY        =   661
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   4
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   7832
            MinWidth        =   7832
         EndProperty
         BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   6068
            MinWidth        =   6068
         EndProperty
         BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Alignment       =   1
         EndProperty
      EndProperty
   End
   Begin VB.Menu mnuControl 
      Caption         =   "控制（&C）"
      Begin VB.Menu mnuConnect 
         Caption         =   "联接（&O）"
      End
      Begin VB.Menu mnuDisconnect 
         Caption         =   "离线（&D）"
         Enabled         =   0   'False
      End
      Begin VB.Menu mnuOper1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "退出（&X）"
         Shortcut        =   ^X
      End
   End
   Begin VB.Menu mnuSimulator 
      Caption         =   "仿真工具（&S）"
      Enabled         =   0   'False
      Begin VB.Menu mnuPortSpy 
         Caption         =   "端口监视（&P）..."
      End
      Begin VB.Menu mnuDataSimu 
         Caption         =   "数据仿真器（&E）..."
      End
   End
   Begin VB.Menu mnuOption 
      Caption         =   "选项（&O）"
      Begin VB.Menu mnuHDSet 
         Caption         =   "硬件设置（&H）..."
      End
      Begin VB.Menu mnuPLSet 
         Caption         =   "协议设置（&P）..."
      End
   End
   Begin VB.Menu mnuAbout 
      Caption         =   "关于(&A)"
   End
End
Attribute VB_Name = "frmModbusPlat"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const cPORTSTATUSINDEX = 1
Const cPORTDESPINDEX = 2
Const cPLDESPINDEX = 3
Const cTIMESTATUSINDEX = 4

Private Sub Form_Load()
    stbStatus.Panels(cPORTSTATUSINDEX).Text = "端口离线"
    stbStatus.Panels(cTIMESTATUSINDEX).Text = Format$(Time, "hh:mm:ss")
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If gbOnline Then
        Cancel = True
    End If
End Sub

Private Sub mnuAbout_Click()
    Load frmCOMTestAbout
    frmCOMTestAbout.Show vbModal, Me
End Sub

Private Sub mnuConnect_Click()
    On Error GoTo ErrConnect
    MSComm1.CommPort = gtHDSet.byCOMPort
    MSComm1.Settings = gsBaudRate(gtHDSet.byBaudRate) & "," & _
        Left$(gsParityMode(gtHDSet.byParityMode), 1) & "," & _
        gsDataBit(gtHDSet.byDataBit) & "," & gsStopBit(gtHDSet.byStopBit)
    MSComm1.Handshaking = gtHDSet.byHandShaking
    If gtPLSet.byFrameType = 0 Then
        MSComm1.InputMode = comInputModeText
    Else
        MSComm1.InputMode = comInputModeBinary
    End If
    MSComm1.EOFEnable = gtHDSet.bEOFEnable
    MSComm1.NullDiscard = gtHDSet.bNullDiscard
    MSComm1.RTSEnable = gtHDSet.bRTSEnable
    MSComm1.DTREnable = gtHDSet.bDTREnable
    MSComm1.InputLen = 0
    MSComm1.PortOpen = True
    stbStatus.Panels(cPORTSTATUSINDEX).Text = "端口在线"
    mnuConnect.Enabled = False
    mnuExit.Enabled = False
    mnuDisconnect.Enabled = True
    mnuSimulator.Enabled = True
    tmrTime.Interval = gtPLSet.iScan
    gbOnline = True
    Exit Sub
ErrConnect:
    stbStatus.Panels(cPORTDESPINDEX).Text = Err.Description
End Sub

Private Sub mnuDataSimu_Click()
    Load frmDataSimu
    frmDataSimu.Show vbModal, Me
End Sub

Private Sub mnuDisconnect_Click()
    MSComm1.PortOpen = False
    stbStatus.Panels(cPORTSTATUSINDEX).Text = "端口离线"
    mnuSimulator.Enabled = False
    mnuDisconnect.Enabled = False
    mnuConnect.Enabled = True
    mnuExit.Enabled = True
    gbOnline = False
End Sub

Private Sub mnuExit_Click()
    Unload Me
End Sub

Private Sub mnuHDSet_Click()
    Load frmHDSet
    frmHDSet.Show vbModal, Me
End Sub

Private Sub mnuPLSet_Click()
    Load frmPLSet
    frmPLSet.Show vbModal, Me
End Sub

Private Sub mnuPortSpy_Click()
    Load frmPortSpy
    frmPortSpy.Show vbModal, Me
End Sub

Private Sub MSComm1_OnComm()
    Select Case MSComm1.CommEvent
        Case comEventBreak
            stbStatus.Panels(cPORTDESPINDEX).Text = "收到 Break"
        Case comEventCDTO
            stbStatus.Panels(cPORTDESPINDEX).Text = "CD (RLSD) 超时"
        Case comEventCTSTO
            stbStatus.Panels(cPORTDESPINDEX).Text = "CTS 超时"
        Case comEventDSRTO
            stbStatus.Panels(cPORTDESPINDEX).Text = "DSR 超时"
        Case comEventFrame
            stbStatus.Panels(cPORTDESPINDEX).Text = "帧错误"
        Case comEventOverrun
            stbStatus.Panels(cPORTDESPINDEX).Text = "数据丢失"
        Case comEventRxOver
            stbStatus.Panels(cPORTDESPINDEX).Text = "接收缓冲区溢出"
        Case comEventRxParity
            stbStatus.Panels(cPORTDESPINDEX).Text = "校验错误"
        Case comEventTxFull
            stbStatus.Panels(cPORTDESPINDEX).Text = "传输缓冲区已满"
        Case comEventDCB
            stbStatus.Panels(cPORTDESPINDEX).Text = "获取 DCB] 时意外错误"
        Case comEvCD
            stbStatus.Panels(cPORTDESPINDEX).Text = "CD 线状态变化"
        Case comEvCTS
            stbStatus.Panels(cPORTDESPINDEX).Text = "CTS 线状态变化"
        Case comEvDSR
            stbStatus.Panels(cPORTDESPINDEX).Text = "DSR 线状态变化"
        Case comEvRing
            stbStatus.Panels(cPORTDESPINDEX).Text = "Ring Indicator 变化"
        Case comEvReceive
            stbStatus.Panels(cPORTDESPINDEX).Text = "收到" & MSComm1.RThreshold & "个字符"
        Case comEvSend
            stbStatus.Panels(cPORTDESPINDEX).Text = "传输缓冲区有" & MSComm1.SThreshold & "个字符"
        Case comEvEOF
            stbStatus.Panels(cPORTDESPINDEX).Text = "输入数据流中发现 EOF 字符"
    End Select
End Sub

Private Sub tmrTime_Timer()
    Dim iInSize As Integer
    Dim vaInBuffer As Variant
    Dim byInBuffer() As Byte
    Dim strInBuffer() As String
    Dim vaOutBuffer As Variant
    Dim byOutBuffer() As Byte
    Dim strOutBuffer() As String
    Dim strTemp As String
    Dim i As Integer, j As Integer, k As Integer
    Dim iAddress As Integer
    Dim iDataCount As Integer
    Dim byByteCount As Byte
    Dim iPkgLen As Integer
    Dim iCrc As Integer
    Dim byCrc(1) As Byte
    Dim byData As Byte