frmutility.frm

ModBus通信测试工具,方便工程开发测试用.

         Top             =   345
         Width           =   9420
         Begin VB.TextBox txtMData 
            Appearance      =   0  'Flat
            BackColor       =   &H8000000F&
            BorderStyle     =   0  'None
            Height          =   4320
            Left            =   30
            Locked          =   -1  'True
            MultiLine       =   -1  'True
            ScrollBars      =   2  'Vertical
            TabIndex        =   20
            TabStop         =   0   'False
            Top             =   195
            Width           =   9345
         End
      End
      Begin VB.Label lblMsg 
         BackStyle       =   0  'Transparent
         Caption         =   "→ → →"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H000000FF&
         Height          =   195
         Left            =   -68205
         TabIndex        =   29
         Top             =   210
         Visible         =   0   'False
         Width           =   945
      End
   End
   Begin VB.Label lblPort 
      Caption         =   "端口关闭"
      ForeColor       =   &H000000FF&
      Height          =   165
      Left            =   3360
      TabIndex        =   27
      Top             =   7245
      Width           =   720
   End
   Begin VB.Label Label 
      Alignment       =   2  'Center
      Caption         =   "ModBus 通 讯 测 试"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   21.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Index           =   0
      Left            =   2130
      TabIndex        =   24
      Top             =   450
      Width           =   6000
   End
   Begin VB.Label lblComsettings 
      BackColor       =   &H008080FF&
      BackStyle       =   0  'Transparent
      Caption         =   "COM:1  Settings:19200,n,8,1"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   240
      Left            =   270
      TabIndex        =   22
      Top             =   7200
      Width           =   4875
   End
   Begin VB.Label Label5 
      Alignment       =   2  'Center
      Caption         =   "CRC码："
      ForeColor       =   &H00FF0000&
      Height          =   210
      Left            =   8340
      TabIndex        =   18
      Top             =   6195
      Width           =   705
   End
   Begin VB.Label Label4 
      Alignment       =   2  'Center
      Caption         =   "点数/数据："
      ForeColor       =   &H00FF0000&
      Height          =   210
      Left            =   6360
      TabIndex        =   17
      Top             =   6195
      Width           =   1005
   End
   Begin VB.Label Label3 
      Alignment       =   2  'Center
      Caption         =   "起始地址："
      ForeColor       =   &H00FF0000&
      Height          =   210
      Left            =   4425
      TabIndex        =   16
      Top             =   6195
      Width           =   945
   End
   Begin VB.Label Label2 
      Alignment       =   2  'Center
      Caption         =   "功能码："
      ForeColor       =   &H00FF0000&
      Height          =   210
      Left            =   2505
      TabIndex        =   15
      Top             =   6195
      Width           =   945
   End
   Begin VB.Label lblAddr 
      Alignment       =   2  'Center
      Caption         =   "从机地址："
      ForeColor       =   &H00FF0000&
      Height          =   210
      Left            =   570
      TabIndex        =   14
      Top             =   6195
      Width           =   945
   End
   Begin VB.Label Label 
      Alignment       =   2  'Center
      BackColor       =   &H00FF8080&
      BackStyle       =   0  'Transparent
      Caption         =   "Copyright (C) 2004 C.Y.Huang"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00808080&
      Height          =   255
      Index           =   39
      Left            =   4890
      TabIndex        =   8
      Top             =   7200
      Width           =   3435
   End
   Begin VB.Label Label 
      BorderStyle     =   1  'Fixed Single
      Height          =   6120
      Index           =   1
      Left            =   240
      TabIndex        =   7
      Top             =   1020
      Width           =   9690
   End
   Begin VB.Menu Oper 
      Caption         =   "设置(&S)"
      Begin VB.Menu ProtSettings 
         Caption         =   "端口设置(&P)"
      End
      Begin VB.Menu N1 
         Caption         =   "-"
      End
      Begin VB.Menu Close 
         Caption         =   "退    出(&C)"
      End
   End
   Begin VB.Menu Cor 
      Caption         =   "通信(&C)"
      Begin VB.Menu ProtOpen 
         Caption         =   "打开端口(&O)"
      End
      Begin VB.Menu N3 
         Caption         =   "-"
      End
      Begin VB.Menu crc 
         Caption         =   "CRC测试(&T)"
      End
      Begin VB.Menu SendData 
         Caption         =   "发送数据(&S)"
         Enabled         =   0   'False
      End
      Begin VB.Menu N5 
         Caption         =   "-"
      End
      Begin VB.Menu Clcer 
         Caption         =   "清空接收区(&C)"
      End
   End
   Begin VB.Menu Help 
      Caption         =   "帮助(&H)"
      Begin VB.Menu Content 
         Caption         =   "Content(&C)"
      End
      Begin VB.Menu N4 
         Caption         =   "-"
      End
      Begin VB.Menu About 
         Caption         =   "About ModBus Utility(&A)"
      End
   End
