frmmbtcp.frm

modbus协议用vb编写

    lstSend.Clear
    lstReceive.Clear
End Sub

Private Sub cmdClearStatistic_Click()
    mlSendByte = 0
    mlSendPacket = 0
    mlReceiveByte = 0
    mlReceivePacket = 0
    lTime_Max = 0
    lTime_Min = 1000
    
    txtSendByte.Text = "0"
    txtSendPacket.Text = "0"
    txtReceiveByte.Text = "0"
    txtReceivePacket.Text = "0"
    txtDiffPercent.Text = "0.00 %"
    txtDiffPacket.Text = "0"
    txtTimeMax.Text = "0"
    txtTimeMin.Text = "1000"
End Sub

Private Sub cmdClose_Click()
    Timer1.Enabled = False
    cmdConnect.Enabled = True
    cmdClose.Enabled = False
    cmdSend.Enabled = False
    cmdStartPolling.Enabled = False
    cmdStopPolling.Enabled = False
    cmdStartTimer.Enabled = False
    cmdStopTimer.Enabled = False
    Winsock1.Close
    
    If chkDataLog.Value = vbChecked Then
        chkDataLog.Value = vbUnchecked
    End If
End Sub

Private Sub cmdConnect_Click()
    On Error GoTo CreatError
    Winsock1.RemoteHost = ServeripText.Text
    Winsock1.RemotePort = ServerPortText.Text
    Winsock1.Connect
    Exit Sub
    
CreatError:
    bFileIsReady = False
End Sub

Private Sub CmdEXIT_Click()
    Winsock1.Close
    Unload Me
End Sub

Private Sub cmdSend_Click()
    Dim i As Integer
    Dim cAscii As Byte
    Dim sTemp As String
    Dim iSpace As Integer
    Dim iCount As Integer
    Dim bytBinary() As Byte
    
    If Winsock1.State = sckConnected Then
        sTemp = txtString.Text
        i = 0
        While sTemp <> ""
            sTemp = LTrim(sTemp)    'Trim the space
            iSpace = InStr(1, sTemp, " ")
            If iSpace = 0 And sTemp <> "" Then
                iSpace = Len(sTemp)
            End If
            sTemp = Right(sTemp, Len(sTemp) - iSpace)
            iCount = iCount + 1

        Wend
        ReDim bytBinary(0 To iCount - 1)    'iCount-1 is the byte-count of the command,
                                           
        sTemp = txtString.Text
        For i = 0 To iCount - 1
            sTemp = LTrim(sTemp)    'Trim the space
            iSpace = InStr(1, sTemp, " ")
            'Last data (without space char)
            If iSpace = 0 And sTemp <> "" Then
                iSpace = Len(sTemp)
                bytBinary(i) = CInt("&H" & sTemp)
            Else
                bytBinary(i) = CInt("&H" & Left(sTemp, iSpace - 1))
            End If
            sTemp = Right(sTemp, Len(sTemp) - iSpace)
        Next i
        
        mlSendByte = mlSendByte + iCount
        mlSendPacket = mlSendPacket + 1
        txtSendByte.Text = mlSendByte
        txtSendPacket.Text = mlSendPacket
        
        txtDiffPacket.Text = mlSendPacket - mlReceivePacket
        txtDiffPercent.Text = Format((mlSendPacket - mlReceivePacket) / mlSendPacket, "0.00 " & "%")
        
        For i = 0 To iCount - 1
            'The 8th number is the FC n
            If i = 6 Then
                sTemp = sTemp & "--> "
            End If
            sTemp = sTemp & Right("0" & Hex(bytBinary(i)), 2) & " "
        Next i
        Call ShowTipText(bytBinary(7))
        If lstSend.ListCount > 2000 Then
            Call CmdClear_Click
        End If
            
        If mbPolling = True Then
            lTime_1 = GetTickCount
        Else
            lstSend.AddItem sTemp
            lstSend.ListIndex = lstSend.ListCount - 1
            If bFileIsReady Then
                Print #1, Now & " >>>> " & sTemp;
            End If
        End If
        Winsock1.SendData bytBinary
        DoEvents
    Else
        MsgBox "Not currently connected"
    End If
End Sub

Private Sub cmdSetInterval_Click()
    Timer1.Interval = CInt(txtInterval.Text)
End Sub

Private Sub cmdStopPolling_Click()
    mbPolling = False
    txtTimeAverage.Text = Format((GetTickCount - lStartTime) / Val(txtReceivePacket.Text), "000.0")
    txtStopTime.Text = Now
    cmdStartPolling.Enabled = True
    cmdStopPolling.Enabled = False
