frmmain.frm

RS485服务器程序,实现设置Nodes,检测Nodes以及传输数据

Sub DisableTransmitter()
'Set RTS true (high) to disable the RS485 transmitter
'by bringing its chip-enable low.
'Assumes that a second RS-232 receiver inverts RTS.
MSComm1.RTSEnable = True
End Sub

Sub EnableTransmitter(EnableDelay As Single)
'Set RTS false (low) to enable the RS485 transmitter.
'Assumes that a second RS-232 receiver has inverted RTS.
'Delay in milliseconds allows remote node to disable its transmitter.
Call Delay(EnableDelay)
MSComm1.RTSEnable = False
'Windows delay:
Call Delay(RTSDelay)
End Sub

Private Sub Form_Load()
Show
Call GetSettings
Call Startup
Load frmPortSettings
Load frmNodes
TransferInProgress = False
tmrTimeout.Interval = ReplyDelay
tmrTransferInterval.Enabled = False
tmrTimeout.Enabled = False
TimedOut = False
Call InitializeDisplayElements
SaveDataInFile = False
Call InitializeNodes
Call GetNewNodeSettings
'The master's transmitter is enabled,
'except when receiving replies.
Call EnableTransmitter(0)
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call ShutDown
Unload frmNodes
Unload frmDataFile
Unload frmPortSettings
Close #2
End
End Sub

Private Sub GetDataToSend(NodeNumber As Integer)
'Dummy data for testing: the current hour and minute.
Dim CurrentTime As String
CurrentTime = CStr(Format(Time, "nnss"))
Nodes.DataOut1(NodeNumber) = Val(Left(CurrentTime, 2))
Nodes.DataOut2(NodeNumber) = Val(Right(CurrentTime, 2))
End Sub

Public Sub GetNewNodeSettings()
'Store user changes made on the Nodes form.
Dim Count As Integer
    Nodes.Address(0) = CInt("&h" & frmNodes.cboAddress(0).Text)
For Count = 1 To 7
    Nodes.Cpu(Count) = frmNodes.cboCPU(Count).Text
    Nodes.Address(Count) = CInt("&h" & frmNodes.cboAddress(Count).Text)
    Nodes.Active(Count) = frmNodes.chkNodeActive(Count).Value
Next Count
End Sub

Private Sub InitializeDisplayElements()
optSingleOrContinuous(0).Value = True
optIntervalUnits(0).Value = True
cboIntervalValue.ListIndex = 0
rtxStatus.Locked = True
rtxStatus.Text = ""
DataTransferFormat.IntervalValue = 1
cmdStop.Enabled = False
End Sub

Private Sub InitializeNodes()
Dim Count As Integer
For Count = 0 To HighestNodeNumber
    Nodes.DataIn1(Count) = 0
    Nodes.DataIn2(Count) = 0
    Nodes.Status(Count) = ""
    Nodes.LastAccess(Count) = ""
    Nodes.Cpu(Count) = ""
Next Count
Call UpdateDisplay
End Sub

Private Sub mnuDataFile_Click(Index As Integer)
frmDataFile.Show
End Sub

Private Sub mnuNodes_Click(Index As Integer)
frmNodes.Show
End Sub

Private Sub mnuPortSettings_Click(Index As Integer)
frmPortSettings.Show
End Sub

Private Sub MSComm1_OnComm()
'Handles all Comm events
Dim ErrorMessage As String
Select Case MSComm1.CommEvent
    'Handle each event or error by placing
    'code below each case statement
    
    'Errors
    Case comEventBreak
        ErrorMessage = "A Break was received."
    Case comEventCDTO
        ErrorMessage = "CD (RLSD) Timeout."
    Case comEventCTSTO
        ErrorMessage = "CTS Timeout."
    Case comEventDSRTO
        ErrorMessage = "DSR Timeout."
    Case comEventFrame
        ErrorMessage = "Framing Error"
    Case comEventOverrun
        ErrorMessage = "Overrun; data Lost."
    Case comEventRxOver
        ErrorMessage = "Receive buffer overflow."
    Case comEventRxParity
        ErrorMessage = "Parity Error."
     Case comEventTxFull
        ErrorMessage = "Transmit buffer full."
     Case comEventDCB
        ErrorMessage = "Unexpected error retrieving DCB."

    ' Events
    Case comEvCD
        ErrorMessage = "Change in the CD line."
    Case comEvCTS
        ErrorMessage = "Change in the CTS line."
    Case comEvDSR
        ErrorMessage = "Change in the DSR line."
    Case comEvRing
        ErrorMessage = "Change in the RI line."
     Case comEvReceive
        ErrorMessage = "Receive buffer has RThreshold number of characters."
     Case comEvSend
        ErrorMessage = "Transmit buffer has SThreshold number of characters."
     Case comEvEOF
        ErrorMessage = "EOF character (1Ah) received."
