VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CSPS"
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"
Option Explicit
'==============================================================================
'
' File   : m_SPS.cls
' Date   : 06.04.1999
' Version: 1.00
' Author : Andreas Schmidt, lindner&partner
'
'==============================================================================
'
' Abstraktion der SPS
'
'==============================================================================
'
' History:
'
' Date   : 06.04.1999
' Version: 1.00
' Author : Andreas Schmidt, lindner&partner
'
' Erste dokumentierte Version.
'
'==============================================================================
' Author : Reinhard Henning, lindner&partner

'################################################################################

' Status Bits der Pruefung
Private Const VORWAHL_BETRIEBSART = "PT_BetrArt"
Private Const VORWAHL_HAND = 1
Private Const VORWAHL_AUTO = 2
Private Const VORWAHL_REFERENZ = 4

' Wird wohl nicht mehr benotigt
'Private Const VORWAHL_PRUEFUNG = "PT_Pruefung"
'Private Const VORWAHL_WECHSELPRUEFUNG = 1
'Private Const VORWAHL_REIHENPRUEFUNG = 2

' Status Bits der Strecke
' Achtung umbenannt:
Private Const STATUS_STRECKE = "PT_Strecke1"
Private Const STATUS_STRECKE_VORGEWAEHLT = 1
Private Const STATUS_STRECKE_GESPANNT = 2
Private Const STATUS_STRECKE_GEFUELLT = 4
Private Const STATUS_STRECKE_PRUEFBEREIT = 8

' Status Bits der Pumpen
Private Const STATUS_PUMPE1 = "PT_P1Status"
Private Const STATUS_PUMPE2 = "PT_P2Status"
Private Const STATUS_PUMPE3 = "PT_P3Status"
Private Const STATUS_PUMPE5 = "PT_P5Status"

Private Const STATUS_PUMPE_ANGEWAEHLT = 1
Private Const STATUS_PUMPE_STEHT = 2
Private Const STATUS_PUMPE_LAEUFT = 3
Private Const STATUS_PUMPE_GESTOERT = 4

' Status Bits der Servos
Private Const STATUS_SERVO1 = "PT_M1Status"
Private Const STATUS_SERVO2 = "PT_M2Status"
Private Const STATUS_SERVO3 = "PT_M3Status"
Private Const STATUS_SERVO4 = "PT_M4Status"
Private Const STATUS_SERVO_ANGEWAEHLT = 1
Private Const STATUS_SERVO_STEHT = 2
Private Const STATUS_SERVO_LAEUFT = 4
Private Const STATUS_SERVO_GESTOERT = 8

' Wassertemperatur 0-100.0 C
Private Const Temperatur = "PT_T_"

Private Const EINLAUFTEMPERATUR = "PT_T_Einlauf"
Private Const Lufttemperatur = "PT_T_Luft"
Private Const RelativeFeuchte = "PT_RH_Luft"

Private Const DURCHFLUSS_BEREINIGT = "PT_QIst"

Private Const REGLER_INFORMATION = "PT_Regler"
Private Const SOLLDURCHFLUSS_ERREICHT = 1

' Status zur Prüfung
Private Const STATUS_PRUEFUNG = "PT_PrfStatus"
Private Const STATUS_PRUEFUNG_BEREIT = 1
Private Const STATUS_PRUEFUNG_STEHT = 2
Private Const STATUS_PRUEFUNG_LAEUFT = 4
Private Const STATUS_PRUEFUNG_GESTOERT = 8
Private Const STATUS_PRUEFUNG_BEHAELTER_VOLL = 16

Private Const VORWAHL = "VB_Betrieb"
Private Const VORWAHL_START = 1
Private Const VORWAHL_STOP = 2

Private Const VORWAHL_MID_GRUPPPE = "VB_MidGr"
Private Const VORWAHL_MID_GRUPPPE_A = 1
Private Const VORWAHL_MID_GRUPPPE_B = 2

Private Const ABLASS = "VB_Ablass"

Private Const VORWAHL_MID = "VB_MidNr"
Private Const VORWAHL_MID_02 = 16
Private Const VORWAHL_MID_2 = 8
Private Const VORWAHL_MID_8 = 4
Private Const VORWAHL_MID_32 = 2
Private Const VORWAHL_MID_125 = 1

Private Const VORWAHL_BEHAELTER = "VB_Behaelter"
Private Const VORWAHL_BEHAELTER_DURCHLAUF = 1
Private Const VORWAHL_BEHAELTER_KLEIN = 2
Private Const VORWAHL_BEHAELTER_GROSS = 4

Private Const PUMPE1 = "VB_Pumpe1"
Private Const PUMPE2 = "VB_Pumpe2"
Private Const PUMPE3 = "VB_Pumpe3"

Private Const PUMPE5 = "VB_Pumpe5"  'Hochbehälter


Private Const PUMPE_ANWAEHLEN = 1
Private Const PUMPE_STOP = 2
Private Const PUMPE_START = 4

Private Const DURCHFLUSS_SOLL = "VB_QSoll"  ' 0 - 300qm/h

Private Const VORWAHL_NUR_MESSEINSAETZE = "VB_Einsatz"
Private Const VORWAHL_NUR_MESSEINSAETZE_STRECKE1 = 1

Private Const REGULIERUNG_MOTOR = "VB_ReguMotor"
Private Const REGULIERUNG_SOLL = "VB_Regu"
'Todo: "VBQDiff" Wofür ?

' Betrieb
Private Const BETRIEB = "VB_Betrieb"
Private Const BETRIEB_VORBEREITEN = 1
Private Const BETRIEB_START = 2
Private Const BETRIEB_ENDE = 4

' Regelart
Private Const REGEL_ART = "VB_RegelArt"
Private Const REGELART_SERVO = 2
Private Const REGELART_FU = 1

