267 lines
7.8 KiB
QBasic
267 lines
7.8 KiB
QBasic
Attribute VB_Name = "modFunktionspruefung"
|
|
Option Explicit
|
|
|
|
Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
|
|
|
|
Public mdblTemperaturVorgabeVorlauf As Double
|
|
Public mdblTemperaturVorgabeRuecklauf As Double
|
|
Public gblnUseFP_FlowSimulation As Boolean
|
|
Public mdblToleranzEnergie As Double
|
|
Public mdblToleranzDeltaT As Double
|
|
|
|
Public Type SYSTEMTIME
|
|
wYear As Integer
|
|
wMonth As Integer
|
|
wDayOfWeek As Integer
|
|
wDay As Integer
|
|
wHour As Integer
|
|
wMinute As Integer
|
|
wSecond As Integer
|
|
wMilliseconds As Integer
|
|
End Type
|
|
|
|
Public Type TYPE_MessDaten
|
|
|
|
lngIdentNoForVerification As Long 'Wenn erkannt, dann dieses Platz auch prüfen
|
|
intPortNr As Integer 'Die COM-Port-Nr
|
|
|
|
dtmStartZeit As Date 'Startzeit der Funktionsprüfung
|
|
dblStartDeltaT As Double 'Am Start gemessene Temperatur (US-Zähler)
|
|
' dblStartVolume As Double 'Am Start gemessenes Volumen (ausgelesen)
|
|
' dblStartEnergy As Double 'Am Start gemessene Energie (ausgelesen)
|
|
|
|
dtmStopZeit As Date 'Endzeit der Funktionsprüfung
|
|
dblStopDeltaT As Double 'Am Ende gemessene Temperatur (US-Zähler)
|
|
|
|
dblStopVolume As Double 'Am Ende gemessenes Volumen (ausgelesen)
|
|
dblStopEnergy As Double 'Am Ende gemessene Energie (ausgelesen)
|
|
|
|
blnDeltaT_OK As Boolean
|
|
blnEnergy_OK As Boolean
|
|
|
|
End Type
|
|
|
|
|
|
Public Function ExtendedPruefungsInitialisierung(ByVal intPortNr As Integer, Optional ByRef lngIdentNoForVerification As Long = -1) As Long
|
|
|
|
Dim lngReturn As Long
|
|
lngReturn = PruefungsInitialisierung(intPortNr)
|
|
If lngReturn = 0 Then
|
|
lngReturn = SetTemperatureTransferLock(intPortNr, True)
|
|
If lngReturn = 0 Then
|
|
lngReturn = NOWA_START(intPortNr)
|
|
If lngReturn = 0 Then
|
|
If gblnUseFP_FlowSimulation Then
|
|
lngReturn = Set_FP_Flow_Simu(intPortNr, 10 / 3600) '= 10 m³/h (wird aber in m³/s übergeben!)
|
|
If lngReturn = 0 Then
|
|
lngReturn = Set_special_mode(intPortNr, True)
|
|
End If
|
|
End If
|
|
End If
|
|
End If
|
|
End If
|
|
ExtendedPruefungsInitialisierung = lngReturn
|
|
|
|
End Function
|
|
|
|
|
|
Public Function ExtendedPruefungsAbschluss(ByVal intPortNr As Integer, Optional ByRef lngIdentNoForVerification As Long = -1) As Long
|
|
|
|
Dim lngReturn As Long
|
|
lngReturn = NOWA_STOP(intPortNr)
|
|
If lngReturn = 0 Then
|
|
lngReturn = SetTemperatureTransferLock(intPortNr, False, lngIdentNoForVerification)
|
|
If lngReturn = 0 Then
|
|
lngReturn = Set_special_mode(intPortNr, False, lngIdentNoForVerification)
|
|
If lngReturn = 0 Then
|
|
lngReturn = PruefungsAbschluss(intPortNr)
|
|
End If
|
|
End If
|
|
End If
|
|
ExtendedPruefungsAbschluss = lngReturn
|
|
|
|
End Function
|
|
|
|
Public Function GetSollEnergy(ByVal dblStopVolume As Double, _
|
|
ByVal dblStopEnergy As Double, _
|
|
ByVal dblStartDeltaT As Double, _
|
|
ByVal dblStopDeltaT As Double, _
|
|
ByVal dtmMessDauer As Date) As Double
|
|
Dim dblDeltaT As Double
|
|
Dim dblKilogramm As Double
|
|
|
|
Const c = 4187 'J/(kg K) Joule je Kilogramm und Kelvin
|
|
|
|
dblDeltaT = (dblStartDeltaT + dblStopDeltaT) / 2
|
|
|
|
dblKilogramm = dblStopVolume 'Annahme: 1Liter = 1kg !!!!!!!! ToDo ???
|
|
|
|
Dim dblSollEnergy As Double
|
|
Dim dblToleranz As Double
|
|
|
|
dblSollEnergy = dblKilogramm * c * dblDeltaT '[Ws]
|
|
|
|
dblSollEnergy = dblSollEnergy / 1000 '[kWs]
|
|
|
|
dblSollEnergy = dblSollEnergy / 3600 '[kWh]
|
|
|
|
GetSollEnergy = dblSollEnergy
|
|
|
|
End Function
|
|
|
|
|
|
Public Function isEnergyOK(ByVal dblStopVolume As Double, _
|
|
ByVal dblStopEnergy As Double, _
|
|
ByVal dblStartDeltaT As Double, _
|
|
ByVal dblStopDeltaT As Double, _
|
|
ByVal dtmMessDauer As Date) As Boolean
|
|
|
|
Dim dblDeltaT As Double
|
|
Dim dblKilogramm As Double
|
|
|
|
Const c = 4187 'J/(kg K) Joule je Kilogramm und Kelvin
|
|
|
|
isEnergyOK = False
|
|
|
|
dblDeltaT = (dblStartDeltaT + dblStopDeltaT) / 2
|
|
|
|
dblKilogramm = dblStopVolume 'Annahme: 1Liter = 1kg !!!!!!!! ToDo ???
|
|
|
|
Dim dblSollEnergy As Double
|
|
Dim dblToleranz As Double
|
|
|
|
dblSollEnergy = dblKilogramm * c * dblDeltaT '[Ws]
|
|
|
|
dblSollEnergy = dblSollEnergy / 1000 '[kWs]
|
|
|
|
dblSollEnergy = dblSollEnergy / 3600 '[kWh]
|
|
|
|
' RH 22.10.02 Hier tritt der Überlauf wenn mdblSollEnergy = 0 ist
|
|
dblToleranz = ((dblStopEnergy - dblSollEnergy) / dblSollEnergy)
|
|
|
|
If (Abs(dblToleranz) * 100) <= mdblToleranzEnergie Then
|
|
isEnergyOK = True
|
|
End If
|
|
|
|
End Function
|
|
|
|
'Genauer als Now(), da dieser Wert auch Millisekunden enthält !!!
|
|
'Die Zeit ist die GMT-Zeit !
|
|
Public Function GetTime() As Date
|
|
|
|
Dim udtSysTime As SYSTEMTIME
|
|
GetSystemTime udtSysTime
|
|
With udtSysTime
|
|
GetTime = DateSerial(.wYear, .wMonth, .wDay) + _
|
|
TimeSerial(.wHour, .wMinute, .wSecond) + .wMilliseconds / 86400000
|
|
End With
|
|
|
|
End Function
|
|
|
|
|
|
|
|
|
|
Public Function AllDeltaT_OK(mudtMessDaten() As TYPE_MessDaten) As Boolean
|
|
Dim i As Integer
|
|
Dim blnOK As Boolean
|
|
|
|
blnOK = True
|
|
For i = 0 To UBound(mudtMessDaten)
|
|
If mudtMessDaten(i).intPortNr <> 0 Then
|
|
If Not DeltaT_Difference_OK(mudtMessDaten(i).intPortNr) Then
|
|
'Fehlerabweichung zu groß
|
|
blnOK = False
|
|
Debug.Print "Fehlerhafte Temperaturdifferenz bei Einbauplatz " & i
|
|
Else
|
|
mudtMessDaten(i).blnDeltaT_OK = True
|
|
End If
|
|
End If
|
|
Next
|
|
AllDeltaT_OK = blnOK
|
|
End Function
|
|
|
|
Private Function DeltaT_Difference_OK(ByVal intPortNr As Integer, Optional ByRef lngIdentNoForVerification As Long = -1) As Boolean
|
|
|
|
Dim dblDeltaT_US As Double
|
|
Dim dblDeltaT_NUDAM As Double
|
|
|
|
DeltaT_Difference_OK = False
|
|
|
|
dblDeltaT_US = DeltaT_US(intPortNr, lngIdentNoForVerification)
|
|
dblDeltaT_NUDAM = DeltaT_NUDAM()
|
|
|
|
If (Abs(dblDeltaT_US) < 200) And (Abs(dblDeltaT_NUDAM < 200)) Then
|
|
If Abs(dblDeltaT_US - dblDeltaT_NUDAM) <= mdblToleranzDeltaT Then 'Nur Abweichung < 10 Grad erlaubt
|
|
DeltaT_Difference_OK = True
|
|
End If
|
|
End If
|
|
|
|
|
|
End Function
|
|
|
|
|
|
Private Function DeltaT_US(ByVal intPortNr As Integer, Optional ByRef lngIdentNoForVerification As Long = -1) As Double
|
|
|
|
DeltaT_US = -9999999 'Bedeutet, das kein richtiger Wert ermittelt wurde
|
|
|
|
Dim dblResult As Double
|
|
Dim lngReturn As Long
|
|
|
|
lngReturn = Get_T_fp(intPortNr, enuTemp_DeltaVorlaufRuecklauf, dblResult, lngIdentNoForVerification)
|
|
If lngReturn = 0 Then DeltaT_US = dblResult
|
|
|
|
End Function
|
|
|
|
|
|
|
|
Private Function DeltaT_NUDAM() As Double
|
|
|
|
DeltaT_NUDAM = 9999999 'Bedeutet, das kein richtiger Wert ermittelt wurde
|
|
If mdblTemperaturVorgabeVorlauf > 0 And mdblTemperaturVorgabeRuecklauf > 0 Then
|
|
DeltaT_NUDAM = mdblTemperaturVorgabeVorlauf - mdblTemperaturVorgabeRuecklauf
|
|
End If
|
|
|
|
End Function
|
|
|
|
|
|
Public Function SavePruefergebnis(ByVal lngFabNr As Long, ByVal blnPruefungOK As Boolean) As Boolean
|
|
|
|
On Error GoTo SavePruefergebnis_Error
|
|
SavePruefergebnis = False
|
|
|
|
|
|
Dim strSQL As String
|
|
|
|
strSQL = "SELECT * FROM SpeicherAbbild WHERE FabNr=" & lngFabNr & ";"
|
|
|
|
Dim ADOConnection As ADODB.connection
|
|
|
|
Set ADOConnection = g_App.getDB.getConnection
|
|
|
|
Dim rs As CRecordset
|
|
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, False
|
|
|
|
If rs.EOF Then
|
|
SavePruefergebnis = False
|
|
Else
|
|
If blnPruefungOK Then
|
|
rs.setValue "FunktionsPruefung", Now()
|
|
Else
|
|
rs.setValue "FunktionsPruefung", Null
|
|
End If
|
|
rs.update
|
|
End If
|
|
|
|
Set rs = Nothing
|
|
|
|
SavePruefergebnis = False
|
|
Exit Function
|
|
|
|
SavePruefergebnis_Error:
|
|
|
|
ErrorMsg "Fehler bei 'SavePruefergebnis': (" & Err.Number & ") " & Err.Description
|
|
|
|
End Function
|