End Select
'Use for debuggging:
'Debug.Print ErrorMessage
End Sub

Private Sub optIntervalUnits_Click(Index As Integer)
'Set the interval combo box to match the units selected.
Dim Maximum As Integer
Dim Count As Integer
Select Case Index
    Case 0
        Maximum = 59
        DataTransferFormat.IntervalUnits = "seconds"
    Case 1
        Maximum = 59
        DataTransferFormat.IntervalUnits = "minutes"
    Case 2
        Maximum = 24
        DataTransferFormat.IntervalUnits = "hours"
End Select
cboIntervalValue.Clear
For Count = 1 To Maximum
    cboIntervalValue.AddItem CStr(Count)
Next Count
cboIntervalValue.ListIndex = 0
End Sub

Private Sub optPollUnits_Click(Index As Integer)
'Set the combo box items to match the units selected.
Dim Maximum As Integer
Dim Count%
Select Case Index
    Case 0, 1
        'seconds, minutes
        Maximum = 59
    Case 2
        'hours
        Maximum = 24
End Select
End Sub

Private Sub optSingleOrContinuous_Click(Index As Integer)
Select Case Index
    Case 0
        DataTransferFormat.SingleOrContinuous = "single"
        'Disable interval selection:
        optIntervalUnits(0).Enabled = False
        optIntervalUnits(1).Enabled = False
        optIntervalUnits(2).Enabled = False
    Case 1
        DataTransferFormat.SingleOrContinuous = "continuous"
        'Enable interval selection:
        optIntervalUnits(0).Enabled = True
        optIntervalUnits(1).Enabled = True
        optIntervalUnits(2).Enabled = True
End Select
End Sub

Private Sub PollSlave()
'Send the node address & wait for Acknowledge.
'If Ack received, send data, wait for reply.
'Store the results.
Dim AckReceived As Boolean
Dim ReplyReceived As Boolean
Dim NumberOfTries As Integer
Dim LastNode As Integer
Dim Count As Integer
Dim MessageToSend As Variant
Dim AttemptNumber As Integer
Dim TransmitFinished As Boolean
Dim Buffer As Variant
TransferInProgress = True
For Count = 1 To HighestNodeNumber
'Skip the node if it isn't selected (Active) on the Nodes form.
    If Nodes.Active(Count) = 1 Then
        'Clear the transmit and receive buffers
        MSComm1.OutBufferCount = 0
        If MSComm1.InBufferCount > 0 Then
            Buffer = MSComm1.Input
        End If
        'Create the message from the stored values.
        MessageToSend = fncCreateMessage(Count)
        'Store the time of the poll.
        Nodes.LastAccess(Count) = fncDisplayDateAndTime
        'Send the node address as a text character.
        Buffer = Chr(Nodes.Address(Count))
        'For Stamp and other slaves without input buffers,
        'poll more than once if needed.
        Select Case Nodes.Cpu(Count)
            Case "PC"
                NumberOfTries = 1
            Case "Stamp"
                NumberOfTries = 2
        End Select
        AttemptNumber = 0
        Do
            MSComm1.Output = Buffer
            'Wait for the data to transmit
            Select Case fncConfirmTransmittedData(Buffer)
                Case -1
                    'If success, wait for Acknowledge.
                    AckReceived = fncWaitForAck(Count)
                Case 0
                    Nodes.Status(Count) = "Transmit error"
                Case 1
                    Nodes.Status(Count) = "Ack Timeout"
            End Select
            AttemptNumber = AttemptNumber + 1
        Loop Until AckReceived = True Or AttemptNumber = NumberOfTries
        If AckReceived = True Then
            MSComm1.Output = MessageToSend
            'Delay to let the data transmit
            Select Case fncConfirmTransmittedData(MessageToSend)
                Case -1
                    'Data has transmitted.
                    'Wait for the slave's reply.
                    ReplyReceived = fncWaitForReply(Count)
                Case Else
                    Nodes.Status(Count) = "Transmit error"
            End Select
        End If
        Call UpdateDisplay
    End If
Next Count
If SaveDataInFile = True Then
    Call WriteResultsToFile
End If
TransferInProgress = False
End Sub