' Servo
Private Const SERVO_STELLUNG = "VB_ServoSt"
Private Const FU_STELLWERT_IST = "PT_FU_Ist"
Private Const SERVO_M4_POSITION_IST = "PT_M4_Ist"
Private Const SERVO_M3_POSITION_IST = "PT_M3_Ist"
Private Const SERVO_M2_POSITION_IST = "PT_M2_Ist"
Private Const SERVO_M1_POSITION_IST = "PT_M1_Ist"


' Grenzwert der Waage
Private Const WAAGEN_GRENZWERT = "PT_WAAGE"
Private Const WAAGEN_GRENZWERT_ERREICHT = 1

Private Const SPS_BEENDEN = "VB_Ende"

Private Const DURCHFLUSSDIFF = "VB_QDiff"   ' 0-100,00%


' Fuellstand
Private Const FUELLSTAND1 = "PT_Fuell1"
Private Const FUELLSTAND2 = "PT_Fuell2"

'Lichtwellenleiter
Private Const LICHTWELLENLEITER = "VB_Lwl"


' Member
' --------------
Public m_nStrang As Integer
Public m_bInitialized As Boolean

Public ProToolObj As CProTool
Private hProTool As Variant

Public m_TestModus As Boolean
Public m_FuellstandLeer As Double

Public OpcServer As CopcSps


Private m_ArtVerbindung As ENUMVERBINDUNG

Private Enum ENUMVERBINDUNG
    keine = 0
    Protool = 1
    Prodave = 2
    OPC = 3
End Enum
    

'################################################################################
' eigene Initialisierung
Private Function init() As Boolean
    init = True
Exit Function
init_fehler:
    init = False
End Function

Private Function ProdaveVariableSchreiben(strVarname As String, varWert As Variant) As Boolean
    On Error GoTo Errorhandler

    Dim VarDataType As EnumProdaveDATATYPE
    Dim StartNr As Integer
    Dim DatType As Byte
    Dim BufLen As Long
    Dim pWriteBuffer(1024) As Byte
    Dim Amount As Long
    Dim MyHex As String
    Dim sngWert As Single
    Dim bytBausteinNr As Byte
    Dim Fieldtype As Byte
   
    If Not GetVariablenAdrTypeDb(strVarname, StartNr, VarDataType, bytBausteinNr) Then
        WriteToLog "Prodave " & strVarname & " Variable unbekannt."
        Exit Function
    End If
    
    Select Case VarDataType
        Case EnumProdaveDATATYPE.TypeByte
            ' 1 BYTE
            BufLen = 8
            DatType = 2
            Amount = 1
            pWriteBuffer(0) = CByte(varWert)
            Fieldtype = Asc("d")
        Case EnumProdaveDATATYPE.TypeFloat
            ' FLOAT 4 Bytes
            DatType = 2
            BufLen = 4
            Amount = 4
            sngWert = CSng(varWert)
            Call SngToBuffer(sngWert, 0, pWriteBuffer)
            Fieldtype = Asc("d")
        Case Else
            MsgBox "ProdaveVariableSchreiben: Unbekannter Datentyp " & VarDataType
            Exit Function
    End Select
    
    'MyHex = db_write_ex6(mbyte_ProdaveBaustein, DatType, StartNr, Amount, BufLen, pWriteBuffer(0))
    
    MyHex = field_write_ex6(Fieldtype, bytBausteinNr, StartNr, Amount, BufLen, pWriteBuffer(0))

    ret = MyHex
    If ret = 0 Then
        ' OK
        ProdaveVariableSchreiben = True
        WriteToLog "Prodave schreibe " & strVarname & " = " & varWert
    Else
        Dim errorBuffer(256) As Byte
        Dim MyChar As String
        Dim strHex
        strHex = Hex(MyHex)
        ret = GetErrorMessage_ex6(ret, 256, errorBuffer(0))
        Call ByteToString(MyChar, errorBuffer, 200)
        If MyChar <> "" Then
            Call MsgBox("Prodave gibt diesen Fehler: " & MyChar & vbCrLf & "GGf. Pruef2000.exe neu starten.", vbOKOnly, "SPS/Prodave Fehler 0x" & strHex)
        Else
            MsgBox "Prodave db_write_ex6 - Fehler 0x" & strHex & " kann nicht ausgewertet werden weil Prodave datei error.dat fehlt."
        End If
    End If
Exit Function
Errorhandler:
    MsgBox "Fehler " & Err.Number & " in ProdaveVariableSchreiben(" & strVarname & "," & varWert & "): " & Err.Description
End Function


Private Function ProdaveVariableLesen(ByVal strVarname As String, ByRef varWert As Variant) As Boolean
        
    Dim StartNr As Integer
    Dim VarDataType As EnumProdaveDATATYPE
    Dim DatType As Byte
    Dim pDatLen As Long
    Dim MyHex As String
    Dim Amount As Long
    Dim sngWert As Single
    Dim byteWert As Byte
    Dim Fieldtype As Byte
    Dim bytBausteinNr As Byte
    
    
    Const BufLen = 4
    
    If Not GetVariablenAdrTypeDb(strVarname, StartNr, VarDataType, bytBausteinNr) Then
        Exit Function
    End If
    
    
    Dim pReadBuffer(BufLen) As Byte

    Select Case VarDataType
        Case EnumProdaveDATATYPE.TypeByte
            ' 1 BYTE
            DatType = 2
            Amount = 1
            Fieldtype = Asc("d")
        Case EnumProdaveDATATYPE.TypeFloat
            ' DWORD 4 Bytes
            DatType = 2
            Amount = 4
            Fieldtype = Asc("d")
        Case Else
            MsgBox "ProdaveVariableLesen: Unbekannter Datentyp " & VarDataType
            Exit Function
    End Select
        
    'MyHex = db_read_ex6(bytBausteinNr, DatType, StartNr, Amount, BufLen, pReadBuffer(0), pDatLen)
    
    MyHex = field_read_ex6(Fieldtype, bytBausteinNr, StartNr, Amount, BufLen, pReadBuffer(0), pDatLen)
    ret = Val(MyHex)
    
    If ret = 0 Then
        Select Case VarDataType
            Case EnumProdaveDATATYPE.TypeByte
                byteWert = pReadBuffer(0)
                ProdaveVariableLesen = True
                varWert = byteWert
            Case EnumProdaveDATATYPE.TypeFloat
                Call BufferToSng(pReadBuffer, 0, sngWert)
                varWert = sngWert
                ProdaveVariableLesen = True
            Case Else
                MsgBox "ProdaveVariableLesen: unbekannter Datentyp " & VarDataType
                Exit Function
        End Select
    Else
        Dim errorBuffer(256) As Byte
        Dim MyChar As String
        Dim strHex
        strHex = Hex(MyHex)
        ret = GetErrorMessage_ex6(ret, 256, errorBuffer(0))
        Call ByteToString(MyChar, errorBuffer, 200)
        If MyChar <> "" Then
            Call MsgBox(MyChar, vbOKOnly, "Fehler 0x" & strHex)
        Else
            MsgBox "Prodave db_read_ex6 - Fehler 0x" & strHex & " kann nicht ausgewertet werden weil Prodave datei error.dat fehlt."
        End If
    End If
    
