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