Private Sub SaveResults _
    (NodeNumber As Integer, _
    Data1 As Byte, _
    Data2 As Byte, _
    ResultStatus As String)
    Nodes.DataIn1(NodeNumber) = Data1
    Nodes.DataIn2(NodeNumber) = Data2
    Nodes.Status(NodeNumber) = ResultStatus
End Sub

Private Sub WriteResultsToFile()
'Save received data and time in a file.
Dim Count As Integer
For Count = 1 To HighestNodeNumber
    'Skip if the node isn't selected (active) on the Nodes form.
    If Nodes.Active(Count) = 1 Then
        Write #2, _
            Count, _
            Nodes.LastAccess(Count), _
            Nodes.DataOut1(Count), _
            Nodes.DataOut2(Count), _
            Nodes.DataIn1(Count), _
            Nodes.DataIn2(Count), _
            Nodes.Status(Count)
    End If
Next Count
End Sub

Private Sub tmrTransferInterval_Timer()
'See if it's time to do a transfer.
Dim CurrentTime As Date
Dim Units As String
CurrentTime = Now
Select Case DataTransferFormat.IntervalUnits
    Case "seconds"
        Units = "s"
    Case "minutes"
        Units = "n"
    Case "hours"
        Units = "h"
End Select
'If elapsed time since the last transfer is more than
'the selected interval, do a data transfer.
If DateDiff(Units, PreviousTime, CurrentTime) >= _
        DataTransferFormat.IntervalValue Then
    PreviousTime = CurrentTime
    'But don't start a new transfer if one is in progress.
    If TransferInProgress = False Then
        Call PollSlave
    End If
End If
End Sub

Private Sub tmrTimeout_Timer()
tmrTimeout.Enabled = False
TimedOut = True
End Sub

Private Sub UpdateDisplay()
'Show the latest information for all nodes
Dim Column As Integer
Dim DataIn1Display As String
Dim DataIn2Display As String
Dim Count As Integer
'Set up 5 columns
With rtxStatus
        .SelTabCount = 5
        For Column = 0 To .SelTabCount - 1
            .SelTabs(Column) = 1000 * Column
        Next Column
    End With
rtxStatus.Text = "Node #" & Chr(vbKeyTab) _
    & "Data out" & Chr(vbKeyTab) _
    & "Data in" & Chr(vbKeyTab) _
    & "Status" & Chr(vbKeyTab) _
    & "Last Access" & vbCrLf
For Count = 1 To HighestNodeNumber
    'Skip if the node isn't selected (active) on the Nodes form.
    If Nodes.Active(Count) = 1 Then
    Select Case Nodes.Status(Count)
           Case "OK"
                DataIn1Display = _
                    fncByteToAsciiHex(Nodes.DataIn1(Count))
                DataIn2Display = _
                    fncByteToAsciiHex(Nodes.DataIn2(Count))
           Case Else
                DataIn1Display = ""
                DataIn2Display = ""
        End Select
        rtxStatus.SelStart = Len(rtxStatus.Text)
        rtxStatus.SelText = _
             Hex$(Count) & Chr(vbKeyTab) _
            & fncByteToAsciiHex(Nodes.DataOut1(Count)) & "   " _
            & fncByteToAsciiHex(Nodes.DataOut2(Count)) & Chr(vbKeyTab) _
            & DataIn1Display & "  " & DataIn2Display & Chr(vbKeyTab) _
            & Nodes.Status(Count) & Chr(vbKeyTab) _
            & Nodes.LastAccess(Count) & vbCrLf
    End If
Next Count
End Sub

Public Function fncInitializeComPort _
    (BitRate As Long, PortNumber As Integer) As Boolean
'BitRate and PortNumber are passed to this routine.
'All other properties are set explicitly in the code.
Dim ComSettings As String
If MSComm1.PortOpen = True Then
    MSComm1.PortOpen = False
End If
ComSettings = CStr(BitRate) & ",N,8,1"
MSComm1.CommPort = PortNumber
' bit rate, no parity, 8 data, and 1 stop bit.
MSComm1.Settings = ComSettings
'Set to 0 to read entire buffer on Input
MSComm1.InputLen = 0
MSComm1.InBufferSize = 256
'Input and output data are text.
MSComm1.InputMode = comInputModeText
'MSComm does no handshaking.
MSComm1.Handshaking = comNone
MSComm1.OutBufferSize = 256
MSComm1.EOFEnable = False
'No OnComm event on received data.
MSComm1.RThreshold = 0
'No OnComm transmit event.
MSComm1.SThreshold = 0
MSComm1.PortOpen = True
OneByteDelay = fncOneByteDelay(BitRate)
End Function