Exit Function
Errorhandler:
    MsgBox "Fehler " & Err.Number & " in ProdaveVariableLesen('" & strVarname & "'): " & Err.Description
End Function


Public Sub SPSVariableSchreiben(strVarname As String, varWert As Variant)
    Select Case m_ArtVerbindung
        Case ENUMVERBINDUNG.Prodave
            ProdaveVariableSchreiben strVarname, varWert
        Case ENUMVERBINDUNG.Protool
            If Not ProToolObj Is Nothing Then
                Call ProToolObj.VarSchreiben(strVarname, varWert)
            Else
                MsgBox "ProToolObj Is Nothing"
                WriteToLog "ProToolObj Is Nothing"
            End If
        Case ENUMVERBINDUNG.OPC
                OpcServer.VarSchreiben strVarname, varWert
        Case ENUMVERBINDUNG.keine
            MsgBox "Keine Prodave- oder Protool-Verbindung zu einer SPS vorhanden. Variable " & strVarname & "=" & varWert
            WriteToLog "Keine Prodave- oder Protool-Verbindung zu einer SPS vorhanden. Variable " & strVarname & "=" & varWert
    End Select
End Sub

Public Function SPSVariableLesen(strVarname As String) As Variant
    On Error GoTo Errorhandler
    
    Dim varWert As Variant
        
    Select Case m_ArtVerbindung
        Case ENUMVERBINDUNG.Prodave
            If ProdaveVariableLesen(strVarname, varWert) Then
                SPSVariableLesen = varWert
                Debug.Print "Prodave lese " & strVarname & "=" & varWert
            Else
                LogIntoDB "Prodave Variable " & strVarname & " konnte nicht gelesen werden."
            End If
        Case ENUMVERBINDUNG.Protool
            If Not ProToolObj Is Nothing Then
                SPSVariableLesen = ProToolObj.VarLesen(strVarname)
            Else
                MsgBox "ProToolObj Is Nothing"
            End If
        Case ENUMVERBINDUNG.OPC
                SPSVariableLesen = OpcServer.VarLesen(strVarname)
        Case ENUMVERBINDUNG.keine
            ErrorMsg "Keine Prodave- oder Protool-Verbindung zu einer SPS vorhanden. Variable " & strVarname
    End Select
Exit Function
Errorhandler:
    LogIntoDB "Fehler " & Err.Number & " in SPSVariableLesen(" & strVarname & "): " & Err.Description
End Function


Public Function CheckAndInitProdave() As Boolean
    Dim Station As Byte
    Dim Slot As Byte
    Dim Rack As Byte
    Dim byte_ProdaveBaustein As Byte
    
    CheckAndInitProdave = False
nochmal:
    If g_App.Settings.GetProdaveSettings(Station, Slot, Rack) Then
        WriteToLog "Prodave Station " & Station & ", Slot " & Slot & ", Rack " & Rack
        
    Else
         If g_App.PruefstationNr = 2007 And g_App.Mitarbeiter.getNr = 10 Then
            If MsgBox("An der Prüfstation 2007 sind noch keine Prodave Settings in der Ini definiert. Möchten Sie diese jetzt in die INI schreiben?", vbYesNo Or vbDefaultButton2) = vbYes Then
                
                g_App.Settings.SetProdaveSettings 2, 2, 0
                modProdave6.CreateIniWerte
                GoTo nochmal
            End If
        End If
        Exit Function
    End If
    
    If modProdave6.connect(Station, Rack, Slot) Then
        CheckAndInitProdave = True
        m_ArtVerbindung = Prodave
    End If
    
End Function
Public Function initOpcServer() As Boolean
Set OpcServer = New CopcSps
OpcServer.init
m_ArtVerbindung = OPC

End Function


Public Function initProTool() As Boolean
Dim sProtoolStart As String
Dim oSettings As CSettings
On Error Resume Next

' Holt String zum Starten der ProTool Anwendung aus der ini Datei
sProtoolStart = g_App.Settings.getProToolString
hProTool = g_App.Settings.getProToolAppTitle

' loop_getobject: ' Try again

Err.Clear
Set ProToolObj = New CProTool

If sProtoolStart <> "" Then
    ' ProTool soll gestartet werden
    Err.Clear
            
            
    Call ProtoolBeenden
    
    hProTool = Shell(sProtoolStart, vbNormalFocus)
    Sleep 4000, True
    AppActivate hProTool, False
    
    If ProToolObj.init Then
        GoTo OKInitProTool
    Else
        GoTo ErrorInitProTool
    End If
Else
    ' ProTool sollte nicht gestartet werden
    Exit Function
End If
    
OKInitProTool:
    initProTool = True
    m_ArtVerbindung = Protool
    Exit Function
