laatzen/Pruef2000/source/CFM85P.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CFM85P"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'==============================================================================
'
' File   : CFM85P
' Author : Andreas Schmidt
' Date   : 27.01.1999
' Version: 0.01
'
'==============================================================================
'
' History:
'
' Author : Andreas Schmidt
' Date   : 27.01.1999
' Version: 0.01
'
' Erste Version mit rh.
'
'==============================================================================

Option Explicit

' Parent jedes FM85P-Objekts ist der CFMBus
Private m_FMBus As CFMBus

' Adresse dieses FM85P im FM-BUS
Private m_Address As Integer

' Letzter Fehlercode des FM85P
Private m_nError As Integer

' Letzte Antwort des FM85P
Private m_sAnswer

' Maximale Wartezeit auf eine Antwort
Const DEFAULT_TIMEOUT = 1100

'
' FM85P neu initialisieren, evtl. gespeicherten Fehlercode
' zurücksetzen etc.
'
Public Function Reset()
    ' TODO: FM ansprechen, resetten. Nur true zurückgeben,
    ' wenn hardware-reset erfolgreich war
    
    clearStateMembers
    
    Reset = True
End Function

'
' Objektmember, die über den Zustand der letzten
' Kommunikation Auskunft geben, zurücksetzen.
'
Private Sub clearStateMembers()
    m_nError = 0
    m_sAnswer = ""
End Sub


'
' @param FMBus      Bus, dem der FM85P zugeordnet ist
'
Public Sub setFMBus(FMBus As CFMBus)
    Set m_FMBus = FMBus
End Sub


'
' @param nAdresse   Adresse des FM85P im Bus
'
Public Sub setAdress(nAdress As Integer)
    m_Address = nAdress
End Sub

'
' @return Adresse des FM85P
'
Public Function getAdress() As Integer
    getAdress = m_Address
End Function

'
' Liegt ein Fehler vor?
'
' @return   true  = Fehler liegt vor, Fehlerbeschreibung kann
'                   mit getErrorCode/getErrorDesc eingeholt
'                   werden
'           false = alles OK
'
Public Function hasError() As Boolean
    hasError = (m_nError <> 0)
End Function

'
' @return   Interner Code des letzten Fehlers
'           (siehe modFM85P.bas)
'
Public Function getErrorCode() As Integer
    getErrorCode = m_nError
End Function

'
' @return Erläuterung zu dem letzten Fehler
'
Public Function getErrorDesc() As String
    Select Case m_nError
        Case FM85P_ERR_TIMEOUT:
            getErrorDesc = FM85P_ERR_TIMEOUT_D
        Case FM85P_ERR_UNKNOWNANSWER:
            getErrorDesc = FM85P_ERR_UNKNOWNANSWER_D + " (" + m_sAnswer + ")"
        Case FM85P_ERR_NOANSWER:
            getErrorDesc = FM85P_ERR_NOANSWER_D
        Case FM85P_ERR_BUS:
            getErrorDesc = FM85P_ERR_BUS_D
        Case Default
            getErrorDesc = ""
    End Select
End Function

'
' FM85P ansprechen
'
' @return   true  = OK,
'           false = Fehler beim Senden oder keine Antwort erhalten
'
Public Function sendAttention() As Boolean
    Dim nAddress As Integer
    clearStateMembers
    nAddress = getAdress()
    
    If nAddress = 0 Then
        Stop
    End If
        
    
    If Not m_FMBus.send("**" & nAddress & "@") Then
        m_nError = FM85P_ERR_BUS
        Exit Function
    End If
    
    ' zuletzt angesprochenen Zähler merken
    m_FMBus.SetLastFM (nAddress)
    
    
    m_sAnswer = m_FMBus.receive(DEFAULT_TIMEOUT)
    
    If m_FMBus.getErrorCode() <> 0 Then
        m_nError = FM85P_ERR_BUS
        Exit Function
    End If

    If Left$(m_sAnswer, 6) = "*FM85P" Or Left$(m_sAnswer, 7) = "*FM2014" Then
        sendAttention = True
    ElseIf Left$(m_sAnswer, 8) = " TIMEOUT" Then
        m_nError = FM85P_ERR_TIMEOUT
    ElseIf InStr(1, m_sAnswer, Hex(nAddress)) > 0 Then
        sendAttention = True
    ElseIf m_sAnswer <> "" Then
        m_nError = FM85P_ERR_UNKNOWNANSWER
    Else
        m_nError = FM85P_ERR_NOANSWER
    End If
End Function

'
'Daten an FM85P senden
'
'@return   true  = OK,
'          false = Fehler beim Senden
'
Public Function send(data As String) As Boolean
   send = True
   Dim nAddress As Integer
   
   If m_Address <> m_FMBus.GetLastFM Then
   ' Todo:
    If sendAttention() Then
    Else
    End If
   End If
          
   clearStateMembers
   If Not m_FMBus.send(data) Then
      m_nError = FM85P_ERR_BUS
      send = False
      Exit Function
   End If
End Function

'
' @return letzte Antwort des FM85P
'
Public Function getLastAnswer()
   getLastAnswer = m_sAnswer
End Function

'
'
' @ return  true  =  OK
'           false =  keine Antwort oder Timeout bekommen
'
Public Function receive()
    m_sAnswer = m_FMBus.receive(DEFAULT_TIMEOUT)
    If m_FMBus.getErrorCode() <> 0 Then
        m_nError = FM85P_ERR_BUS
        Exit Function
    End If
    If Left$(m_sAnswer, 8) = " TIMEOUT" Then
        m_nError = FM85P_ERR_TIMEOUT
        Exit Function
    Else
        If m_sAnswer = "" Then
            m_nError = FM85P_ERR_NOANSWER
            Exit Function
        Else
            receive = True
        End If
    End If
End Function


' sendet einen String zum FM85 und gibt die Antwort zurück
Public Function dialog(data)
send (data)
If receive() Then
    dialog = getLastAnswer()
Else
    dialog = ""
End If
End Function