End Sub

Private Sub cmdStopTimer_Click()
    Timer1.Enabled = False
    cmdStartTimer.Enabled = True
    cmdStopTimer.Enabled = False
    txtStopTime.Text = Time
End Sub

Private Sub Form_Load()
    Caption = "MBTCP  Ver. " & App.Major & "." & App.Minor & "." & App.Revision
    cmdConnect.Enabled = True
    cmdClose.Enabled = False
    cmdSend.Enabled = False
    cmdStartPolling.Enabled = False
    cmdStopPolling.Enabled = False
    With cboFunction
        .AddItem "FC1  Read multiple coils status (0xxxx)  for DO"
        .AddItem "FC2  Read multiple input discretes (1xxxx)  for DI"
        .AddItem "FC3  Read multiple registers (4xxxx)  for AO"
        .AddItem "FC4  Read multiple input registers (3xxxx)  for AI"
        .AddItem "FC5  Write single coil (0xxxx)  for DO"
        .AddItem "FC6  Write single register (4xxxx)  for AO"
        .AddItem "FC15 Force multiple coils (0xxxx)  for DO"
        .AddItem "FC16 Write multiple registers (4xxxx)  for AO"
        .ListIndex = 0
    End With
    Call ShowTipText(1)
End Sub

Private Sub txtsend_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        KeyAscii = 0
        cmdSend_Click
    End If
End Sub




Private Sub Timer1_Timer()
    Call cmdSend_Click
End Sub

Private Sub txtString_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Call cmdSend_Click
    End If
End Sub

Private Sub Winsock1_Close()
    While Winsock1.State = sckClosing
        DoEvents
    Wend
    MsgBox ("Connection is closed.")
End Sub

' Connect event fired when the client connects
Private Sub Winsock1_Connect()
    Dim vtdata As Variant
  
    If Winsock1.State = sckConnected Then
        cmdConnect.Enabled = False
        cmdSend.Enabled = True
        cmdStartPolling.Enabled = True
        cmdClose.Enabled = True
        cmdStartTimer.Enabled = True
        cmdClearStatistic_Click
    End If
End Sub

' DataArrival event is fired when the Winsock1 receive data
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim bytBuf() As Byte
    Dim i As Integer
    Dim sTemp As String

    ReDim bytBuf(bytesTotal - 1)
    
    Winsock1.GetData bytBuf, vbByte + vbArray
    
    If mbPolling = True Then
        lTime_2 = GetTickCount
        If (lTime_2 - lTime_1) > lTime_Max Then
            lTime_Max = lTime_2 - lTime_1
            txtTimeMax.Text = lTime_Max
        End If
        If (lTime_2 - lTime_1) < lTime_Min Then
            lTime_Min = lTime_2 - lTime_1
            txtTimeMin.Text = lTime_Min
        End If
    Else
        For i = 0 To bytesTotal - 1
            'The 8th number is the FC n
            If i = 6 Then
                sTemp = sTemp & "--> "
            End If
            If (i > 6) And ((i - 5) Mod 12 = 1) Then
                lstReceive.AddItem sTemp
                sTemp = Space(35)
            End If
            sTemp = sTemp & Right("0" & Hex(bytBuf(i)), 2) & " "
        Next i
        lstReceive.AddItem sTemp
        If bFileIsReady Then
            Print #1, " <<<< " & sTemp
        End If
    End If
    
    mlReceiveByte = mlReceiveByte + bytesTotal
    mlReceivePacket = mlReceivePacket + 1
    txtReceiveByte.Text = mlReceiveByte
    txtReceivePacket.Text = mlReceivePacket
    
    txtDiffPacket.Text = mlSendPacket - mlReceivePacket
    txtDiffPercent.Text = Format((mlSendPacket - mlReceivePacket) / mlSendPacket, "0.00 " & "%")

    
    lstReceive.ListIndex = lstReceive.ListCount - 1
    DoEvents
    If mbPolling = True Then
        Call cmdSend_Click
    End If
End Sub

Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    If Winsock1.State <> sckConnected Then
        MsgBox (Description)
        'Call cmdClose_Click
    End If
End Sub