ErrorInitProTool:
    ' Fehlermeldung: keine Verbindung zur SPS
    ErrorMsg "Es konnte keine Verbindung zur SPS aufgebaut werden:" & vbCrLf & Err.Description & vbCrLf & "Wenn für diese Prüfstation die Kommunikation mit ProTool und der SPS erforderlich ist, brechen Sie das Programm jetzt ab, beheben den Fehler und versuchen Sie es erneut." & vbCrLf & "ProTool sollte sich laut INI-Datei im Pfad '" & sProtoolStart & "' befinden"
    
    g_ohneSPS = True
    'If MsgBox("Sollen die Antworten der SPS zwecks Test simuliert werden", vbYesNo, "") = vbYes Then
        m_TestModus = True
    'End If
    
    initProTool = False
End Function

Public Sub ActivateProTool()
    On Error Resume Next
    If Not IsEmpty(hProTool) Then
        AppActivate hProTool, True
        If Err Then
            MsgBox ("ActivateProTool Err: " & Err.Description)
        End If
    End If
End Sub

Public Sub DisconnectSPS()
    Select Case m_ArtVerbindung
        Case ENUMVERBINDUNG.Protool
            Call SPSVariableSchreiben(SPS_BEENDEN, 1)
            m_ArtVerbindung = keine
        Case ENUMVERBINDUNG.Prodave
            modProdave6.Dicconnect
            m_ArtVerbindung = keine
        Case ENUMVERBINDUNG.OPC
            OpcServer.Disconnect
            m_ArtVerbindung = keine
    End Select
End Sub

' SERVO_STELLUNG, gilt auch für FU (14.3.2000)
Public Sub SetServoStellung(Parameter As Integer)
    ' Parameter geht von 0 - 100, 0 = zu, 100 = offen
    Call SPSVariableSchreiben(SERVO_STELLUNG, Parameter)
End Sub

Public Sub SetRegulierungsSollwert(Parameter As Integer)
    ' Parameter geht von 0 - 100, 0 = -3%, 50=0%, 100= 3%
    Call SPSVariableSchreiben(REGULIERUNG_SOLL, Parameter)
End Sub

Public Sub setBetrieb(nByte As Byte)
    Call SPSVariableSchreiben(BETRIEB, nByte)
End Sub

Public Sub setBehaelter(nNr As Integer)
    ' Bit 0 = Durchlauf = 1, Bit 1 = Klein = 2, Bit 2 = Groß = 4
    ' Plausibilitäts-Check:
    Select Case nNr
        Case VORWAHL_BEHAELTER_DURCHLAUF
            Call SPSVariableSchreiben(VORWAHL_BEHAELTER, VORWAHL_BEHAELTER_DURCHLAUF)
        Case VORWAHL_BEHAELTER_KLEIN
            Call SPSVariableSchreiben(VORWAHL_BEHAELTER, VORWAHL_BEHAELTER_KLEIN)
        Case VORWAHL_BEHAELTER_GROSS
            Call SPSVariableSchreiben(VORWAHL_BEHAELTER, VORWAHL_BEHAELTER_GROSS)
        Case 8
            Call SPSVariableSchreiben(VORWAHL_BEHAELTER, 8)
        Case Else
            MsgBox ("SPS.setBehaelter: Behälter-Anwahl " & nNr & " existiert nicht")
    End Select
End Sub

Public Sub WassserAblassen(BehaelterBits As Byte)
    Call SPSVariableSchreiben(ABLASS, BehaelterBits)
End Sub

Public Function IstAutomatik() As Boolean
    Dim bByte As Byte
    
    If m_TestModus Or g_ohneSPS Then
        IstAutomatik = True
        Exit Function
    End If
    
    bByte = SPSVariableLesen(VORWAHL_BETRIEBSART)
    If ((bByte And VORWAHL_AUTO) = VORWAHL_AUTO) Then
        IstAutomatik = True
    Else
        IstAutomatik = False
    End If
End Function

Public Function IstRefZPrf() As Boolean
    Dim bByte As Byte
            
    bByte = SPSVariableLesen(VORWAHL_BETRIEBSART)
    If ((bByte And VORWAHL_REFERENZ) = VORWAHL_REFERENZ) Then
        IstRefZPrf = True
    Else
        IstRefZPrf = False
    End If
End Function

Public Function IstStreckePruefbereit() As Boolean
    Dim bStrecke As Byte
    
    If m_TestModus Or g_ohneSPS Then
        IstStreckePruefbereit = True
        Exit Function
    End If
    
    bStrecke = SPSVariableLesen(STATUS_STRECKE)
    If ((bStrecke And STATUS_STRECKE_PRUEFBEREIT) = STATUS_STRECKE_PRUEFBEREIT) Then
        IstStreckePruefbereit = True
    Else
        IstStreckePruefbereit = False
    End If
End Function


Public Function IstStreckePruefbereit_Neu() As Boolean
    Dim bStrecke As Long
    Dim i As Integer
    Dim bStrecke_alt As Long
    
    bStrecke_alt = -1
    
Neu_Anfangen_zu_Zaehlen:
    
    For i = 1 To 3
        bStrecke = SPSVariableLesen(STATUS_STRECKE)
        If bStrecke_alt = -1 Then
            ' beim ersten mal liegt noch kein Vergleichswert vor
            bStrecke_alt = bStrecke
        Else
            ' nun kann man vergleichen
            If bStrecke <> bStrecke_alt Then
                ' Wert hat sich geändert!
                ' neu anfangen zu zählen
                LogIntoDB "Wert hat sich gändert. Durchlauf " & i & " Wert=" & bStrecke, "IstStreckePruefbereit_Neu"
                bStrecke_alt = bStrecke
                GoTo Neu_Anfangen_zu_Zaehlen
            Else
                ' Wert ist gleich geblieben
            End If
        End If
        Sleep 1000, True
    Next
    
    ' hier kam 3 mal der gleiche Wert hintereinander
    If ((bStrecke And STATUS_STRECKE_PRUEFBEREIT) = STATUS_STRECKE_PRUEFBEREIT) Then
        IstStreckePruefbereit_Neu = True
    Else
        IstStreckePruefbereit_Neu = False
    End If
        
