frmmain.frm

modbus 协议通讯程序

      Caption         =   "接收信息"
      Height          =   3495
      Left            =   3840
      TabIndex        =   1
      Top             =   840
      Width           =   5775
      Begin VB.TextBox txtReceive 
         Height          =   2775
         Left            =   240
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   2
         Top             =   360
         Width           =   5295
      End
   End
   Begin MSCommLib.MSComm mscom 
      Left            =   4680
      Top             =   7920
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "ModBus通讯协议调试器"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   3360
      TabIndex        =   0
      Top             =   240
      Width           =   3195
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strReceive As String
Private Sub Command1_Click()
 Dim SendData(5) As Byte
 Dim CRCData() As Byte
 
  Dim strtemp As String
  Dim i As Integer
  With mscom
  .CommPort = CInt(Right(combComNumber.Text, 1))
  .Settings = combComBps.Text & COMBitCheck(combComCheck.Text) & _
                   combComBit.Text & combComStopBit.Text
   .InputLen = 0
   .InputMode = comInputModeBinary
   .SThreshold = 0
   .RThreshold = 1
   End With
  If mscom.PortOpen = False Then mscom.PortOpen = True
  If optRTU = True Then
  
    SendData(0) = CByte(combSlaveAddress.Text)
    SendData(1) = CByte(Val(combFunction.Text))
    SendData(2) = CByte(Val(txtDataAddress.Text) \ 256)
    SendData(3) = CByte(Val(txtDataAddress.Text) Mod 256)
    SendData(4) = CByte(Val(txtDataLen.Text) \ 256)
    SendData(5) = CByte(Val(txtDataLen.Text) Mod 256)
    CRCData = CRC16(SendData())
    For i = LBound(CRCData) To UBound(CRCData)
     strtemp = strtemp & Hex(CRCData(i)) & " "
     
    Next i
    txtSend = strtemp
  End If
  
  With mscom
  .Output = CRCData
  End With
  ReceiveTime.Enabled = True
  
End Sub





Function COMBitCheck(strtemp As String) As String
If strtemp = "偶校验" Then COMBitCheck = "E"
If strtemp = "标志" Then COMBitCheck = "M"
If strtemp = "无" Then COMBitCheck = "N"
If strtemp = "奇校验" Then COMBitCheck = "O"
If strtemp = "空格" Then COMBitCheck = "S"
End Function



Private Sub Form_Initialize()
Dim i As Integer
With combSlaveAddress
For i = 1 To 247
  .AddItem (i)
Next i
  .Text = .List(0)
End With

With combFunction
  .AddItem ("1 读开关量输出")
  .AddItem ("2 读开关量输入")
  .AddItem ("3 读寄存器数据")
  .AddItem ("5 写开关量输出")
  .AddItem ("6 写单路寄存器")
  .AddItem ("10 写多路寄存器")
.Text = .List(2)
End With

With combComNumber
For i = 1 To 16
combComNumber.AddItem ("COM" & i)
Next i
 .Text = .List(0)
End With


With combComBps

 .AddItem (300)
 .AddItem (600)
 .AddItem (1200)
 .AddItem (2400)
 .AddItem (4800)
 .AddItem (9600)
 .AddItem (14400)
 .AddItem (19200)
 .AddItem (38400)
 .AddItem (57600)
 .AddItem (115200)

 .Text = .List(3)
End With

With combComBit
 For i = 4 To 8
 .AddItem (i)
 Next i
 .Text = .List(4)
End With



With combComCheck
.AddItem ("偶校验")
.AddItem ("标志")
.AddItem ("无")
.AddItem ("奇校验")
.AddItem ("空格")

.Text = .List(2)
End With

With combComStopBit
 .AddItem (1)
 .AddItem (1.5)
 .AddItem (2)
 .Text = .List(0)
End With

With combComStream
.AddItem ("无")
.AddItem ("Xon/Xoff")
.AddItem ("RTS/CTS")
.AddItem ("RTS和Xon/Xoff")
.Text = .List(0)
End With


End Sub

Private Sub Form_Unload(Cancel As Integer)

SaveSetting "ModBus Debuger", "COM", "ComNumber", combComNumber.Text
SaveSetting "ModBus Debuger", "COM", "ComBps", combComBps.Text
SaveSetting "ModBus Debuger", "COM", "ComBit", combComBit.Text
SaveSetting "ModBus Debuger", "COM", "ComCheck", combComCheck.Text
SaveSetting "ModBus Debuger", "COM", "ComStopBit", combComStopBit.Text
SaveSetting "ModBus Debuger", "COM", "ComStream", combComStream.Text

SaveSetting "ModBus Debuger", "Setting", "Mode", optRTU.Value
SaveSetting "ModBus Debuger", "Setting", "SalveAddress", combSlaveAddress.Text
SaveSetting "ModBus Debuger", "Setting", "Function", combFunction.Text
SaveSetting "ModBus Debuger", "Setting", "DataAddress", txtDataAddress.Text
SaveSetting "ModBus Debuger", "Setting", "DataLen", txtDataLen.Text


End Sub

Private Sub mscom_OnComm()
 Dim strtemp As String
 Dim ReceiveData() As Byte
 Select Case mscom.CommEvent
  Case comEventCDTO ' CD (RLSD) Timeout.
  Case comEventCTSTO ' CTS Timeout.
  Case comEventDSRTO ' DSR Timeout.
  Case comEventFrame ' Framing Error
  Case comEventOverrun ' Data Lost.
  Case comEventRxOver ' Receive buffer overflow.
  Case comEventRxParity ' Parity Error.
  Case comEventTxFull ' Transmit buffer full.
  Case comEventDCB ' Unexpected error retrieving DCB]
  
  Case comEvCD ' Change in the CD line.
  Case comEvCTS ' Change in the CTS line.
  Case comEvDSR ' Change in the DSR line.
  Case comEvRing ' Change in the Ring Indicator.
  Case comEvReceive ' Received RThreshold # of' chars.
     ReceiveData = mscom.Input
      For i = LBound(ReceiveData) To UBound(ReceiveData)
       strReceive = strReceive & "&H" & Hex(ReceiveData(i)) & " "
       Next i
  Case comEvSend ' There are SThreshold number of' characters in the transmit' buffer.
  Case comEvEOF ' An EOF charater was found in
 End Select
End Sub

Private Sub Text2_Change()

End Sub



Private Sub ReceiveTime_Timer()
Dim strtemp As String
ReceiveTime.Enabled = False
 'For i = LBound(ReceiveData) To UBound(ReceiveData)
  'strtemp = strtemp & Hex(ReceiveData(i)) & " "
'Next i
strtemp = "&H"
CheckReceiveData (strReceive)
txtReceive = txtReceive & strReceive & vbCrLf
strReceive = ""
mscom.PortOpen = False



End Sub

Sub CheckReceiveData(strData As String)
 Dim i As Integer
 Dim strtemp As String
 Dim strLen As Integer
 Dim Position
 Dim strCompare As String
 Dim ByteTemp As New Collection
 Position = 0

 strtemp = strData
 Do While Len(strtemp) > 0
  Position = InStr(strtemp, " ")
  ByteTemp.Add CByte(Val(Left(strtemp, Position)))
  strtemp = Right(strData, Len(strtemp) - Position)
 Loop
    
 'if bytetemp.Item(1)>
  
  

End Sub