End
Attribute VB_Name = "frmUtility"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim CRC16Lo As Byte, CRC16Hi As Byte     'CRC寄存器
Dim LoadOK As Boolean, AutoSend As Boolean
Dim SendBuf() As Byte, ByteSize As Long
Dim SetMax As Boolean
Private Sub CRC16(data As Byte)
    Dim CL As Byte, CH As Byte           '多项式码&HA001
    Dim SaveHi As Byte, SaveLo As Byte
    Dim i As Integer
    CL = &H1
    CH = &HA0
    CRC16Lo = CRC16Lo Xor data           '每一个数据与CRC寄存器低位进行异或
    For i = 0 To 7
        SaveHi = CRC16Hi
        SaveLo = CRC16Lo
        CRC16Hi = CRC16Hi \ 2            '高位右移一位
        CRC16Lo = CRC16Lo \ 2            '低位右移一位
        If ((SaveHi And &H1) = &H1) Then '如果右移前高位字节最后一位为1
          CRC16Lo = CRC16Lo Or &H80      '则低位字节右移后前面补1
        End If                           '否则自动补0
        If ((SaveLo And &H1) = &H1) Then '如果右移前低位字节最后一位为1，则与多项式码进行异或
          CRC16Hi = CRC16Hi Xor CH
          CRC16Lo = CRC16Lo Xor CL
        End If
    Next i
End Sub

Private Sub About_Click()
  frmAbout.Show
End Sub

Private Sub chkAutoSend_Click()
  If chkAutoSend.Value = 1 Then
     AutoSend = True
     TmFlash.Enabled = True
     cmdSend.Enabled = False
  ElseIf chkAutoSend.Value = 0 Then
     AutoSend = False
     TmFlash.Enabled = False
     lblMsg.Visible = False
     txtMAddr = "01": txtCommand = "03": txtSAddr = "0000": txtPSum = "0000": txtCRC = "45CA"
     cmdSend.Enabled = True
  End If
End Sub

Private Sub chkSetMax_Click()
  If chkSetMax.Value = 1 Then
     SetMax = True
  Else: SetMax = False
  End If
End Sub

Private Sub Clcer_Click()
  cmdClcer_Click
End Sub

Private Sub Close_Click()
  cmdExit_Click
End Sub

Private Sub cmdClcer_Click()
  Dim InBufCount As Integer
  If SSTab.Tab = 0 Then
     InBufCount = MsCOM.InBufferCount
     txtMData = ""
  ElseIf SSTab.Tab = 1 Then
     txtHCommand = ""
     InBufCount = MsCOM.InBufferCount
  End If
End Sub

Private Sub cmdComSet_Click()
  frmCOM.Show
  frmCOMopen = True
End Sub

Private Sub cmdCRC_Click()
  Dim WriteBuf(7) As Byte, Tem As Single
  
  WriteBuf(0) = Hex2Dec(txtMAddr)
  WriteBuf(1) = Hex2Dec(txtCommand)
  WriteBuf(2) = Hex2Dec(Left$(txtSAddr, 2))
  WriteBuf(3) = Hex2Dec(Right$(txtSAddr, 2))
  WriteBuf(4) = Hex2Dec(Left$(txtPSum, 2))
  WriteBuf(5) = Hex2Dec(Right$(txtPSum, 2))
  CRC16Lo = &HFF
  CRC16Hi = &HFF
  CRC16 WriteBuf(0)
  CRC16 WriteBuf(1)
  CRC16 WriteBuf(2)
  CRC16 WriteBuf(3)
  CRC16 WriteBuf(4)
  CRC16 WriteBuf(5)
  WriteBuf(6) = CRC16Lo  '取低位
  WriteBuf(7) = CRC16Hi  '取高位
  
'  txtMData = ""
  If Len(Hex(CRC16Lo)) > 1 And Len(Hex(CRC16Hi)) <= 1 Then
     txtCRC = Hex(CRC16Lo) & "0" & Hex(CRC16Hi)
  ElseIf Len(Hex(CRC16Lo)) <= 1 And Len(Hex(CRC16Hi)) > 1 Then
     txtCRC = "0" & Hex(CRC16Lo) & Hex(CRC16Hi)
  ElseIf Len(Hex(CRC16Lo)) <= 1 And Len(Hex(CRC16Hi)) <= 1 Then
     txtCRC = "0" & Hex(CRC16Lo) & "0" & Hex(CRC16Hi)
  ElseIf Len(Hex(CRC16Lo)) > 1 And Len(Hex(CRC16Hi)) > 1 Then
     txtCRC = Hex(CRC16Lo) & Hex(CRC16Hi)
  End If
End Sub
Private Sub cmdExit_Click()
  If MsgBox("你真的退出吗?", vbYesNo + vbQuestion, "确认") = vbYes Then
     LoadOK = False
     If MsCOM.PortOpen = True Then MsCOM.PortOpen = False
     MsCOM.InBufferCount = 0
     If frmCOMopen = True Then Unload frmCOM
        Set frmUtility = Nothing
     End
     Unload Me
  End If
End Sub

Private Sub cmdOpenCOM_Click()
  On Error GoTo OpenErr:
  If cmdOpenCOM.Caption = "打开通讯口(&O)" Then
     MsCOM.CommPort = xCOM
     MsCOM.Settings = ComSetting
     If MsCOM.PortOpen = False Then MsCOM.PortOpen = True
     cmdOpenCOM.Caption = "关闭通讯口(&C)"
     ProtOpen.Caption = "关闭端口"
     cmdComSet.Enabled = False