End Function



Public Function IstStreckeAngewaehlt() As Boolean
    Dim bStrecke As Byte
    If m_TestModus Then
        IstStreckeAngewaehlt = True
        Exit Function
    End If
    
    bStrecke = SPSVariableLesen(STATUS_STRECKE)
    If ((bStrecke And STATUS_STRECKE_VORGEWAEHLT) = STATUS_STRECKE_VORGEWAEHLT) Then
        IstStreckeAngewaehlt = True
    Else
        IstStreckeAngewaehlt = False
    End If
End Function

Public Function IstStreckeGefuellt() As Boolean
    Dim bStrecke As Byte
    
    If m_TestModus Then
        IstStreckeGefuellt = True
        Exit Function
    End If


    bStrecke = SPSVariableLesen(STATUS_STRECKE)
    If ((bStrecke And STATUS_STRECKE_GEFUELLT) = STATUS_STRECKE_GEFUELLT) Then
        IstStreckeGefuellt = True
    Else
        IstStreckeGefuellt = False
    End If
End Function

Public Function IstStreckeGespannt() As Boolean
    Dim bStrecke As Byte
    
    If m_TestModus Then
        IstStreckeGespannt = True
        Exit Function
    End If


    bStrecke = SPSVariableLesen(STATUS_STRECKE)
    If ((bStrecke And STATUS_STRECKE_GESPANNT) = STATUS_STRECKE_GESPANNT) Then
        IstStreckeGespannt = True
    Else
        IstStreckeGespannt = False
    End If
End Function

Public Function getQIst() As Double
    If m_TestModus Then
        getQIst = 30.99
        Exit Function
    End If

    getQIst = CDbl(SPSVariableLesen(DURCHFLUSS_BEREINIGT))
End Function

Public Sub PruefungVorbereiten()
   Call SPSVariableSchreiben(BETRIEB, 8)
   Sleep 500
   Call SPSVariableSchreiben(BETRIEB, BETRIEB_VORBEREITEN)
End Sub

' Sollwert
Public Sub SetQSoll(vData As Double)
Dim Wert As Double
    Wert = vData
   Call SPSVariableSchreiben(DURCHFLUSS_SOLL, Wert)
End Sub

' letzter Fehler in % zur Fehlerbereinigung des Ist-Wertes des Durchflusses
Public Sub SetQDiff(vData As Double)
    Dim Wert As Double
    Wert = vData
    
    Call SPSVariableSchreiben(DURCHFLUSSDIFF, Wert)
End Sub

Public Sub SetRegelart(Regelart As String)
    Select Case Regelart
        Case "Servo"
            Call SPSVariableSchreiben(REGEL_ART, REGELART_SERVO)
        Case "FU"
            Call SPSVariableSchreiben(REGEL_ART, REGELART_FU)
        Case ""
            LogIntoDB "Regelart ist nicht gesetzt", "ini Fehler"
        Case Else
            ErrorMsg "CSPS.SetRegelart: Regelart '" & Regelart & "' ist unbekannt"
    End Select
End Sub

Public Sub SetNurMesseinsaetze(vData As Boolean)
    Select Case vData
        Case True
            Call SPSVariableSchreiben(VORWAHL_NUR_MESSEINSAETZE, VORWAHL_NUR_MESSEINSAETZE_STRECKE1 Or 2)
            Sleep 300
            Call SPSVariableSchreiben(VORWAHL_NUR_MESSEINSAETZE, VORWAHL_NUR_MESSEINSAETZE_STRECKE1)
        Case False
            Call SPSVariableSchreiben(VORWAHL_NUR_MESSEINSAETZE, 2)
            Sleep 300
            Call SPSVariableSchreiben(VORWAHL_NUR_MESSEINSAETZE, 0)
    End Select
End Sub

Public Sub SetMID(Einbauplatz As Integer)

    ' todo zuverlässiger Triggern
    Call SPSVariableSchreiben(VORWAHL_MID, 0)
    Sleep 300, True
    
    Select Case Einbauplatz
        Case 1
            Call SPSVariableSchreiben(VORWAHL_MID_GRUPPPE, VORWAHL_MID_GRUPPPE_A)
            Sleep 300, True
            Call SPSVariableSchreiben(VORWAHL_MID, VORWAHL_MID_125)
        Case 2
            Call SPSVariableSchreiben(VORWAHL_MID_GRUPPPE, VORWAHL_MID_GRUPPPE_B)
            Sleep 300, True
            Call SPSVariableSchreiben(VORWAHL_MID, VORWAHL_MID_125)
        Case 3
            Call SPSVariableSchreiben(VORWAHL_MID_GRUPPPE, VORWAHL_MID_GRUPPPE_A)
            Sleep 300, True
            Call SPSVariableSchreiben(VORWAHL_MID, VORWAHL_MID_32)
        Case 4
            Call SPSVariableSchreiben(VORWAHL_MID_GRUPPPE, VORWAHL_MID_GRUPPPE_B)
            Sleep 300, True
            Call SPSVariableSchreiben(VORWAHL_MID, VORWAHL_MID_32)
        Case 5
            Call SPSVariableSchreiben(VORWAHL_MID_GRUPPPE, VORWAHL_MID_GRUPPPE_A)
            Sleep 300, True
            Call SPSVariableSchreiben(VORWAHL_MID, VORWAHL_MID_8)
        Case 6
            Call SPSVariableSchreiben(VORWAHL_MID_GRUPPPE, VORWAHL_MID_GRUPPPE_B)
            Sleep 300, True
            Call SPSVariableSchreiben(VORWAHL_MID, VORWAHL_MID_8)
        Case 7
            Call SPSVariableSchreiben(VORWAHL_MID_GRUPPPE, VORWAHL_MID_GRUPPPE_A)
            Sleep 300, True
            Call SPSVariableSchreiben(VORWAHL_MID, VORWAHL_MID_2)
        Case 8
            Call SPSVariableSchreiben(VORWAHL_MID_GRUPPPE, VORWAHL_MID_GRUPPPE_B)
            Sleep 300, True
            Call SPSVariableSchreiben(VORWAHL_MID, VORWAHL_MID_2)
         Case 9
            Call SPSVariableSchreiben(VORWAHL_MID_GRUPPPE, VORWAHL_MID_GRUPPPE_A)
            Sleep 300, True
            Call SPSVariableSchreiben(VORWAHL_MID, VORWAHL_MID_02)
         Case 10
            Call SPSVariableSchreiben(VORWAHL_MID_GRUPPPE, VORWAHL_MID_GRUPPPE_B)
            Sleep 300, True
            Call SPSVariableSchreiben(VORWAHL_MID, VORWAHL_MID_02)
        Case Else
            MsgBox ("MID Einbauplatz " & Einbauplatz & " ist unbekannt in CSPS")
    End Select