Private Sub ShowTipText(ByVal iFC As Integer)
    Dim i As Integer
    
    lbCommand(0).ToolTipText = " Net ID (station number) "
    lbCommand(1).ToolTipText = " FC=" & iFC & ") "
    lbCommand(2).ToolTipText = " Reference number (high byte) "
    lbCommand(3).ToolTipText = " Reference number (low byte) "
    For i = 4 To lbCommand.Count - 1
        lbCommand(i).Visible = False
    Next i
    
    lbResponse(0).ToolTipText = " Net ID (station number) "
    lbResponse(1).ToolTipText = " FC=" & iFC & ") "
    For i = 2 To lbResponse.Count - 1
        lbResponse(i).Visible = False
    Next i
    
    Select Case iFC
        Case 1, 2
            For i = 4 To 5
                lbCommand(i).Visible = True
            Next i
            lbCommand(4).ToolTipText = " Bit count (high byte) "
            lbCommand(5).ToolTipText = " Bit count (low byte) "
            
            For i = 2 To 3
                lbResponse(i).Visible = True
            Next i
         
            lbResponse(2).ToolTipText = " Byte count of response (B=(bit count + 7)/8) "
            lbResponse(3).ToolTipText = " Byte 3-(B+2): Bit values (least significant is first coil!) "
            
        Case 3, 4
            For i = 4 To 5
                lbCommand(i).Visible = True
            Next i
            lbCommand(4).ToolTipText = " Word count (high byte) "
            lbCommand(5).ToolTipText = " Word count (low byte) "
            
            For i = 2 To 3
                lbResponse(i).Visible = True
            Next i
         
            lbResponse(2).ToolTipText = " Byte count of response (B=2 x word count) "
            lbResponse(3).ToolTipText = " Byte 3-(B+2): Register values "
            
        Case 5
            For i = 4 To 5
                lbCommand(i).Visible = True
            Next i
            lbCommand(4).ToolTipText = " =FF to turn ON coil, =00 to turn OFF coil "
            lbCommand(5).ToolTipText = " 00 "
            
            For i = 2 To 5
                lbResponse(i).Visible = True
            Next i
         
            lbResponse(2).ToolTipText = " Reference number (high byte) "
            lbResponse(3).ToolTipText = " Reference number (low byte) "
            lbResponse(4).ToolTipText = " =FF to turn ON coil, =00 to turn OFF coil "
            lbResponse(5).ToolTipText = " 00 "
            
        Case 6
            For i = 4 To 5
                lbCommand(i).Visible = True
            Next i
            lbCommand(4).ToolTipText = " Register value (high byte) "
            lbCommand(5).ToolTipText = " Register value (low byte) "

            For i = 2 To 5
                lbResponse(i).Visible = True
            Next i
         
            lbResponse(2).ToolTipText = " Reference number (high byte) "
            lbResponse(3).ToolTipText = " Reference number (low byte) "
            lbResponse(4).ToolTipText = " Register value (high byte) "
            lbResponse(5).ToolTipText = " Register value (low byte) "
            
        Case 15
            For i = 4 To 7
                lbCommand(i).Visible = True
            Next i
            lbCommand(4).ToolTipText = " Bit count (high byte) "
            lbCommand(5).ToolTipText = " Bit count (low byte) "
            lbCommand(6).ToolTipText = " Byte count of response (B=(bit count + 7)/8) "
            lbCommand(7).ToolTipText = " Byte 7-(B+6): Data to be written (least significant is first coil!) "
            
            For i = 2 To 5
                lbResponse(i).Visible = True
            Next i
         
            lbResponse(2).ToolTipText = " Reference number (high byte) "
            lbResponse(3).ToolTipText = " Reference number (low byte) "
            lbResponse(4).ToolTipText = " Bit count (high byte) "
            lbResponse(5).ToolTipText = " Bit count (low byte) "
            
        Case 16
            For i = 4 To 7
                lbCommand(i).Visible = True
            Next i
            lbCommand(2).ToolTipText = " Reference number (high byte) "
            lbCommand(3).ToolTipText = " Reference number (low byte) "
            lbCommand(4).ToolTipText = " Word count (high byte) "
            lbCommand(5).ToolTipText = " Word count (low byte) "
            lbCommand(6).ToolTipText = " Byte count (B=2 x word count) "
            lbCommand(7).ToolTipText = " Byte 7-(B+6): Register values "
            
            For i = 2 To 5
                lbResponse(i).Visible = True
            Next i
         
            lbResponse(2).ToolTipText = " Reference number (high byte) "
            lbResponse(3).ToolTipText = " Reference number (low byte) "
            lbResponse(4).ToolTipText = " Word count (high byte) "
            lbResponse(5).ToolTipText = " Word count (low byte) "
    End Select
End Sub