1228 lines
48 KiB
QBasic
1228 lines
48 KiB
QBasic
Attribute VB_Name = "modUSchall"
|
|
Option Explicit
|
|
|
|
Global g_USSeriennr(10) As String
|
|
Global g_lastUSCOMPort
|
|
Global g_lastPingFehler As Long
|
|
|
|
Global g_blnFW2_Systemzeit_setzen As Boolean
|
|
|
|
|
|
Const FW2ANZAHLWDH = 3
|
|
Const FW2_WDH_DELAY = 1000
|
|
|
|
|
|
' Ping für Ultraschallzähler
|
|
Function USPing(Einbauplatz As Integer) As Long
|
|
Dim comport As Integer
|
|
Dim lngReturn As Long
|
|
Dim strComPort As String
|
|
|
|
On Error Resume Next
|
|
|
|
strComPort = Val(g_App.Settings.getUSComPort(Einbauplatz))
|
|
If strComPort = "" Then
|
|
g_lastPingFehler = -1
|
|
USPing = -1
|
|
Exit Function
|
|
End If
|
|
|
|
comport = Val(strComPort)
|
|
|
|
Debug.Print "Ping " & Einbauplatz & " an COM " & comport
|
|
If comport = 0 Then
|
|
'MsgBox "Für Einbauplatz " & Einbauplatz & " ist kein COM ComPort definiert"
|
|
USPing = 0
|
|
Exit Function
|
|
End If
|
|
|
|
lngReturn = modIECCOM.ScanPort(comport)
|
|
If lngReturn = 0 Then
|
|
USPing = 1
|
|
Debug.Print "Zähler antwortet am Einbauplatz " & Einbauplatz & " an COM " & comport
|
|
Else
|
|
Debug.Print "keine Verb." & lngReturn & " am " & Einbauplatz & " an COM " & comport
|
|
USPing = lngReturn
|
|
g_lastPingFehler = lngReturn
|
|
End If
|
|
End Function
|
|
|
|
Function setUSSerienNr(Einbauplatz As Integer, SerienNr As Long) As Long
|
|
Dim comport As Integer
|
|
Dim lngRet As Long
|
|
|
|
comport = Val(g_App.Settings.getUSComPort(Einbauplatz))
|
|
setUSSerienNr = modIECCOM.SetFabNo(comport, CStr(SerienNr))
|
|
|
|
End Function
|
|
|
|
Function getUSFabNr(Einbauplatz As Integer) As String
|
|
Dim comport As Integer
|
|
Dim lngRet As Long
|
|
|
|
comport = Val(g_App.Settings.getUSComPort(Einbauplatz))
|
|
|
|
lngRet = modIECCOM.GetFabNo(comport, getUSFabNr)
|
|
|
|
If lngRet <> 0 Then
|
|
DebugMsg "getUSFabNr Rückgabewert: " & lngRet
|
|
End If
|
|
|
|
End Function
|
|
|
|
Function USgetFlow_fp(Einbauplatz As Integer, ByRef dblResult As Double) As Long
|
|
Dim comport As Integer
|
|
|
|
comport = Val(g_App.Settings.getUSComPort(Einbauplatz))
|
|
|
|
USgetFlow_fp = modIECCOM.Get_Flow_fp(comport, dblResult)
|
|
End Function
|
|
|
|
Function USSchlossOeffnen(Einbauplatz As Integer)
|
|
Dim comport As Integer
|
|
comport = Val(g_App.Settings.getUSComPort(Einbauplatz))
|
|
Call modIECCOM.OpenSchloss(comport)
|
|
End Function
|
|
|
|
Function USSchlossSchliessen(Einbauplatz As Integer)
|
|
Dim comport As Integer
|
|
'Stop
|
|
comport = Val(g_App.Settings.getUSComPort(Einbauplatz))
|
|
Call modIECCOM.CloseSchloss(comport)
|
|
End Function
|
|
|
|
Function USZaehlerPruefungInitialisierung(EinbauplatzNr As Integer) As Long
|
|
Dim comport As Integer
|
|
Dim lngResult As Long
|
|
|
|
comport = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
|
|
|
|
' Interne Fühler abschalten, da Temperatur extern (Wert aus der SPS) gesetzt wird
|
|
|
|
' Änderung Andreas Pfeiffer am 23.03.2004, RH am 22.04.2004
|
|
' Das Abschalten wird jetzt in Abhängigkeit eines Eintages in der INI-Datei geschaltet
|
|
' Die Sektion heißt [USTemperaturLock], der Key heisst VerwendungExternerFuehler
|
|
' 0 bedeutet, dass das der Zähler selbst mißt (default)
|
|
' 1 die Temperatur aus der Prüfstation übertragen wird
|
|
|
|
If g_App.Settings.USTemperaturlock = 1 Then
|
|
' Verwendung Externer Fühler: mit TemperatureTransferLock
|
|
' das Überschreiben mit Interner Temperatur unterbinden
|
|
lngResult = modIECCOM.SetTemperatureTransferLock(comport, True)
|
|
If lngResult <> 0 Then
|
|
USZaehlerPruefungInitialisierung = lngResult
|
|
If gblnIsInIDE Then
|
|
Stop
|
|
End If
|
|
|
|
Exit Function
|
|
End If
|
|
ElseIf g_App.Settings.USTemperaturlock = 0 Then
|
|
' Verwendung Interner Fühler
|
|
lngResult = modIECCOM.SetTemperatureTransferLock(comport, False)
|
|
If lngResult <> 0 Then
|
|
USZaehlerPruefungInitialisierung = lngResult
|
|
Stop
|
|
Exit Function
|
|
End If
|
|
Else
|
|
MsgBox "falscher Wert in INI: [USTemperaturlock] VerwendungExternerFuehler"
|
|
End If
|
|
|
|
USZaehlerPruefungInitialisierung = modIECCOM.PruefungsInitialisierung(comport)
|
|
End Function
|
|
|
|
Function USPruefungsAbschluss(Einbauplatz As Integer, Optional lngSeriennummer As Long = -1) As Long
|
|
Dim comport As Integer
|
|
comport = Val(g_App.Settings.getUSComPort(Einbauplatz))
|
|
USPruefungsAbschluss = modIECCOM.PruefungsAbschluss(comport)
|
|
End Function
|
|
|
|
Function USSetOptoOffTimerMax(Einbauplatz As Integer) As Integer
|
|
Dim comport As Integer
|
|
comport = Val(g_App.Settings.getUSComPort(Einbauplatz))
|
|
USSetOptoOffTimerMax = modIECCOM.Set_Opto_off_timer_Max(comport)
|
|
End Function
|
|
|
|
|
|
Function USgetOptoOffTimer(Einbauplatz As Integer) As Long
|
|
Dim comport As Integer
|
|
Dim intResult As Integer
|
|
comport = Val(g_App.Settings.getUSComPort(Einbauplatz))
|
|
If modIECCOM.Get_Opto_off_timer(comport, intResult) = 0 Then
|
|
USgetOptoOffTimer = CLng(intResult)
|
|
End If
|
|
End Function
|
|
|
|
|
|
Function USinit()
|
|
g_USSeriennr(2) = 0
|
|
g_USSeriennr(3) = 9300599
|
|
End Function
|
|
|
|
Function merkeUSCOMPort(Einbauplatz As Integer) As Integer
|
|
Dim comport As Integer
|
|
comport = Val(g_App.Settings.getUSComPort(Einbauplatz))
|
|
g_lastUSCOMPort = comport
|
|
End Function
|
|
|
|
Function GetUSVolumen(EinbauplatzNr As Integer, ByRef dblVolumen As Double, Optional SerienNrForVerication As Long = -1) As Integer
|
|
Dim comport As Integer
|
|
Dim FehlerCounter As Integer
|
|
Dim firmwareVersion As Byte
|
|
|
|
|
|
comport = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
|
|
|
|
FehlerCounter = 0
|
|
|
|
Call modIECCOM.Get_Slave_FLASH_Firmware_Version(comport, firmwareVersion)
|
|
|
|
Do
|
|
dblVolumen = 0
|
|
GetUSVolumen = modIECCOM.Get_NOWA_volume_fp(comport, dblVolumen, -1)
|
|
|
|
'Wird nicht mehr benötigt nach autom. Skalierungserkennung
|
|
'Select Case firmwareVersion
|
|
' Case 20
|
|
' dblVolumen = dblVolumen / 100
|
|
' Case Else
|
|
' dblVolumen = dblVolumen / 1000
|
|
'End Select
|
|
|
|
dblVolumen = dblVolumen / 1000
|
|
|
|
If GetUSVolumen < 0 Then
|
|
FehlerCounter = FehlerCounter + 1
|
|
Sleep 2000, True
|
|
DebugMsg "Warnung: GetUSVolumen " & FehlerCounter & " mal fehlgeschlagen (Fehler " & GetUSVolumen & ") "
|
|
End If
|
|
Loop While GetUSVolumen < 0 And FehlerCounter < 5
|
|
|
|
End Function
|
|
|
|
Function GetRZVolumen(EinbauplatzNr As Integer, Referenzzaehler As CRefzaehler, ByRef dblVolumen As Double) As Integer
|
|
Dim FMBus As CFMBus
|
|
Dim Impulse As Long
|
|
Dim strTemp As String
|
|
|
|
On Error GoTo GetRZVolumenFehler
|
|
|
|
Impulse = 0
|
|
|
|
Set FMBus = g_App.getFMBus
|
|
dblVolumen = 0
|
|
|
|
FMBus.send "**" & EinbauplatzNr & "@"
|
|
If FMBus.receive(500) = "" Then
|
|
GetRZVolumen = -1
|
|
Exit Function
|
|
End If
|
|
|
|
' Korrektur: 22.2.2013 RH: "l" statt "L"
|
|
'Der FM85.P sendet den Wert der bei Erhalt des Befehles L bzw. q zwischengespeicherten Anzahl eingetroffener Impulse des Referenz-Zählers (HEX-Zahl).
|
|
FMBus.send "l"
|
|
strTemp = FMBus.receive(500)
|
|
If strTemp = "" Then
|
|
GetRZVolumen = -2
|
|
Exit Function
|
|
End If
|
|
|
|
Impulse = CLng("&H0" & strTemp) 'And (2 ^ 31 - 1)
|
|
|
|
dblVolumen = Impulse / Referenzzaehler.ImpulseQM ' in m^3
|
|
|
|
WriteToLog "Antwort vom FM85-" & EinbauplatzNr & " : '" & strTemp & "'. " & Impulse & " Impulse / " & Referenzzaehler.ImpulseQM & " Impulse/m³ = " & dblVolumen & " m³"
|
|
|
|
Exit Function
|
|
GetRZVolumenFehler:
|
|
GetRZVolumen = -99
|
|
End Function
|
|
|
|
|
|
Function USSetTemperatur(EinbauplatzNr As Integer, dblTemperatur As Double, Optional lngIdentNoForVerification As Long = -1) As Long
|
|
Dim comport As Integer
|
|
Dim lngResult As Long
|
|
|
|
comport = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
|
|
|
|
If g_App.Settings.USTemperaturlock = 1 Then
|
|
USSetTemperatur = modIECCOM.Set_FP_Temperature(comport, dblTemperatur, -1)
|
|
Else
|
|
lngResult = modIECCOM.ScanPort(comport)
|
|
If lngResult <> 0 Then
|
|
USSetTemperatur = lngResult
|
|
End If
|
|
End If
|
|
|
|
End Function
|
|
|
|
Function USSetTemperatureLock(EinbauplatzNr As Integer, blnLocked As Boolean, Optional lngIdentNoForVerification As Long = -1)
|
|
'Exit Function
|
|
Dim comport As Integer
|
|
Dim bytResult As Byte
|
|
Dim lngResult As Long
|
|
|
|
comport = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
|
|
lngResult = modIECCOM.Get_Slave_FLASH_Firmware_Version(comport, bytResult, lngIdentNoForVerification)
|
|
If lngResult = 0 Then
|
|
If bytResult >= 14 Then
|
|
lngResult = modIECCOM.SetTemperatureTransferLock(comport, blnLocked, -1)
|
|
USSetTemperatureLock = lngResult
|
|
Else
|
|
' TempLock nicht möglich
|
|
USSetTemperatureLock = -55
|
|
End If
|
|
Else
|
|
USSetTemperatureLock = lngResult
|
|
End If
|
|
End Function
|
|
|
|
|
|
Function USSetFlowMinMax(EinbauplatzNr As Integer, dblFP_Flow_Min As Double, dblFP_Flow_Max As Double, Optional lngIdentNoForVerification As Long = -1)
|
|
Dim comport As Integer
|
|
comport = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
|
|
|
|
USSetFlowMinMax = modIECCOM.Set_FP_Flow_MaxMin(comport, dblFP_Flow_Min, dblFP_Flow_Max, -1)
|
|
End Function
|
|
|
|
Function USSetIdentNr(EinbauplatzNr As Integer, lngIdentNr As Long, Optional lngIdentNoForVerification As Long = -1)
|
|
Dim comport As Integer
|
|
comport = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
|
|
|
|
USSetIdentNr = modIECCOM.SetIdentNo(comport, lngIdentNr)
|
|
End Function
|
|
|
|
Function USGetFabNr(EinbauplatzNr As Integer) As Long
|
|
Dim comport As Integer
|
|
Dim lngReturn As Long
|
|
Dim strResult As String
|
|
|
|
comport = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
|
|
lngReturn = modIECCOM.GetFabNo(comport, strResult)
|
|
If lngReturn = 0 Then
|
|
USGetFabNr = CLng(strResult)
|
|
Else
|
|
MsgBox ("FabNr aus Ultraschallzähler konnte nicht gelesen werden: " & lngReturn & " " & Err.Description)
|
|
USGetFabNr = 0
|
|
End If
|
|
|
|
End Function
|
|
|
|
Function USGetFlowSimu(EinbauplatzNr As Integer) As Double
|
|
Dim comport As Integer
|
|
Dim lngReturn As Long
|
|
Dim dblResult As Double
|
|
|
|
comport = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
|
|
|
|
lngReturn = modIECCOM.Get_FP_Flow_Simu(comport, dblResult)
|
|
|
|
|
|
If lngReturn = 0 Then
|
|
USGetFlowSimu = dblResult
|
|
Else
|
|
MsgBox ("FlowSimu aus Ultraschallzähler konnte nicht gelesen werden: " & lngReturn & " " & Err.Description)
|
|
USGetFlowSimu = 0
|
|
End If
|
|
End Function
|
|
|
|
|
|
Function USGetIdentNr(EinbauplatzNr As Integer) As Long
|
|
Dim comport As Integer
|
|
Dim lngReturn As Long
|
|
Dim strResult As String
|
|
|
|
comport = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
|
|
lngReturn = modIECCOM.GetIdentNo(comport, strResult)
|
|
If lngReturn = 0 Then
|
|
USGetIdentNr = CLng(strResult)
|
|
Else
|
|
MsgBox ("IdentNr aus Ultraschallzähler konnte nicht gelesen werden: " & lngReturn & " " & Err.Description)
|
|
USGetIdentNr = 0
|
|
End If
|
|
|
|
End Function
|
|
|
|
Function USGetSchlossOffen(EinbauplatzNr As Integer, blnOffen As Boolean) As Long
|
|
Dim comport As Integer
|
|
comport = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
|
|
|
|
USGetSchlossOffen = modIECCOM.GetSchloss(comport, blnOffen)
|
|
|
|
End Function
|
|
|
|
|
|
Function USGet_Flow_fp(EinbauplatzNr As Integer) As Long
|
|
|
|
Dim comport As Integer
|
|
Dim dblResult As Double
|
|
|
|
comport = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
|
|
|
|
USGet_Flow_fp = modIECCOM.Get_Flow_fp(comport, dblResult)
|
|
|
|
End Function
|
|
|
|
|
|
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
''''''''''''''''''''''''''''''''''''''''''''''''' FW 2 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
|
|
|
|
Public Function FW2_USSetTemperatur(Einbauplatz As CEinbauplatz, dblTemperatur As Double) As Integer
|
|
On Error GoTo Errorhandler
|
|
|
|
Dim comport As Integer
|
|
Dim lngResult As Long
|
|
Dim WdhCounter As Integer
|
|
|
|
If Einbauplatz.m_iComport = 0 Then Stop
|
|
If Einbauplatz.m_strMapfile = "" Then Stop
|
|
|
|
FW2_USSetTemperatur = modMBUS_SMS.fw2_open_comport(Einbauplatz.m_iComport, 2400, Einbauplatz.m_strMapfile, True, 3)
|
|
If FW2_USSetTemperatur = 0 Then
|
|
|
|
WdhCounter = 0
|
|
WDH_WriteValue:
|
|
|
|
FW2_USSetTemperatur = modMBUS_SMS.WriteValue("i16_temperature_to_slave_transfere", Round(dblTemperatur * 10))
|
|
|
|
If FW2_USSetTemperatur = 0 Then
|
|
WriteToLog "i16_temperature_to_slave_transfere= " & Round(dblTemperatur * 10)
|
|
WriteToFW2Logfile Einbauplatz, "schreibe i16_temperature_to_slave_transfere=" & vbTab & Round(dblTemperatur * 10)
|
|
'ElseIf FW2_USSetTemperatur = MBUS_SMS_ERR_TIMEOUT And WdhCounter < FW2ANZAHLWDH Then
|
|
ElseIf WdhCounter < FW2ANZAHLWDH Then
|
|
'WriteToFW2Logfile Einbauplatz, "Timeout bei WriteValue (i16_temperature_to_slave_transfere)! Wdh=" & WdhCounter
|
|
WriteToFW2Logfile Einbauplatz, "Fehler " & FW2_USSetTemperatur & " bei WriteValue (i16_temperature_to_slave_transfere)! Wdh=" & WdhCounter & ": " & modMBUS_SMS.Errorstring(FW2_USSetTemperatur)
|
|
Sleep FW2_WDH_DELAY
|
|
WdhCounter = WdhCounter + 1
|
|
GoTo WDH_WriteValue
|
|
Else
|
|
WriteToFW2Logfile Einbauplatz, "Fehler in FW2_USSetTemperatur() bei WriteValue i16_temperature_to_slave_transfere): " & FW2_USSetTemperatur & "=" & modMBUS_SMS.Errorstring(FW2_USSetTemperatur)
|
|
End If
|
|
Else
|
|
WriteToFW2Logfile Einbauplatz, "Fehler in FW2_USSetTemperatur: fw2_open_comport: " & FW2_USSetTemperatur & "=" & modMBUS_SMS.Errorstring(FW2_USSetTemperatur)
|
|
End If
|
|
|
|
modMBUS_SMS.IECCOM_CloseCom
|
|
Exit Function
|
|
Errorhandler:
|
|
ErrorMsg ("Fehler " & Err.Number & " in FW2_USSetTemperatur: " & Err.Description)
|
|
End Function
|
|
|
|
|
|
Public Function FW2_SetzeSchloss(Einbauplatz As CEinbauplatz, blnOpen As Boolean) As Integer
|
|
Dim WdhCounter As Integer
|
|
FW2_SetzeSchloss = modMBUS_SMS.fw2_open_comport(Einbauplatz.m_iComport, 2400, Einbauplatz.m_strMapfile, True, 3)
|
|
If FW2_SetzeSchloss = modMBUS_SMS.MBUS_SMS_ERR_OK Then
|
|
If blnOpen Then
|
|
|
|
WdhCounter = 0
|
|
WDH_Open:
|
|
FW2_SetzeSchloss = modMBUS_SMS.open_fw2
|
|
If FW2_SetzeSchloss = 0 Then
|
|
WriteToFW2Logfile Einbauplatz, "FW2_SetzeSchloss(): open_fw2 OK"
|
|
'ElseIf FW2_SetzeSchloss = MBUS_SMS_ERR_TIMEOUT And WdhCounter < FW2ANZAHLWDH Then
|
|
ElseIf WdhCounter < FW2ANZAHLWDH Then
|
|
WriteToFW2Logfile Einbauplatz, "FW2_SetzeSchloss(): Fehler " & FW2_SetzeSchloss & " in open_fw2. Wdh=" & WdhCounter
|
|
Sleep FW2_WDH_DELAY
|
|
WdhCounter = WdhCounter + 1
|
|
GoTo WDH_Open
|
|
Else
|
|
WriteToFW2Logfile Einbauplatz, "Fehler in FW2_SetzeSchloss() bei open_fw2=" & FW2_SetzeSchloss & "=" & modMBUS_SMS.Errorstring(FW2_SetzeSchloss)
|
|
End If
|
|
Else
|
|
WdhCounter = 0
|
|
WDH_Close:
|
|
FW2_SetzeSchloss = modMBUS_SMS.close_fw2
|
|
If FW2_SetzeSchloss = 0 Then
|
|
WriteToFW2Logfile Einbauplatz, "FW2_SetzeSchloss(): close_fw2 OK"
|
|
'ElseIf FW2_SetzeSchloss = MBUS_SMS_ERR_TIMEOUT And WdhCounter < FW2ANZAHLWDH Then
|
|
ElseIf WdhCounter < FW2ANZAHLWDH Then
|
|
WriteToFW2Logfile Einbauplatz, "FW2_SetzeSchloss(): Fehler " & FW2_SetzeSchloss & " in close_fw2. Wdh=" & WdhCounter
|
|
Sleep FW2_WDH_DELAY
|
|
WdhCounter = WdhCounter + 1
|
|
GoTo WDH_Close
|
|
Else
|
|
WriteToFW2Logfile Einbauplatz, "Fehler in FW2_SetzeSchloss() bei close_fw2: " & FW2_SetzeSchloss & "=" & modMBUS_SMS.Errorstring(FW2_SetzeSchloss)
|
|
End If
|
|
|
|
End If
|
|
End If
|
|
modMBUS_SMS.IECCOM_CloseCom
|
|
Exit Function
|
|
Errorhandler:
|
|
ErrorMsg ("Fehler " & Err.Number & " in FW2_SetzeSchloss: " & Err.Description)
|
|
End Function
|
|
|
|
|
|
Public Function Get_u8_System_Flags_from_Auftragfile(Einbauplatz As CEinbauplatz, byte_u8_system_flags As Byte) As Boolean
|
|
Dim objTextstreamCompareFile As TextStream
|
|
Dim fso As scripting.FileSystemObject
|
|
Dim strKonfigFile As String
|
|
Dim strLine As String
|
|
Dim arZeile() As String
|
|
|
|
On Error GoTo Errorhandler
|
|
|
|
strKonfigFile = Einbauplatz.m_strCompareFile
|
|
Set fso = New scripting.FileSystemObject
|
|
Get_u8_System_Flags_from_Auftragfile = False
|
|
|
|
Set objTextstreamCompareFile = fso.OpenTextFile(strKonfigFile, ForReading, False, TristateMixed)
|
|
|
|
'F;117;1;u8;F;F;0;0;T;0x00;0;u8_system_flags;1075;F;0x00;0
|
|
|
|
Do
|
|
strLine = objTextstreamCompareFile.ReadLine
|
|
arZeile = Split(strLine, ";")
|
|
Debug.Print strLine
|
|
If UBound(arZeile) >= 15 Then
|
|
If LCase(Trim(arZeile(11))) = "u8_system_flags" Then
|
|
If Val(arZeile(15)) <= 255 Then
|
|
byte_u8_system_flags = Val(arZeile(15))
|
|
Get_u8_System_Flags_from_Auftragfile = True
|
|
Exit Function
|
|
''''''''''''''''''''''''''''''''''''''''''''''
|
|
Else
|
|
GoTo Errorhandler
|
|
End If
|
|
End If
|
|
End If
|
|
Loop While Not objTextstreamCompareFile.AtEndOfStream
|
|
WriteToFW2Logfile Einbauplatz, "Ebp " & Einbauplatz.getNr & ": u8_system_flags konnte nicht aus Configfile " & strKonfigFile & " bestimmt werden."
|
|
Exit Function
|
|
Errorhandler:
|
|
If Err.Number > 0 Then
|
|
WriteToFW2Logfile Einbauplatz, " u8_system_flags konnte bestimmt werden. Fehler " & Err.Number & ": " & Err.Description & ", Configfile=" & strKonfigFile
|
|
Else
|
|
WriteToFW2Logfile Einbauplatz, " u8_system_flags konnte nicht aus Configfile " & strKonfigFile & ", Zeile '" & strLine & "' bestimmt werden."
|
|
End If
|
|
End Function
|
|
|
|
|
|
Public Function FW2_SetOptoTimeout(Einbauplatz As CEinbauplatz, blnReset As Boolean) As Integer
|
|
Dim WdhCounter As Integer
|
|
Dim bytSystemflags As Byte
|
|
|
|
' wenn blnReset = false : vor der Prüfung wird Bit0 auf 0 gesetzt
|
|
' wenn blnReset = true : nach der Prüfung wird der Wert wieder auf den richtigen Wert zurückgesetzt bz
|
|
|
|
FW2_SetOptoTimeout = modMBUS_SMS.fw2_open_comport(Einbauplatz.m_iComport, 2400, Einbauplatz.m_strMapfile, True, 3)
|
|
WdhCounter = 0
|
|
|
|
|
|
If FW2_SetOptoTimeout = 0 Then
|
|
WDH_SetOptoTimeout_FW2:
|
|
If blnReset = False Then
|
|
' u8_system_flags Wert lesen
|
|
FW2_SetOptoTimeout = modMBUS_SMS.ReadValue("u8_system_flags", bytSystemflags)
|
|
|
|
If FW2_SetOptoTimeout = MBUS_SMS_ERR_OK Then
|
|
WriteToFW2Logfile Einbauplatz, "lese u8_system_flags=" & vbTab & bytSystemflags
|
|
ElseIf WdhCounter < FW2ANZAHLWDH Then
|
|
WriteToFW2Logfile Einbauplatz, "FW2_SetOptoTimeout(): Fehler " & FW2_SetOptoTimeout & " . Wdh=" & WdhCounter
|
|
Sleep FW2_WDH_DELAY
|
|
WdhCounter = WdhCounter + 1
|
|
GoTo WDH_SetOptoTimeout_FW2
|
|
Else
|
|
WriteToFW2Logfile Einbauplatz, "Fehler in FW2_SetOptoTimeout(): lese u8_system_flags: " & FW2_SetOptoTimeout & "=" & modMBUS_SMS.Errorstring(FW2_SetOptoTimeout)
|
|
GoTo CloseCom
|
|
End If
|
|
|
|
' u8_system_flags Wert merken
|
|
Einbauplatz.getPruefzaehler.m_b_u8_system_flags = bytSystemflags
|
|
Einbauplatz.getPruefzaehler.m_b_u8_system_flags_saved = True
|
|
|
|
' bit 0 löschen
|
|
bytSystemflags = bytSystemflags And Not 2 ^ 0
|
|
WriteToFW2Logfile Einbauplatz, "Bit 0 von u8_system_flags löschen: " & Einbauplatz.getPruefzaehler.m_b_u8_system_flags & " => " & bytSystemflags
|
|
Else
|
|
' Reset
|
|
If Get_u8_System_Flags_from_Auftragfile(Einbauplatz, bytSystemflags) Then
|
|
' Wert konnte aus dem Auftragsfile gelesen werden
|
|
WriteToFW2Logfile Einbauplatz, "u8_system_flags aus dem " & Einbauplatz.m_strCompareFile & " = " & bytSystemflags & " zur Wiederherstellung nutzen."
|
|
Else
|
|
' Wert konnte aus dem Auftragsfile NICHT gelesen werden
|
|
If Einbauplatz.getPruefzaehler.m_b_u8_system_flags_saved = True Then
|
|
'bytSystemflags wieder auf Originalwert setzen
|
|
bytSystemflags = Einbauplatz.getPruefzaehler.m_b_u8_system_flags
|
|
WriteToFW2Logfile Einbauplatz, "u8_system_flags wieder auf " & Einbauplatz.getPruefzaehler.m_b_u8_system_flags & " zurücksetzen:"
|
|
Einbauplatz.getPruefzaehler.m_b_u8_system_flags_saved = False
|
|
Else
|
|
WriteToFW2Logfile Einbauplatz, "u8_system_flags wude nicht verändert"
|
|
'bytSystemflags nicht schreiben, da kein Wert zwischengespeichert wurde
|
|
GoTo CloseCom
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
WDH_SetOptoTimeout_FW2_2:
|
|
|
|
FW2_SetOptoTimeout = modMBUS_SMS.WriteValue("u8_system_flags", bytSystemflags)
|
|
|
|
If FW2_SetOptoTimeout = MBUS_SMS_ERR_OK Then
|
|
WriteToFW2Logfile Einbauplatz, "schreibe u8_system_flags=" & vbTab & bytSystemflags
|
|
ElseIf WdhCounter < FW2ANZAHLWDH Then
|
|
WriteToFW2Logfile Einbauplatz, "FW2_SetOptoTimeout(): Timeout. Wdh=" & WdhCounter
|
|
Sleep FW2_WDH_DELAY
|
|
WdhCounter = WdhCounter + 1
|
|
GoTo WDH_SetOptoTimeout_FW2_2
|
|
Else
|
|
WriteToFW2Logfile Einbauplatz, "Fehler in FW2_SetOptoTimeout(): schreibe u8_system_flags=" & bytSystemflags & ": " & FW2_SetOptoTimeout & "=" & modMBUS_SMS.Errorstring(FW2_SetOptoTimeout)
|
|
End If
|
|
Else
|
|
WriteToFW2Logfile Einbauplatz, "Fehler in FW2_SetOptoTimeout(): fw2_open_comport: " & FW2_SetOptoTimeout & "=" & modMBUS_SMS.Errorstring(FW2_SetOptoTimeout)
|
|
End If
|
|
|
|
CloseCom:
|
|
modMBUS_SMS.IECCOM_CloseCom
|
|
End Function
|
|
|
|
Public Function FW2_Init_KEV1(Einbauplatz As CEinbauplatz) As Integer
|
|
Dim bytValue As Byte
|
|
Dim WdhCounter As Integer
|
|
|
|
FW2_Init_KEV1 = modMBUS_SMS.fw2_open_comport(Einbauplatz.m_iComport, 2400, Einbauplatz.m_strMapfile, True, 3)
|
|
If FW2_Init_KEV1 = 0 Then
|
|
|
|
WdhCounter = 0
|
|
WDH_Init_FW2:
|
|
FW2_Init_KEV1 = modMBUS_SMS.Init_FW2(modMBUS_SMS.INIT_KEV1)
|
|
If FW2_Init_KEV1 = 0 Then
|
|
|
|
WdhCounter = 0
|
|
WDH_u8_flagreg:
|
|
FW2_Init_KEV1 = modMBUS_SMS.ReadValue("u8_flagreg", bytValue)
|
|
If FW2_Init_KEV1 = 0 Then
|
|
If bytValue And 2 ^ 6 = 2 ^ 6 Then
|
|
WriteToFW2Logfile Einbauplatz, "FW2_Init_KEV1(): lese u8_flagreg = " & vbTab & bytValue & ", BIT6=1 OK"
|
|
Else
|
|
WriteToFW2Logfile Einbauplatz, "FW2_Init_KEV1(): lese u8_flagreg = " & vbTab & bytValue & ", BIT6 !=1 WARNUNG"
|
|
End If
|
|
'ElseIf FW2_Init_KEV1 = MBUS_SMS_ERR_TIMEOUT And WdhCounter < FW2ANZAHLWDH Then
|
|
ElseIf WdhCounter < FW2ANZAHLWDH Then
|
|
Sleep FW2_WDH_DELAY
|
|
WdhCounter = WdhCounter + 1
|
|
WriteToFW2Logfile Einbauplatz, "FW2_Init_KEV1(): Fehler " & FW2_Init_KEV1 & " beim Lesen von u8_flagreg. Wdh=" & WdhCounter
|
|
GoTo WDH_u8_flagreg
|
|
Else
|
|
WriteToFW2Logfile Einbauplatz, "Fehler in FW2_Init_KEV1() bei ReadValue(u8_flagreg): " & FW2_Init_KEV1 & "=" & modMBUS_SMS.Errorstring(FW2_Init_KEV1)
|
|
End If
|
|
'ElseIf FW2_Init_KEV1 = MBUS_SMS_ERR_TIMEOUT And WdhCounter < FW2ANZAHLWDH Then
|
|
ElseIf WdhCounter < FW2ANZAHLWDH Then
|
|
WriteToFW2Logfile Einbauplatz, "FW2_Init_KEV1(): Fehler " & FW2_Init_KEV1 & " bei Init_FW2 mit INIT_KEV1. Wdh=" & WdhCounter
|
|
Sleep FW2_WDH_DELAY
|
|
WdhCounter = WdhCounter + 1
|
|
GoTo WDH_Init_FW2
|
|
Else
|
|
WriteToFW2Logfile Einbauplatz, "Fehler in FW2_Init_KEV1() bei Init_FW2: " & FW2_Init_KEV1 & "=" & modMBUS_SMS.Errorstring(FW2_Init_KEV1)
|
|
End If
|
|
End If
|
|
modMBUS_SMS.IECCOM_CloseCom
|
|
Exit Function
|
|
Errorhandler:
|
|
ErrorMsg ("Fehler " & Err.Number & " in FW2_Init_KEV1: " & Err.Description)
|
|
End Function
|
|
|
|
|
|
Function FW2_GetUSVolumen(Einbauplatz As CEinbauplatz, ByRef dblResult As Double) As Integer
|
|
Dim bytScaling As Byte
|
|
Dim sngWert As Single
|
|
Dim WdhCounter As Integer
|
|
|
|
On Error GoTo Errorhandler
|
|
|
|
FW2_GetUSVolumen = modMBUS_SMS.fw2_open_comport(Einbauplatz.m_iComport, 2400, Einbauplatz.m_strMapfile, True, 3)
|
|
If FW2_GetUSVolumen <> 0 Then
|
|
WriteToFW2Logfile Einbauplatz, "Fehler in FW2_GetUSVolumen() bei fw2_open_comport(): " & FW2_GetUSVolumen & "=" & modMBUS_SMS.Errorstring(FW2_GetUSVolumen)
|
|
GoTo CloseCom
|
|
End If
|
|
|
|
|
|
'''''''''''''''''''''''''''''''' u8_scaling '''''''''''''''''''''''''''''''
|
|
WdhCounter = 0
|
|
WDH_u8_scaling:
|
|
|
|
FW2_GetUSVolumen = read_Byte("u8_scaling", bytScaling)
|
|
If FW2_GetUSVolumen = 0 Then
|
|
WriteToFW2Logfile Einbauplatz, "lese u8_scaling=" & vbTab & bytScaling
|
|
'ElseIf FW2_GetUSVolumen = MBUS_SMS_ERR_TIMEOUT And WdhCounter < FW2ANZAHLWDH Then
|
|
ElseIf WdhCounter < FW2ANZAHLWDH Then
|
|
WriteToFW2Logfile Einbauplatz, "FW2_GetUSVolumen(): Fehler " & FW2_GetUSVolumen & " beim Lesen u8_scaling. Wdh=" & WdhCounter
|
|
Sleep FW2_WDH_DELAY
|
|
WdhCounter = WdhCounter + 1
|
|
GoTo WDH_u8_scaling
|
|
Else
|
|
WriteToFW2Logfile Einbauplatz, "Fehler in FW2_GetUSVolumen() bei read_Byte(u8_scaling): " & FW2_GetUSVolumen & "=" & modMBUS_SMS.Errorstring(FW2_GetUSVolumen)
|
|
GoTo CloseCom
|
|
End If
|
|
|
|
'''''''''''''''''''''''''''''''' f_nowa_volume '''''''''''''''''''''''''''''''
|
|
WdhCounter = 0
|
|
WDH_f_nowa_volume:
|
|
|
|
FW2_GetUSVolumen = read_Float("f_nowa_volume", sngWert)
|
|
If FW2_GetUSVolumen = 0 Then
|
|
WriteToFW2Logfile Einbauplatz, "lese f_nowa_volume=" & vbTab & sngWert
|
|
'ElseIf FW2_GetUSVolumen = MBUS_SMS_ERR_TIMEOUT And WdhCounter < FW2ANZAHLWDH Then
|
|
ElseIf WdhCounter < FW2ANZAHLWDH Then
|
|
WriteToFW2Logfile Einbauplatz, "FW2_GetUSVolumen(): Fehler " & FW2_GetUSVolumen & " beim Lesen f_nowa_volume. Wdh: " & WdhCounter
|
|
Sleep FW2_WDH_DELAY
|
|
WdhCounter = WdhCounter + 1
|
|
GoTo WDH_f_nowa_volume
|
|
Else
|
|
WriteToFW2Logfile Einbauplatz, "Fehler in FW2_GetUSVolumen() bei read_Float(f_nowa_volume): " & FW2_GetUSVolumen & "=" & modMBUS_SMS.Errorstring(FW2_GetUSVolumen)
|
|
GoTo CloseCom
|
|
End If
|
|
|
|
dblResult = CDbl(sngWert)
|
|
Select Case bytScaling
|
|
Case 0: ' Faktor = 1
|
|
Case 1: dblResult = dblResult * 10
|
|
Case 2: dblResult = dblResult * 100
|
|
Case 3: dblResult = dblResult * 1000
|
|
Case Else
|
|
WriteToFW2Logfile Einbauplatz, "FW2_GetUSVolumen(): kein Faktor definiert für u8_scaling=" & bytScaling
|
|
End Select
|
|
|
|
dblResult = dblResult / 1000
|
|
WriteToFW2Logfile Einbauplatz, "US Volumen [m³] =" & vbTab & dblResult
|
|
CloseCom:
|
|
On Error Resume Next
|
|
modMBUS_SMS.IECCOM_CloseCom
|
|
Exit Function
|
|
Errorhandler:
|
|
ErrorMsg "Fehler " & Err.Number & " in FW2_GetUSVolumen: " & Err.Description
|
|
WriteToFW2Logfile Einbauplatz, "Fehler " & Err.Number & " in FW2_GetUSVolumen: " & Err.Description
|
|
End Function
|
|
|
|
|
|
Function FW2_GetUS_NOWA_Zeit(Einbauplatz As CEinbauplatz, ByRef dblZeit_ms As Double) As Integer
|
|
Dim WdhCounter As Integer
|
|
On Error GoTo Errorhandler
|
|
|
|
FW2_GetUS_NOWA_Zeit = modMBUS_SMS.fw2_open_comport(Einbauplatz.m_iComport, 2400, Einbauplatz.m_strMapfile, True, 3)
|
|
If FW2_GetUS_NOWA_Zeit = MBUS_SMS_ERR_OK Then
|
|
|
|
WdhCounter = 0
|
|
WDH_u16_NOWA_Timer:
|
|
|
|
FW2_GetUS_NOWA_Zeit = modMBUS_SMS.ReadValue("u16_NOWA_Timer", dblZeit_ms)
|
|
|
|
If FW2_GetUS_NOWA_Zeit = MBUS_SMS_ERR_OK Then
|
|
WriteToFW2Logfile Einbauplatz, "lese u16_NOWA_Timer=" & vbTab & dblZeit_ms
|
|
dblZeit_ms = 62.5 * dblZeit_ms
|
|
WriteToFW2Logfile Einbauplatz, "NOWA_Zeit [ms] =" & vbTab & dblZeit_ms
|
|
'ElseIf FW2_GetUS_NOWA_Zeit = MBUS_SMS_ERR_TIMEOUT And WdhCounter < FW2ANZAHLWDH Then
|
|
ElseIf WdhCounter < FW2ANZAHLWDH Then
|
|
WriteToFW2Logfile Einbauplatz, "Fehler " & FW2_GetUS_NOWA_Zeit & " in FW2_GetUS_NOWA_Zeit() bei ReadValue(u16_NOWA_Timer). Wdh=" & WdhCounter
|
|
Sleep FW2_WDH_DELAY
|
|
WdhCounter = WdhCounter + 1
|
|
GoTo WDH_u16_NOWA_Timer
|
|
Else
|
|
WriteToFW2Logfile Einbauplatz, "Fehler in FW2_GetUS_NOWA_Zeit bei ReadValue(u16_NOWA_Timer): " & FW2_GetUS_NOWA_Zeit & "=" & modMBUS_SMS.Errorstring(FW2_GetUS_NOWA_Zeit)
|
|
End If
|
|
Else
|
|
WriteToFW2Logfile Einbauplatz, "Fehler in FW2_GetUS_NOWA_Zeit() bei fw2_open_comport: " & FW2_GetUS_NOWA_Zeit & "=" & modMBUS_SMS.Errorstring(FW2_GetUS_NOWA_Zeit)
|
|
End If
|
|
|
|
modMBUS_SMS.IECCOM_CloseCom
|
|
Exit Function
|
|
|
|
Errorhandler:
|
|
ErrorMsg "Fehler " & Err.Number & " in FW2_GetUS_NOWA_Zeit: " & Err.Description
|
|
WriteToFW2Logfile Einbauplatz, "Fehler " & Err.Number & " in FW2_GetUS_NOWA_Zeit: " & Err.Description
|
|
End Function
|
|
|
|
Public Function FW2_writeVar(Einbauplatz As CEinbauplatz, strVarname As String, varWert As Variant, Optional blnOpenComPort As Boolean = True) As Integer
|
|
Dim WdhCounter As Integer
|
|
On Error GoTo Errorhandler
|
|
|
|
WdhCounter = 0
|
|
|
|
WDH_WriteValue:
|
|
|
|
If blnOpenComPort Then
|
|
FW2_writeVar = modMBUS_SMS.fw2_open_comport(Einbauplatz.m_iComport, 2400, Einbauplatz.m_strMapfile, True, 3)
|
|
Else
|
|
FW2_writeVar = 0
|
|
End If
|
|
|
|
If FW2_writeVar = 0 Then
|
|
FW2_writeVar = modMBUS_SMS.WriteValue(strVarname, varWert)
|
|
If FW2_writeVar = MBUS_SMS_ERR_OK Then
|
|
WriteToFW2Logfile Einbauplatz, "schreibe " & strVarname & "=" & vbTab & varWert
|
|
'ElseIf FW2_writeVar = MBUS_SMS_ERR_TIMEOUT And WdhCounter < FW2ANZAHLWDH Then
|
|
ElseIf WdhCounter < FW2ANZAHLWDH Then
|
|
WriteToFW2Logfile Einbauplatz, "Fehler " & FW2_writeVar & " = " & modMBUS_SMS.Errorstring(FW2_writeVar) & " bei WriteValue(" & strVarname & "," & varWert & "). Wdh=" & WdhCounter
|
|
Sleep FW2_WDH_DELAY
|
|
WdhCounter = WdhCounter + 1
|
|
GoTo WDH_WriteValue
|
|
Else
|
|
WriteToFW2Logfile Einbauplatz, "Fehler bei WriteValue(" & strVarname & "," & varWert & "): " & FW2_writeVar & "=" & modMBUS_SMS.Errorstring(FW2_writeVar)
|
|
GoTo Fehlerdialog
|
|
End If
|
|
Else
|
|
WriteToFW2Logfile Einbauplatz, "Fehler in FW2_writeVar(Ebp=" & Einbauplatz.getNr & ") bei fw2_open_comport(comport=" & Einbauplatz.m_iComport & "): " & FW2_writeVar & "=" & modMBUS_SMS.Errorstring(FW2_writeVar)
|
|
GoTo Fehlerdialog
|
|
End If
|
|
|
|
If blnOpenComPort Then
|
|
modMBUS_SMS.IECCOM_CloseCom
|
|
End If
|
|
|
|
Exit Function
|
|
Fehlerdialog:
|
|
Dim iret As Integer
|
|
iret = MsgBox("Beim Schreiben der Variablen '" & strVarname & "' in das Rechenwerk (Einbauplatz " & Einbauplatz.getNr & ") gab es wiederholt einen Fehler: (" & FW2_writeVar & ") " & modMBUS_SMS.Errorstring(FW2_writeVar) & vbCrLf & "Überprüfen Sie die Verbindung und klicken Sie auf Wiederholen!", vbRetryCancel)
|
|
If iret = vbRetry Then
|
|
GoTo WDH_WriteValue
|
|
End If
|
|
If blnOpenComPort Then
|
|
modMBUS_SMS.IECCOM_CloseCom
|
|
End If
|
|
Exit Function
|
|
Errorhandler:
|
|
WriteToFW2Logfile Einbauplatz, "Fehler " & Err.Number & " in FW2_writeVar(" & strVarname & "," & varWert & "): " & Err.Description
|
|
End Function
|
|
|
|
|
|
Public Function FW2_ReadVar(Einbauplatz As CEinbauplatz, strVarname As String, ByRef varWert As Variant, Optional blnOpenComPort As Boolean = True) As Integer
|
|
Dim WdhCounter As Integer
|
|
On Error GoTo Errorhandler
|
|
|
|
If blnOpenComPort Then
|
|
FW2_ReadVar = modMBUS_SMS.fw2_open_comport(Einbauplatz.m_iComport, 2400, Einbauplatz.m_strMapfile, True, 3)
|
|
Else
|
|
FW2_ReadVar = 0
|
|
End If
|
|
|
|
If FW2_ReadVar = 0 Then
|
|
''''''''''''''''''''''
|
|
WdhCounter = 0
|
|
WDH_ReadValue:
|
|
FW2_ReadVar = modMBUS_SMS.ReadValue(strVarname, varWert)
|
|
If FW2_ReadVar = MBUS_SMS_ERR_OK Then
|
|
WriteToFW2Logfile Einbauplatz, "lese " & strVarname & "=" & vbTab & varWert
|
|
'ElseIf FW2_ReadVar = MBUS_SMS_ERR_TIMEOUT And WdhCounter < FW2ANZAHLWDH Then
|
|
ElseIf WdhCounter < FW2ANZAHLWDH Then
|
|
WriteToFW2Logfile Einbauplatz, "Fehler " & FW2_ReadVar & " in FW2_ReadVar bei ReadValue(" & strVarname & "). Wdh=" & WdhCounter
|
|
Sleep FW2_WDH_DELAY
|
|
WdhCounter = WdhCounter + 1
|
|
GoTo WDH_ReadValue
|
|
Else
|
|
WriteToFW2Logfile Einbauplatz, "Fehler in FW2_ReadVar() bei ReadValue(" & strVarname & "): " & FW2_ReadVar & "=" & modMBUS_SMS.Errorstring(FW2_ReadVar)
|
|
End If
|
|
'''''''''''''''''''''''
|
|
Else
|
|
WriteToFW2Logfile Einbauplatz, "Fehler in FW2_ReadVar(" & strVarname & ") bei fw2_open_comport: " & FW2_ReadVar & "=" & modMBUS_SMS.Errorstring(FW2_ReadVar)
|
|
End If
|
|
|
|
If blnOpenComPort Then
|
|
modMBUS_SMS.IECCOM_CloseCom
|
|
End If
|
|
|
|
Exit Function
|
|
Errorhandler:
|
|
WriteToFW2Logfile Einbauplatz, "Fehler " & Err.Number & " in FW2_ReadVar(" & strVarname & "): " & Err.Description
|
|
End Function
|
|
|
|
Public Function FW2_SetTimeToZero(Einbauplatz As CEinbauplatz, Optional blnOpenComPort As Boolean = True) As Integer
|
|
On Error GoTo Errorhandler
|
|
|
|
' laut F.Leidel 18.9.2013: Opto Schnittstelle für 48 Stunden offen halten
|
|
'' FW2_SetTimeToZero = FW2_writeVar(Einbauplatz, "u8_next_st", 48, blnOpenComPort)
|
|
|
|
FW2_SetTimeToZero = FW2_writeVar(Einbauplatz, "u8_seconds", 1, blnOpenComPort)
|
|
FW2_SetTimeToZero = FW2_writeVar(Einbauplatz, "u8_min", 1, blnOpenComPort)
|
|
FW2_SetTimeToZero = FW2_writeVar(Einbauplatz, "u8_std", 0, blnOpenComPort)
|
|
Exit Function
|
|
Errorhandler:
|
|
MsgBox "Fehler " & Err.Number & " in FW2_SetTimeToZero(): " & Err.Description
|
|
End Function
|
|
|
|
|
|
Public Function FW2_SetTime(Einbauplatz As CEinbauplatz, dblTime As Double, Optional blnOpenComPort As Boolean = True) As Integer
|
|
On Error GoTo Errorhandler
|
|
Dim byteSeconds As Byte
|
|
Dim byteminute As Byte
|
|
Dim bytehour As Byte
|
|
|
|
byteSeconds = Second(dblTime)
|
|
byteminute = Minute(dblTime)
|
|
bytehour = Hour(dblTime)
|
|
|
|
' Standard setzen Opto Off Time
|
|
''FW2_SetTime = FW2_writeVar(Einbauplatz, "u8_next_st", 24, blnOpenComPort)
|
|
|
|
FW2_SetTime = FW2_writeVar(Einbauplatz, "u8_seconds", byteSeconds, blnOpenComPort)
|
|
FW2_SetTime = FW2_writeVar(Einbauplatz, "u8_min", byteminute, blnOpenComPort)
|
|
FW2_SetTime = FW2_writeVar(Einbauplatz, "u8_std", bytehour, blnOpenComPort)
|
|
|
|
Exit Function
|
|
Errorhandler:
|
|
MsgBox "Fehler " & Err.Number & " in FW2_SetTime(): " & Err.Description
|
|
End Function
|
|
|
|
Public Function FW2_GetTime(ByRef Einbauplatz As CEinbauplatz, ByRef dblTimeOut As Double, Optional blnOpenComPort As Boolean = True) As Integer
|
|
On Error GoTo Errorhandler
|
|
|
|
Dim byteSeconds As Byte
|
|
Dim byteminute As Byte
|
|
Dim bytehour As Byte
|
|
|
|
FW2_GetTime = FW2_ReadVar(Einbauplatz, "u8_std", bytehour, blnOpenComPort)
|
|
FW2_GetTime = FW2_ReadVar(Einbauplatz, "u8_min", byteminute, blnOpenComPort)
|
|
FW2_GetTime = FW2_ReadVar(Einbauplatz, "u8_seconds", byteSeconds, blnOpenComPort)
|
|
|
|
dblTimeOut = TimeSerial(bytehour, byteminute, byteSeconds)
|
|
Exit Function
|
|
|
|
Errorhandler:
|
|
MsgBox "Fehler " & Err.Number & " in FW2_GetTime(): " & Err.Description
|
|
End Function
|
|
|
|
|
|
|
|
|
|
Public Function FW2_Schloss_schliessen_und_Fortschrittrueckmeldung(Einbauplatz As CEinbauplatz) As Boolean
|
|
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
' Schloss schließen
|
|
' Schloss geschlossen überprüfen
|
|
'
|
|
' Schloss geschlossen in Datenbank vermerken
|
|
' Schloss geschlossen protokollieren
|
|
' Fortschrittrückmeldung "G" für diesen einen Zähler, wenn noch nicht bereits erledigt
|
|
' TLMenge in Auftragposition vermerken
|
|
' wenn TLMenge = Menge dann FertMeld_GTerm_Dat und FertMeld_GTerm_MA setzen
|
|
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
Dim byteSchloss As Byte
|
|
Dim AuftragPosition As CAuftragPosition
|
|
Dim AuftragpositionSerienNr As CAuftragPositionSerienNr
|
|
Dim Pruefzaehler As CPruefzaehler
|
|
|
|
Dim ret As Integer
|
|
Dim strSQL As String
|
|
Dim rs As CRecordset
|
|
Dim recordsaffected As Long
|
|
Dim errnum As Long
|
|
Dim errdesc As String
|
|
|
|
On Error GoTo Errorhandler
|
|
|
|
Set Pruefzaehler = Einbauplatz.getPruefzaehler
|
|
Set AuftragPosition = Pruefzaehler.getAuftragPosition
|
|
Set AuftragpositionSerienNr = Pruefzaehler.getAuftragPositionSerienNr
|
|
|
|
Wiederholen_Lesen_1:
|
|
''''''''''''''''''''''''''''''''''''''
|
|
' Schloss überprüfen, sollte noch offen sein
|
|
ret = modUSchall.FW2_ReadVar(Einbauplatz, "u8_schloss", byteSchloss)
|
|
If ret <> 0 Then
|
|
ret = MsgBox("Das Schloss konnte nicht überprüft werden. " & modMBUS_SMS.Errorstring(ret), vbAbortRetryIgnore)
|
|
Select Case ret
|
|
Case vbRetry
|
|
GoTo Wiederholen_Lesen_1
|
|
Case vbIgnore
|
|
' egal, weitermachen!
|
|
Case vbAbort
|
|
FW2_Schloss_schliessen_und_Fortschrittrueckmeldung = False
|
|
Exit Function
|
|
End Select
|
|
Else
|
|
Select Case byteSchloss
|
|
Case 165
|
|
' Schloss ist offen, alles OK
|
|
Case 90
|
|
' OK geschlossen
|
|
MsgBox "Das Schloss im Rechenwerk von Einbauplazt " & Einbauplatz.getNr & " ist schon geschlossen.", vbInformation
|
|
End Select
|
|
End If
|
|
''''''''''''''''''''''''''''''''''''''''
|
|
|
|
|
|
Wiederholen_schließen:
|
|
''''''''''''''''''''''''''''''''''''''
|
|
' Schloss schließen
|
|
ret = modUSchall.FW2_SetzeSchloss(Einbauplatz, False)
|
|
If ret <> 0 Then
|
|
ret = MsgBox("Das Schloss im RW konnte nicht verschlossen werden. " & modMBUS_SMS.Errorstring(ret), vbRetryCancel Or vbCritical)
|
|
Select Case ret
|
|
Case vbRetry
|
|
GoTo Wiederholen_schließen
|
|
Case vbCancel
|
|
FW2_Schloss_schliessen_und_Fortschrittrueckmeldung = False
|
|
Exit Function
|
|
End Select
|
|
End If
|
|
''''''''''''''''''''''''''''''''''''''
|
|
|
|
Wiederholen_Schloss_ueberpruefen:
|
|
''''''''''''''''''''''''''''''''''''''
|
|
' Schloss geschlossen überprüfen
|
|
ret = modUSchall.FW2_ReadVar(Einbauplatz, "u8_schloss", byteSchloss)
|
|
If ret <> 0 Then
|
|
ret = MsgBox("Der Status des Schlosses konnte nicht überprüft werden. " & modMBUS_SMS.Errorstring(ret), vbAbortRetryIgnore Or vbCritical)
|
|
Select Case ret
|
|
Case vbRetry
|
|
GoTo Wiederholen_Schloss_ueberpruefen
|
|
Case vbIgnore
|
|
' egal, weitermachen, ohne den Status zu überprüfen
|
|
Case vbAbort
|
|
FW2_Schloss_schliessen_und_Fortschrittrueckmeldung = False
|
|
Exit Function
|
|
End Select
|
|
Else
|
|
Select Case byteSchloss
|
|
Case 165
|
|
' hat leider nicht geklappt, Schloss ist offen
|
|
ret = MsgBox("Das Schloss ist leider noch offen. Möchten Sie das Schließen noch einmal versuchen?", vbRetryCancel Or vbCritical)
|
|
Select Case ret
|
|
Case vbRetry
|
|
GoTo Wiederholen_schließen
|
|
Case vbCancel
|
|
FW2_Schloss_schliessen_und_Fortschrittrueckmeldung = False
|
|
Exit Function
|
|
End Select
|
|
Case 90
|
|
' OK geschlossen
|
|
End Select
|
|
End If
|
|
|
|
''''''''''''''''''''''''''''''''''''''''
|
|
''' GeschlosseneZaehlerAusSerienNrNachtragen
|
|
''''''''''''''''''''''''''''''''''''''''
|
|
|
|
' Schloss als geschlossen in Datenbank vermerken
|
|
' und_Fortschrittrueckmeldung "G" durchführen
|
|
Schloss_Als_Geschlossen_In_Datenbank_vermerken_und_Fortschrittrueckmeldung Einbauplatz.getPruefzaehler.getSerienNr
|
|
''''''''''''''''''''''''''''''''''''''''
|
|
|
|
''''''''''''''''''''''''''''''''''''''''
|
|
' Aus Kompatibilität zu älteren Versionen StatusFlag, Seriennummer, LogIntoDb, mit AuftragpositionSerienNr.save
|
|
AuftragpositionSerienNr.setFW2SchlossGeschlossen True
|
|
''''''''''''''''''''''''''''''''''''''''
|
|
|
|
If Einbauplatz.getPruefzaehler.getAuftragPosition.GetFertigungsauftragNr > 0 Then
|
|
''''''''''''''''''''''''''''''''''''''''''''
|
|
' Schauen, ob ALLE Zaehler der Auftragposition geschlossen sind
|
|
''''''''''''''''''''''''''''''''''''''''''''
|
|
' alle FW2 Zähler der Auftragposition, die geschlossen sind
|
|
strSQL = "SELECT * from FW2_Zaehler_Info where FertigungsauftragNr = " & Einbauplatz.getPruefzaehler.getAuftragPosition.GetFertigungsauftragNr & " and Schloss_geschlossen_Datum is not null"
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, False
|
|
recordsaffected = rs.RecordCount
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
' vermerken der Teilmenge in der Auftragsposition
|
|
AuftragPosition.SetTLMenge_G recordsaffected
|
|
AuftragPosition.save Einbauplatz.getPruefzaehler.getAuftrag
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
' vermerken der Mengen in FW2_Zaehler_Info in allen betroffenen Datensätzen
|
|
Do While Not rs.EOF
|
|
rs.setValue "Geschlossen", recordsaffected
|
|
rs.setValue "Menge", AuftragPosition.getMenge
|
|
rs.update
|
|
rs.MoveNext
|
|
Loop
|
|
|
|
If recordsaffected = AuftragPosition.getMenge Then
|
|
' Auftragsmenge = Anzahl der geschlossenen Zaehler
|
|
'
|
|
' Alle Zähler der Auftragsposition sind komplett geschlossen:
|
|
' FertMeld_GTerm_Dat, FertMeld_GTerm_MA ändern per SQL update in der Statistik/Auftragposition Tabelle
|
|
AuftragPosition.KomplettAlsGeschlossenVerzeichnenUndSpeichern
|
|
End If
|
|
End If
|
|
|
|
FW2_Schloss_schliessen_und_Fortschrittrueckmeldung = True
|
|
|
|
Exit Function
|
|
Errorhandler:
|
|
errnum = Err.Number
|
|
errdesc = Err.Description
|
|
LogIntoDB "Fehler " & errnum & " in Schloss_schliessen():" & errdesc, "Softwarefehler"
|
|
MsgBox "Fehler " & errnum & " in Schloss_schliessen(): " & errdesc
|
|
FW2_Schloss_schliessen_und_Fortschrittrueckmeldung = False
|
|
Exit Function
|
|
Resume
|
|
End Function
|
|
|
|
|
|
|
|
Public Function Schloss_Als_Geschlossen_In_Datenbank_vermerken_und_Fortschrittrueckmeldung(lngSerienNr As Long, Optional strBemerkung As String) As Boolean
|
|
|
|
''''''''''''''''''''''''''''''''''''''''
|
|
' Schloss geschlossen für diesen Zähler in Datenbank vermerken
|
|
''''''''''''''''''''''''''''''''''''''''
|
|
Dim strSQL As String
|
|
Dim rs As CRecordset
|
|
Dim recordsaffected As Long
|
|
|
|
Dim AuftragpositionSerienNr As CAuftragPositionSerienNr
|
|
Dim AuftragPosition As CAuftragPosition
|
|
|
|
Set AuftragpositionSerienNr = New CAuftragPositionSerienNr
|
|
If Not AuftragpositionSerienNr.load(lngSerienNr) Then
|
|
' SerienNr unbekannt, ignore
|
|
Exit Function
|
|
End If
|
|
|
|
Set AuftragPosition = New CAuftragPosition
|
|
If Not AuftragPosition.load(AuftragpositionSerienNr.getAuftragNr, AuftragpositionSerienNr.getPositionNr) Then
|
|
'Position unbekannt, ignore
|
|
Exit Function
|
|
End If
|
|
|
|
' suchen, ob es diese SerienNr schon gibt
|
|
strSQL = "SELECT * from FW2_Zaehler_Info where SerienNr = " & lngSerienNr ''''& " and FabNr = " & m_Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getFabNr
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, False
|
|
Debug.Print strSQL
|
|
|
|
If rs.EOF Then
|
|
' es gibt noch keinen Eintrag
|
|
rs.addNew
|
|
rs.setValue "SerienNr", lngSerienNr
|
|
rs.setValue "FabNr", AuftragpositionSerienNr.getFabNr
|
|
rs.setValue "AuftragNr", AuftragpositionSerienNr.getAuftragNr
|
|
rs.setValue "PositionNr", AuftragpositionSerienNr.getPositionNr
|
|
rs.setValue "FertigungsauftragNr", AuftragPosition.GetFertigungsauftragNr
|
|
rs.setValue "Schloss_geschlossen_Datum", Now
|
|
rs.update
|
|
End If
|
|
|
|
|
|
If Not rs.isFieldNull("Schloss_geschlossen_Datum") Then
|
|
' Es gibt schon einen Eintrag mit geschlossenem Schloss
|
|
'MsgBox "zur Info: Das Schloss für SNr=" & lngSerienNr & " wurde (lt. Datenbank) schon am " & Format(rs.getDateValue("Schloss_geschlossen_Datum"), "dd.mm.yyyy \u\m hh:mm") & " geschlossen."
|
|
LogIntoDB "Das Schloss für SNr=" & lngSerienNr & " wurde (lt. Datenbank) schon am " & Format(rs.getDateValue("Schloss_geschlossen_Datum"), "dd.mm.yyyy \u\m hh:mm") & " geschlossen.", "FW2"
|
|
Else
|
|
' Es gibt schon einen Eintrag, aber Schloss ist nicht geschlossen
|
|
rs.setValue "Schloss_geschlossen_Datum", Now
|
|
rs.update
|
|
|
|
If AuftragPosition.GetFertigungsauftragNr > 0 Then
|
|
Fortschrittrueckmeldung_G_fuer_einen_Zaehler AuftragPosition.GetFertigungsauftragNr
|
|
rs.setValue "SAP_Meldung_G_Datum", Now
|
|
rs.update
|
|
Else
|
|
'MsgBox "Zur Info: Für einen Auftrag mit der FertigungsauftragNr = 0 kann keine Fortschrittrueckmeldung 'G' an SAP erfolgen!"
|
|
End If
|
|
End If
|
|
|
|
|
|
If strBemerkung <> "" Then
|
|
rs.setValue "Bemerkung", strBemerkung
|
|
End If
|
|
|
|
If AuftragPosition.GetFertigungsauftragNr > 0 Then
|
|
' Die Meldung an SAP ist nur sinnvoll für einen Zähler mit Fertigungsauftrag
|
|
Fortschrittrueckmeldung_G_fuer_einen_Zaehler AuftragPosition.GetFertigungsauftragNr, strBemerkung
|
|
rs.setValue "SAP_Meldung_G_Datum", Now
|
|
Else
|
|
' z.B. Testzähler
|
|
End If
|
|
|
|
rs.update
|
|
|
|
Schloss_Als_Geschlossen_In_Datenbank_vermerken_und_Fortschrittrueckmeldung = True
|
|
Exit Function
|
|
|
|
End Function
|
|
|
|
|
|
Public Function Schloss_Als_Geoeffnet_In_Datenbank_vermerken(lngSerienNr As Long, Optional strBemerkung As String) As Boolean
|
|
''''''''''''''''''''''''''''''''''''''''
|
|
' Schloss geoffnet für diesen Zähler in Datenbank vermerken
|
|
''''''''''''''''''''''''''''''''''''''''
|
|
Dim strSQL As String
|
|
Dim rs As CRecordset
|
|
Dim recordsaffected As Long
|
|
|
|
Dim AuftragpositionSerienNr As CAuftragPositionSerienNr
|
|
Dim AuftragPosition As CAuftragPosition
|
|
|
|
Set AuftragpositionSerienNr = New CAuftragPositionSerienNr
|
|
If Not AuftragpositionSerienNr.load(lngSerienNr) Then
|
|
' SerienNr unbekannt, ignore
|
|
Exit Function
|
|
End If
|
|
|
|
Set AuftragPosition = New CAuftragPosition
|
|
If Not AuftragPosition.load(AuftragpositionSerienNr.getAuftragNr, AuftragpositionSerienNr.getPositionNr) Then
|
|
'Position unbekannt, ignore
|
|
Exit Function
|
|
End If
|
|
|
|
' suchen, ob es diese SerienNr schon gibt
|
|
strSQL = "SELECT * from FW2_Zaehler_Info where SerienNr = " & lngSerienNr ''''& " and FabNr = " & m_Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getFabNr
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, False
|
|
Debug.Print strSQL
|
|
|
|
If rs.EOF Then
|
|
' es gibt noch keinen Eintrag
|
|
rs.addNew
|
|
rs.setValue "SerienNr", lngSerienNr
|
|
rs.setValue "FabNr", AuftragpositionSerienNr.getFabNr
|
|
rs.setValue "AuftragNr", AuftragpositionSerienNr.getAuftragNr
|
|
rs.setValue "PositionNr", AuftragpositionSerienNr.getPositionNr
|
|
rs.setValue "FertigungsauftragNr", AuftragPosition.GetFertigungsauftragNr
|
|
|
|
rs.setValue "Schloss_geschlossen_Datum", Null
|
|
|
|
If strBemerkung <> "" Then
|
|
rs.setValue "Bemerkung", strBemerkung
|
|
End If
|
|
|
|
rs.update
|
|
Else
|
|
If rs.isFieldNull("Schloss_geschlossen_Datum") Then
|
|
' Es gibt schon einen Eintrag mit offenem Schloss
|
|
MsgBox "zur Info: Das Schloss für SNr=" & lngSerienNr & " ist (lt. Datenbank) geöffnet. "
|
|
LogIntoDB "Das Schloss für SNr=" & lngSerienNr & " wurde (lt. Datenbank) schon am " & Format(rs.getDateValue("Schloss_geschlossen_Datum"), "dd.mm.yyyy \u\m hh:mm") & " geschlossen.", "FW2"
|
|
Else
|
|
rs.setValue "Schloss_geschlossen_Datum", Null
|
|
rs.update
|
|
End If
|
|
End If
|
|
Schloss_Als_Geoeffnet_In_Datenbank_vermerken = True
|
|
End Function
|
|
|
|
|
|
|
|
Private Function Fortschrittrueckmeldung_G_fuer_einen_Zaehler(lngFertigungsAuftragNr As Long, Optional strBemerkung As String) As Boolean
|
|
Dim rs As CRecordset
|
|
Dim strSQL As String
|
|
|
|
strSQL = "SELECT * from Fortschrittsrueckmeldung where 1=0"
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, False
|
|
|
|
rs.addNew
|
|
rs.setValue "FertigungsauftragNr", lngFertigungsAuftragNr
|
|
rs.setValue "Vorgang", "G"
|
|
rs.setValue "TLMenge", 1
|
|
rs.setValue "Vorgangsnr", 40
|
|
rs.setValue "Version", "Pruef2000 " & App.Major & "." & App.Minor & "." & App.Revision
|
|
rs.setValue "Personalnr", g_App.Mitarbeiter.getPrueferNr
|
|
|
|
If strBemerkung <> "" Then
|
|
rs.setValue "Bemerkung", strBemerkung
|
|
End If
|
|
rs.update
|
|
|
|
If rs.RecordCount = 1 Then
|
|
Fortschrittrueckmeldung_G_fuer_einen_Zaehler = True
|
|
' alles OK
|
|
Else
|
|
LogIntoDB "Fortschrittrueckmeldung_G_fuer_einen_Zaehler konnte nicht gespeichert werden." & vbCrLf & "Bitte bei Fertigungssteuerung melden!", "Datenbank"
|
|
MsgBox "Fortschrittrueckmeldung_G_fuer_einen_Zaehler konnte nicht gespeichert werden." & vbCrLf & "Bitte bei Fertigungssteuerung melden!", vbCritical
|
|
Fortschrittrueckmeldung_G_fuer_einen_Zaehler = False
|
|
End If
|
|
End Function
|
|
|
|
|