End Sub

Private Sub Class_Initialize()
    m_ArtVerbindung = keine
    m_bInitialized = init()
End Sub

Public Sub StartRegulierung()
     Call SPSVariableSchreiben(REGULIERUNG_MOTOR, 1)
End Sub

Public Sub StopRegulierung()
     Call SPSVariableSchreiben(REGULIERUNG_MOTOR, 0)
End Sub

Public Sub Zuruecksetzen()
    Call AllePumpenAbwaehlen
    setBetrieb 0
    
    SPSVariableSchreiben VORWAHL_BEHAELTER, 0
    SetNurMesseinsaetze False
    SPSVariableSchreiben REGEL_ART, 0
    SetQDiff 0
    SPSVariableSchreiben REGULIERUNG_SOLL, 0
    
    ' darf nicht null sein denn sonst läuft die Handprüfung nicht.
    SPSVariableSchreiben SERVO_STELLUNG, 10
    
    SetQSoll 0
    SPSVariableSchreiben PUMPE1, PUMPE_ANWAEHLEN
    SetMID 1
    
End Sub

'' Vorübergehend
'Public Function GetWert_1(Varname As String) As Variant
'    GetWert_1 = SPSVariableLesen(Varname)
'End Function


Public Sub SetWert(Varname As String, Wert As Variant)
    Call SPSVariableSchreiben(Varname, Wert)
End Sub

Public Sub StopPumpe(nPumpenNr As Integer)
    Select Case nPumpenNr
        Case 1
            SPSVariableSchreiben PUMPE1, PUMPE_STOP Or PUMPE_ANWAEHLEN
        Case 2
            SPSVariableSchreiben PUMPE2, PUMPE_STOP Or PUMPE_ANWAEHLEN
        Case 3
            SPSVariableSchreiben PUMPE3, PUMPE_STOP Or PUMPE_ANWAEHLEN
        Case 4
            MsgBox ("Pumpe 4 nicht stopbar")
            'SetWert PUMPE4, PUMPE_STOP Or PUMPE_ANWAEHLEN
        Case 5
            SPSVariableSchreiben PUMPE5, PUMPE_STOP Or PUMPE_ANWAEHLEN
        Case Else
            MsgBox ("Pumpe " & nPumpenNr & " gibt es nicht")
    End Select
End Sub

Public Sub AnwahlPumpe(nPumpenNr As Integer)
    Select Case nPumpenNr
        Case 1
            SPSVariableSchreiben PUMPE1, PUMPE_ANWAEHLEN
        Case 2
            SPSVariableSchreiben PUMPE2, PUMPE_ANWAEHLEN
        Case 3
            SPSVariableSchreiben PUMPE3, PUMPE_ANWAEHLEN
        Case 4
            MsgBox ("Pumpe 4 nicht Anwählbar")
            'SPSVariableSchreiben PUMPE4, PUMPE_ANWAEHLEN
        Case 5
            SPSVariableSchreiben PUMPE5, PUMPE_ANWAEHLEN
        Case Else
            MsgBox ("Pumpe " & nPumpenNr & " gibt es nicht")
    End Select
End Sub

Public Sub AllePumpenAbwaehlen()
    
    SPSVariableSchreiben PUMPE1, 8
    SPSVariableSchreiben PUMPE2, 8
    SPSVariableSchreiben PUMPE3, 8
    SPSVariableSchreiben PUMPE5, 8
    Sleep 500
    SPSVariableSchreiben PUMPE1, 0
    SPSVariableSchreiben PUMPE2, 0
    SPSVariableSchreiben PUMPE3, 0
    SPSVariableSchreiben PUMPE5, 0
End Sub

Public Sub AbwahlPumpe(nPumpenNr As Integer)
    Select Case nPumpenNr
        Case 1
           SPSVariableSchreiben PUMPE1, 8
           Sleep 500
            SPSVariableSchreiben PUMPE1, 0
        Case 2
           SPSVariableSchreiben PUMPE2, 8
           Sleep 500
            SPSVariableSchreiben PUMPE2, 0
        Case 3
          SPSVariableSchreiben PUMPE3, 8
            Sleep 500
            SPSVariableSchreiben PUMPE3, 0
        Case 5
           SPSVariableSchreiben PUMPE5, 8
           Sleep 500
            SPSVariableSchreiben PUMPE5, 0
        Case Else
            MsgBox ("Pumpe " & nPumpenNr & " gibt es nicht")
    End Select
End Sub

Public Sub SetLichtwellenleiter(blnWert As Boolean)
    If g_App.Settings.LICHTWELLENLEITER = -1 Then Exit Sub
    Select Case blnWert
        Case True
            SPSVariableSchreiben LICHTWELLENLEITER, 1
            DoEvents
            'If SPSVariableLesen(LICHTWELLENLEITER) = 0 Then Stop
        Case False
            SPSVariableSchreiben LICHTWELLENLEITER, 0
            DoEvents
            'If SPSVariableLesen(LICHTWELLENLEITER) = 1 Then Stop
    End Select
