laatzen/Pruef2000/source/SPS.cls
2021-10-01 11:11:04 +02:00

1191 lines
37 KiB
OpenEdge ABL
Raw Permalink Blame History

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<EFBFBD>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<EFBFBD>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<EFBFBD>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<50>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<50>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<72> = 4
' Plausibilit<EFBFBD>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<65>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<67>ndert!
' neu anfangen zu z<EFBFBD>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<EFBFBD>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<70>fung nicht.
SPSVariableSchreiben SERVO_STELLUNG, 10
SetQSoll 0
SPSVariableSchreiben PUMPE1, PUMPE_ANWAEHLEN
SetMID 1
End Sub
'' Vor<6F>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<6E>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<67><72>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<6B>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<65>lter 1 und Beh<65>lter 2 abgelesen werden
' hier sollte zuk<EFBFBD>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 & " <20>berpr<70>fen Sie in der Ini-Datei den Eintrag 'PumpeX.Regelart' und den zugeh<65>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