Exit Sub
End Sub

Public Sub StartPumpe(nPumpenNr As Integer)
    Select Case nPumpenNr
        Case 1
            SPSVariableSchreiben PUMPE1, PUMPE_START Or PUMPE_ANWAEHLEN
        Case 2
            SPSVariableSchreiben PUMPE2, PUMPE_START Or PUMPE_ANWAEHLEN
        Case 3
            SPSVariableSchreiben PUMPE3, PUMPE_START Or PUMPE_ANWAEHLEN
        Case 4
            'SPSVariableSchreiben PUMPE4, PUMPE_START Or PUMPE_ANWAEHLEN
            MsgBox ("Pumpe 4 nicht startbar")
        Case 5
            SPSVariableSchreiben PUMPE5, PUMPE_START Or PUMPE_ANWAEHLEN
        Case Else
            MsgBox ("StartPumpe: Pumpe " & nPumpenNr & " gibt es nicht")
    End Select
End Sub

'Public Function GetStellwert() As Integer
'    On Error Resume Next
'
'    If AufVorhandenseinVariableTesten(FU_STELLWERT_IST) Then
'        GetStellwert = GetWert(FU_STELLWERT_IST)
'        If GetStellwert > 0 Then
'            Debug.Print "GetStellwert FU_STELLWERT: " & GetStellwert
'            Exit Function
'        End If
'    End If
'
'    ' Nur eine Servoposition ist größer als 0. Es gilt, diese zu finden.
'    ' Die anderen Ventile sind geschlosssen.
'
'    If AufVorhandenseinVariableTesten(SERVO_M3_POSITION_IST) Then
'        GetStellwert = GetWert(SERVO_M3_POSITION_IST)
'        If GetStellwert > 0 Then
'            Debug.Print "GetStellwert SERVO_M3_POSITION: " & GetStellwert
'            Exit Function
'        End If
'
'    If AufVorhandenseinVariableTesten(SERVO_M4_POSITION_IST) Then
'        GetStellwert = GetWert(SERVO_M4_POSITION_IST)
'        If GetStellwert > 0 Then
'            Debug.Print "GetStellwert SERVO_M4_POSITION: " & GetStellwert
'            Exit Function
'        End If
'
'    If AufVorhandenseinVariableTesten(SERVO_M1_POSITION_IST) Then
'        GetStellwert = GetWert(SERVO_M1_POSITION_IST)
'        If GetStellwert > 0 Then
'            Debug.Print "GetStellwert SERVO_M1_POSITION: " & GetStellwert
'            Exit Function
'        End If
'    End If
'
'    If AufVorhandenseinVariableTesten(SERVO_M2_POSITION_IST) Then
'        GetStellwert = GetWert(SERVO_M2_POSITION_IST)
'        If GetStellwert > 0 Then
'            Debug.Print "GetStellwert SERVO_M2_POSITION: " & GetStellwert
'            Exit Function
'        End If
'    End If
'    Debug.Print "GetStellwert " & GetStellwert
'Exit Function
'GetStellwert_Error:
'    ' Stellwert konnte nicht bestimmt werden und ist unbekannt. 50% ist neutral
'    GetStellwert = 50
'End Function

Public Function GetStellwert() As Integer
On Error Resume Next
    If SPSVariableLesen(FU_STELLWERT_IST) > 0 Then
        GetStellwert = SPSVariableLesen(FU_STELLWERT_IST)
        Debug.Print "GetStellwert FU_STELLWERT: " & GetStellwert
    ElseIf SPSVariableLesen(SERVO_M3_POSITION_IST) > 0 Then
        GetStellwert = SPSVariableLesen(SERVO_M3_POSITION_IST)
        Debug.Print "GetStellwert SERVO_M3_POSITION: " & GetStellwert
    ElseIf SPSVariableLesen(SERVO_M4_POSITION_IST) > 0 Then
        GetStellwert = SPSVariableLesen(SERVO_M4_POSITION_IST)
        Debug.Print "GetStellwert SERVO_M4_POSITION: " & GetStellwert
    ElseIf SPSVariableLesen(SERVO_M1_POSITION_IST) > 0 Then
        GetStellwert = SPSVariableLesen(SERVO_M1_POSITION_IST)
        Debug.Print "GetStellwert SERVO_M1_POSITION: " & GetStellwert
    ElseIf SPSVariableLesen(SERVO_M2_POSITION_IST) > 0 Then
        GetStellwert = SPSVariableLesen(SERVO_M2_POSITION_IST)
        Debug.Print "GetStellwert SERVO_M2_POSITION: " & GetStellwert
    Else
        GetStellwert = 0
        Debug.Print "GetStellwert: " & GetStellwert
    End If
Exit Function
GetStellwert_Error:
    GetStellwert = 50
End Function

Public Function GetPumpenStatus(nPumpenNr As Integer) As Variant
If m_TestModus Then
    GetPumpenStatus = 1
    Exit Function
End If
    Select Case nPumpenNr
        Case 1
            GetPumpenStatus = SPSVariableLesen(STATUS_PUMPE1)
        Case 2
            GetPumpenStatus = SPSVariableLesen(STATUS_PUMPE2)
        Case 3
            GetPumpenStatus = SPSVariableLesen(STATUS_PUMPE3)
        Case 5
            GetPumpenStatus = SPSVariableLesen(STATUS_PUMPE5)
        Case Else
            MsgBox ("GetPumpenStatus: Pumpe " & nPumpenNr & " gibt es nicht")
            GetPumpenStatus = -1
    End Select
End Function

Public Function SolldurchflussErreicht() As Boolean
    If m_TestModus Or g_ohneSPS Then
        SolldurchflussErreicht = True
        Exit Function
    End If

    If SPSVariableLesen(REGLER_INFORMATION) = SOLLDURCHFLUSS_ERREICHT Then
        SolldurchflussErreicht = True
    Else
        SolldurchflussErreicht = False
    End If
End Function


Public Function GrenzwertWaageErreicht() As Boolean
If m_TestModus Then
    GrenzwertWaageErreicht = (MsgBox("Waagengrenzwert erricht", vbYesNo) = vbYes)
    Exit Function
End If

    If SPSVariableLesen(WAAGEN_GRENZWERT) = WAAGEN_GRENZWERT_ERREICHT Then
        GrenzwertWaageErreicht = True
    Else
        GrenzwertWaageErreicht = False
    End If
End Function

Public Function GetLuftTemperatur() As Single
        If g_App.Settings.getTempFeuchteMessen() = 1 Then
            GetLuftTemperatur = SPSVariableLesen(Lufttemperatur)
        Else
            GetLuftTemperatur = 0
        End If
End Function

Public Function GetRelativeFeuchte() As Single
        If g_App.Settings.getTempFeuchteMessen() = 1 Then
            GetRelativeFeuchte = SPSVariableLesen(RelativeFeuchte)
        Else
            GetRelativeFeuchte = 0
        End If
End Function

'Public Function GetTemperatur(n As Integer) As Double
'    If m_TestModus Then
'        GetTemperatur = -9999
'        Exit Function
'    End If
'    GetTemperatur = SPSVariableLesen(Temperatur & Trim(CStr(n)))
'End Function

Public Function GetEinlaufTemperatur() As Double
    If m_TestModus Then
        GetEinlaufTemperatur = 21.99
        Exit Function
    End If
        
    GetEinlaufTemperatur = SPSVariableLesen(EINLAUFTEMPERATUR)
    'ACHTUNG TEST Temperaturkorrektur AP 29.10.2003
    'Rückgängig gemacht am 27.01.2004 AP
    'GetEinlaufTemperatur = GetEinlaufTemperatur + 0.9
End Function

Public Function GetFuellstand_neu(BehaelterNr As Integer) As Double
    On Error GoTo Errorhandler
    
    Dim strFuellstandvariableKey As String
    Dim strFuellstandvariable As String
    
    strFuellstandvariableKey = "Waage" & BehaelterNr & ".SPS_Fuellstand_Variable"
    strFuellstandvariable = g_App.Settings.readStringValue("Waagen", strFuellstandvariableKey, "")
    If strFuellstandvariable <> "" Then
        GetFuellstand_neu = SPSVariableLesen(strFuellstandvariable) - m_FuellstandLeer
    Else
        Select Case BehaelterNr
           Case 1
              GetFuellstand_neu = SPSVariableLesen(FUELLSTAND1) - m_FuellstandLeer
           Case 2
              GetFuellstand_neu = SPSVariableLesen(FUELLSTAND2) - m_FuellstandLeer
           End Select
    End If
    
Exit Function
Errorhandler:
      ErrorMsg "Fehler " & Err.Number & " in getFuellstand: " & Err.Description
End Function




' Nachteil: es kann der Fuellstand nur für Behälter 1 und Behälter 2 abgelesen werden
' hier sollte zukünftig die Protool/Prodave Fuellstand-Variable aus der Ini gelesen werden!
Public Function GetFuellstand(BehaelterNr As Integer) As Double
On Error GoTo Errorhandler
   Select Case BehaelterNr
      Case 1
         GetFuellstand = SPSVariableLesen(FUELLSTAND1) - m_FuellstandLeer
      Case 2
         GetFuellstand = SPSVariableLesen(FUELLSTAND2) - m_FuellstandLeer
      End Select
Exit Function
Errorhandler:
      ErrorMsg "Fehler " & Err.Number & " in getFuellstand: " & Err.Description
End Function

Public Function GetServoFUStellwert(strRegelart As String, intStrang As Integer) As Integer
On Error GoTo GetServoFUStellwert_Error
Select Case strRegelart
    Case "FU"
        GetServoFUStellwert = SPSVariableLesen(FU_STELLWERT_IST)
        WriteToLog "GetServoFUStellwert FU_STELLWERT: " & GetServoFUStellwert
    Case "Servo"
        Select Case intStrang
            Case 1
                GetServoFUStellwert = SPSVariableLesen(SERVO_M1_POSITION_IST)
                WriteToLog "GetServoFUStellwert SERVO_M1_POSITION: " & GetServoFUStellwert
            Case 2
                GetServoFUStellwert = SPSVariableLesen(SERVO_M2_POSITION_IST)
                WriteToLog "GetServoFUStellwert SERVO_M2_POSITION: " & GetServoFUStellwert
            Case 3
                GetServoFUStellwert = SPSVariableLesen(SERVO_M3_POSITION_IST)
                WriteToLog "GetServoFUStellwert SERVO_M3_POSITION: " & GetServoFUStellwert
            Case 4
                GetServoFUStellwert = SPSVariableLesen(SERVO_M4_POSITION_IST)
                WriteToLog "GetServoFUStellwert SERVO_M4_POSITION: " & GetServoFUStellwert
            Case Else
                GetServoFUStellwert = 50
        End Select
    Case ""
        GetServoFUStellwert = 50
    Case Else
        GetServoFUStellwert = 50
    End Select
Exit Function
GetServoFUStellwert_Error:
    WriteToLog "Fehler " & Err.Number & " in GetServoFUStellwert " & Err.Description & vbCrLf & "Evtl gibt es eine SPS Variable nicht in der SPS (Protool/Prodave)." & vbCrLf & " Überprüfen Sie in der Ini-Datei den Eintrag 'PumpeX.Regelart' und den zugehörigen MID Strang." & vbCrLf & "Regelart= " & strRegelart & vbCrLf & "Strang=" & intStrang
End Function



Private Sub ProtoolBeenden()
    Dim intCount As Integer
    intCount = KillProcessByName("PTProRun.exe", True)
    If intCount > 0 Then
        intCount = KillProcessByName("PTProRun.exe", False)
        LogIntoDB intCount & " PTProRun.exe Prozesse wurde(n) beendet", "Protool"
        Sleep 1000, True
    End If
End Sub