1770 lines
66 KiB
OpenEdge ABL
1770 lines
66 KiB
OpenEdge ABL
VERSION 1.0 CLASS
|
|
BEGIN
|
|
MultiUse = -1 'True
|
|
Persistable = 0 'NotPersistable
|
|
DataBindingBehavior = 0 'vbNone
|
|
DataSourceBehavior = 0 'vbNone
|
|
MTSTransactionMode = 0 'NotAnMTSObject
|
|
END
|
|
Attribute VB_Name = "CPruefzaehler"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = True
|
|
Attribute VB_PredeclaredId = False
|
|
Attribute VB_Exposed = False
|
|
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
|
|
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
|
|
'==============================================================================
|
|
'
|
|
' File : Pruefzaehler.cls
|
|
' Author : Reinhard Henning
|
|
' Date : 18.03.1999
|
|
' Version: 0.01
|
|
'
|
|
'==============================================================================
|
|
'
|
|
' Abstraktion eines Prüfzählers
|
|
'
|
|
' Hier hier verwalteten Daten stammen aus verschiedenen Datenbanktabellen.
|
|
' Um einen Testprüfzähler, der nicht in der Datenbank gespeichert ist,
|
|
' ebenfalls verwalten zu können, können viele Member über entsprechende
|
|
' set-Methoden von aussen beschrieben werden.
|
|
'
|
|
' Um ein Prüfzählerobjekt aus der Datenbank zu laden, ist nur
|
|
'
|
|
' load(lSerienNr)
|
|
'
|
|
' durchzuführen. Weitere set-Methoden sollten dann nicht
|
|
' mehr verwendet werden.
|
|
'
|
|
'==============================================================================
|
|
'
|
|
' History:
|
|
'
|
|
' Author : Reinhard Henning
|
|
' Date : 18.03.1999
|
|
' Version: 0.01
|
|
'
|
|
' Erste dokumentierte Version.
|
|
'
|
|
' Änderungen:
|
|
' neu 21.7.99:
|
|
' m_KZPVersion
|
|
' m_Bemerkung
|
|
' m_AuftragPositionSerienNr
|
|
'==============================================================================
|
|
|
|
Option Explicit
|
|
|
|
' Private Member
|
|
' --------------
|
|
Private m_lSerienNr As Long ' aus Tabelle "AuftragPositionSerienNr" oder direkt vorgegeben
|
|
Private m_lIdentNr As Long ' aus Tabelle "AuftragPosition"
|
|
Private m_nKZP As Integer ' aus Tabelle "AuftragPosition"
|
|
Private m_sPruefklasseKZ As String ' aus Tabelle "KZP" oder direkt vorgegeben
|
|
|
|
Private m_Auftrag As CAuftrag ' aus Tabelle "Auftrag"
|
|
Private m_AuftragPosition As CAuftragPosition ' aus Tabelle "AuftragPosition"
|
|
|
|
Private m_IdentNr As CIdentNr ' aus Tabelle "IdentNr"
|
|
|
|
Private m_KZP As CKZP ' aus Tabelle "KZP" oder nothing
|
|
Private m_Pruefpunkte As CPruefpunkte ' aus Tabelle "Pruefpunkte" oder nothing
|
|
|
|
Private m_Vorpruefpunkte As CVorpruefpunkte 'neu RH 12.12.2001
|
|
|
|
Private m_KZPVersion As Long ' neu 21.7.99, aus Tabelle KZP und Auftragposition
|
|
Private m_Bemerkung As String ' neu 21.7.99
|
|
Private m_AuftragPositionSerienNr As CAuftragPositionSerienNr ' neu 21.7.99
|
|
Private m_Prueffehler As CPrueffehler
|
|
|
|
Private m_blnAusgedatet As Boolean
|
|
Private m_intAnzahlPaletten As Integer
|
|
|
|
Public m_blnIsEncoder As Boolean
|
|
|
|
Public m_lng_LWLImpulswertigkeit As Long
|
|
Public m_strKundeneigeneSerienNr As String
|
|
|
|
Public m_bNurKaltPruefbar As Boolean ' neu RH 5.6.2013
|
|
|
|
Public m_strPruefpunktInfo As String 'zum testen der Prüfpunkt-Ermittlung
|
|
Public m_Verbundzaehler As CVerbundzaehler
|
|
|
|
'für US FW2 Zähler:
|
|
Public m_b_u8_system_flags_saved As Boolean
|
|
Public m_b_u8_system_flags As Byte
|
|
|
|
|
|
' Member neu initialisieren
|
|
'
|
|
Private Sub init()
|
|
m_lSerienNr = 0
|
|
m_lIdentNr = 0
|
|
m_nKZP = 0
|
|
|
|
|
|
Set m_Auftrag = Nothing
|
|
Set m_AuftragPosition = Nothing
|
|
Set m_IdentNr = Nothing
|
|
Set m_KZP = Nothing
|
|
Set m_Pruefpunkte = New CPruefpunkte
|
|
|
|
|
|
Set m_AuftragPositionSerienNr = Nothing
|
|
End Sub
|
|
|
|
' Serien-Nr. des Prüfzählers neu vorgeben
|
|
'
|
|
Public Sub setSerienNr(lSerienNr As Long)
|
|
m_lSerienNr = lSerienNr
|
|
End Sub
|
|
|
|
' @return Serien-Nr. des Prüfzählers
|
|
'
|
|
Public Function getSerienNr() As Long
|
|
getSerienNr = m_lSerienNr
|
|
End Function
|
|
|
|
Public Function IstVerbundZaehler() As Boolean
|
|
'geändert am 14.02.2003 PF: Zusatztext kann auch "WPV" enthalten
|
|
'geändert am 20.01.2004 PF: TypText kann auch "Meitwin" enthalten
|
|
If Left(m_IdentNr.getTyp, 3) = "WPV" Or _
|
|
Left(m_IdentNr.getTypzusatz, 3) = "WPV" Or _
|
|
Left(m_IdentNr.getTyp, 7) = "Meitwin" Then
|
|
IstVerbundZaehler = True
|
|
End If
|
|
End Function
|
|
|
|
Public Function getAuftragPositionSerienNr() As CAuftragPositionSerienNr
|
|
Set getAuftragPositionSerienNr = m_AuftragPositionSerienNr
|
|
End Function
|
|
|
|
Public Sub SetAuftragPositionSerienNr(AuftragpositionSerienNr As CAuftragPositionSerienNr)
|
|
Set m_AuftragPositionSerienNr = AuftragpositionSerienNr
|
|
End Sub
|
|
|
|
' Ident-Nr. vorgeben
|
|
'
|
|
' @param lIdentNr neue Ident-Nr.
|
|
'
|
|
Public Sub setIdentNr(lIdentNr As Long)
|
|
m_lIdentNr = lIdentNr
|
|
Set m_IdentNr = Nothing
|
|
End Sub
|
|
|
|
' @return hart vorgegebene oder aus "AuftragsPosition" geladene Ident-Nr.
|
|
'
|
|
Public Function getIdentNr() As Long
|
|
getIdentNr = m_lIdentNr
|
|
End Function
|
|
|
|
' @return IdentNr-Objekt oder nothing
|
|
'
|
|
Public Function getIdentNrObj() As CIdentNr
|
|
Set getIdentNrObj = m_IdentNr
|
|
End Function
|
|
|
|
' KZP-Nr. hart vorgeben
|
|
' Um keine Inkonsistenzen entstehen zu lassen, wird
|
|
' ein evtl. bereits vorhandenes KZP-Objekt auf nothing gesetzt!
|
|
'
|
|
' @param nKZP Neue KZP-Nr.
|
|
'
|
|
' @see setPruefklasseKZ
|
|
'
|
|
Public Sub setKZPNr(nKZP As Integer)
|
|
m_nKZP = nKZP
|
|
Set m_KZP = Nothing
|
|
End Sub
|
|
|
|
' @return hart vorgegebene oder aus "AuftragPosition" geladene KZP-Nr.
|
|
'
|
|
Public Function getKZPNr() As Integer
|
|
getKZP = m_nKZP
|
|
End Function
|
|
|
|
|
|
' @return Referenz auf das KZP-Objekt zu der Ident-Nr. der
|
|
' Prüfpunkte oder nothing
|
|
'
|
|
Public Function getKZP() As CKZP
|
|
Set getKZP = m_KZP
|
|
End Function
|
|
|
|
' @return Bemerkung
|
|
Public Function getBemerkung() As String
|
|
getBemerkung = m_Bemerkung
|
|
End Function
|
|
|
|
' erneutes setzen der Bemerkung
|
|
Public Sub setBemerkung(Bemerkung As String)
|
|
m_Bemerkung = Bemerkung
|
|
savebemerkung
|
|
End Sub
|
|
|
|
' Speichert FabNr in zugehörigem Feld von AuftragPsoitionSeriennummer
|
|
Private Sub saveFabNr(lngFabNr As Long)
|
|
Dim sSQL As String
|
|
Dim rs As CRecordset
|
|
|
|
On Error GoTo saveFabNrErr
|
|
|
|
' Schauen, ob es diese Auftragsposition schon gibt
|
|
' ------------------------------------------------
|
|
sSQL = "SELECT * FROM AuftragPositionSerienNr "
|
|
sSQL = sSQL & "WHERE "
|
|
sSQL = sSQL & "SerienNr = " & getSerienNr()
|
|
sSQL = sSQL & " order by Wiederholungen;"
|
|
|
|
Set rs = New CRecordset
|
|
If Not rs.openRS(sSQL) Then Exit Sub
|
|
|
|
If Not rs.EOF() Then
|
|
Call rs.setValue("FabNr", lngFabNr)
|
|
rs.update
|
|
Else
|
|
ErrorMsg "saveFabNr: Es gibt keine FabNr für" & getSerienNr()
|
|
End If
|
|
Exit Sub
|
|
saveFabNrErr:
|
|
ErrorMsg "Konnte FabNr nicht speichern: " & Err
|
|
End Sub
|
|
|
|
' Speichert Bemerkung in zugehörigem Feld von AuftragPsoitionSeriennummer
|
|
Private Sub savebemerkung()
|
|
Dim sSQL As String
|
|
Dim rs As CRecordset
|
|
|
|
On Error GoTo saveBemerkungErr
|
|
|
|
' Schauen, ob es diese Auftragsposition schon gibt
|
|
' ------------------------------------------------
|
|
sSQL = "SELECT * FROM AuftragPositionSerienNr "
|
|
sSQL = sSQL & "WHERE "
|
|
sSQL = sSQL & "SerienNr = " & getSerienNr()
|
|
sSQL = sSQL & " order by Wiederholungen;"
|
|
|
|
Set rs = New CRecordset
|
|
If Not rs.openRS(sSQL) Then Exit Sub
|
|
|
|
If Not rs.EOF() Then
|
|
Call rs.setValue("Bemerkung", getBemerkung())
|
|
rs.update
|
|
Else
|
|
ErrorMsg "saveBemerkung: Es gibt keine Auftragposition für" & getSerienNr()
|
|
End If
|
|
Exit Sub
|
|
saveBemerkungErr:
|
|
ErrorMsg "Konnte Bemerkung nicht speichern: " & Err
|
|
End Sub
|
|
|
|
' Pruefklasse neu vorgeben.
|
|
' Um keine Inkonsistenzen entstehen zu lassen, wird
|
|
' ein evtl. bereits vorhandenes KZP-Objekt auf nothing gesetzt!
|
|
'
|
|
' @param sKZ Neue Prüfklasse
|
|
'
|
|
Public Sub setPruefklasseKZ(sKZ As String)
|
|
m_sPruefklasseKZ = sKZ
|
|
Set m_KZP = Nothing
|
|
End Sub
|
|
|
|
|
|
' @return hart vorgegebenes oder aus dem aus "KZP" geladenes Prüfklassen-Kürzel
|
|
'
|
|
Public Function getPruefklasseKZ() As String
|
|
getPruefklasseKZ = m_sPruefklasseKZ
|
|
End Function
|
|
|
|
' Prüfpunkte-Objekt neu vorgeben
|
|
'
|
|
Public Sub setPruefpunkte(Pruefpunkte As CPruefpunkte)
|
|
Set m_Pruefpunkte = Pruefpunkte
|
|
End Sub
|
|
|
|
' @return Prüfpunkte-Objekt oder nothing
|
|
'
|
|
Public Function getPruefpunkte() As CPruefpunkte
|
|
Set getPruefpunkte = m_Pruefpunkte
|
|
End Function
|
|
|
|
' @return Vorprüfpunkte-Objekt oder nothing
|
|
'
|
|
Public Function getVorpruefpunkte() As CVorpruefpunkte
|
|
If m_Vorpruefpunkte Is Nothing Then
|
|
loadVorpruefpunkte
|
|
End If
|
|
Set getVorpruefpunkte = m_Vorpruefpunkte
|
|
|
|
End Function
|
|
|
|
' Prüfpunkte-Objekt neu vorgeben
|
|
'
|
|
Public Sub setVorpruefpunkte(Vorpruefpunkte As CVorpruefpunkte)
|
|
Set m_Vorpruefpunkte = Vorpruefpunkte
|
|
End Sub
|
|
|
|
' Warmwasserzähler?
|
|
' Die Information hängt von der Ident-Nr. des Zählers bzw.
|
|
' von der Ident-Nr. der Prüfpunkte ab. Die Ident-Nr. der
|
|
' Prüfpunkte wird vorrangig verwendet.
|
|
'
|
|
' @return true = Zähler ist ein Warmwasserzähler
|
|
'
|
|
Public Function isWarmwasserzaehler() As Boolean
|
|
If Not m_IdentNr Is Nothing Then
|
|
isWarmwasserzaehler = m_IdentNr.isWarmwasserzaehler()
|
|
End If
|
|
End Function
|
|
|
|
' Serien-Nr. des Prüfzählers auf Vorhandensein überprüfen
|
|
'
|
|
' @return true = Serien-Nr. des Prüfzählers wurde gefunden
|
|
Public Function testSerienNr(lSerienNr As Long) As Boolean
|
|
Dim AuftragpositionSerienNr As CAuftragPositionSerienNr
|
|
|
|
Set AuftragpositionSerienNr = New CAuftragPositionSerienNr
|
|
If Not AuftragpositionSerienNr.load(lSerienNr) Then
|
|
Exit Function
|
|
End If
|
|
|
|
testSerienNr = True
|
|
End Function
|
|
|
|
Public Function loadForSerienOrFabNummer(lSerienFabNr As Long) As Boolean
|
|
Dim strSQL As String
|
|
Dim rs As CRecordset
|
|
Dim lngSerienNr As Long
|
|
|
|
strSQL = "SELECT SerienNr from AuftragPositionSerienNr where SerienNr = " & lSerienFabNr & " or FabNr = " & lSerienFabNr & " order by AnlageDatum desc"
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, True
|
|
If rs.EOF Then
|
|
loadForSerienOrFabNummer = False
|
|
Exit Function
|
|
Else
|
|
lngSerienNr = rs.getLongValue("SerienNr")
|
|
loadForSerienOrFabNummer = loadForSerienNr(lngSerienNr)
|
|
End If
|
|
End Function
|
|
|
|
Public Function loadForSerienOrKundeneigene(strSearch As String) As Boolean
|
|
Dim strSQL As String
|
|
Dim rs As CRecordset
|
|
Dim lngSerienNr As Long
|
|
|
|
If Val(strSearch) = 0 Then
|
|
strSQL = "SELECT SerienNr from AuftragPositionSerienNr where KundeneigeneSerienNr = '" & strSearch & "' order by AnlageDatum desc"
|
|
Else
|
|
strSQL = "SELECT SerienNr from AuftragPositionSerienNr where SerienNr = " & Val(strSearch) & " or KundeneigeneSerienNr = '" & strSearch & "' order by AnlageDatum desc"
|
|
End If
|
|
|
|
Debug.Print strSQL
|
|
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, True
|
|
If rs.EOF Then
|
|
loadForSerienOrKundeneigene = False
|
|
Exit Function
|
|
Else
|
|
lngSerienNr = rs.getLongValue("SerienNr")
|
|
loadForSerienOrKundeneigene = loadForSerienNr(lngSerienNr)
|
|
End If
|
|
End Function
|
|
|
|
|
|
Public Function loadForSerienOrFabNummerOrKundeneigene(strSearch As String) As Boolean
|
|
Dim strSQL As String
|
|
Dim rs As CRecordset
|
|
Dim lngSerienNr As Long
|
|
|
|
strSQL = "SELECT SerienNr from AuftragPositionSerienNr where SerienNr = " & Val(strSearch) & " or FabNr = " & Val(strSearch) & " or KundeneigeneSerienNr = '" & strSearch & "' order by AnlageDatum desc"
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, True
|
|
If rs.EOF Then
|
|
loadForSerienOrFabNummerOrKundeneigene = False
|
|
Exit Function
|
|
Else
|
|
lngSerienNr = rs.getLongValue("SerienNr")
|
|
loadForSerienOrFabNummerOrKundeneigene = loadForSerienNr(lngSerienNr)
|
|
End If
|
|
End Function
|
|
|
|
|
|
' Prüfzählerdaten zu der angegebenen Serien-Nr. laden
|
|
'
|
|
Public Function loadForSerienNr(lSerienNr As Long, Optional AuftragNr As Long) As Boolean
|
|
Dim strSQL As String
|
|
Dim Auftrag As CAuftrag
|
|
Dim AuftragPosition As CAuftragPosition
|
|
Dim KZP As CKZP
|
|
Dim Pruefpunkte As CPruefpunkte
|
|
Dim IdentNrObj As CIdentNr
|
|
Dim AuftragpositionSerienNr As CAuftragPositionSerienNr
|
|
|
|
Dim sPruefklasseKZ As String
|
|
Dim Metrolog As String
|
|
Dim KZPVersion As Long
|
|
Dim IdentNr As Long
|
|
Dim strKZP As String
|
|
|
|
Dim Pruefpunkte_neu As CPruefpunkte
|
|
Dim bln_KZPoderMetrologVonHandEingegeben As Boolean
|
|
|
|
Dim strBestellcode As String
|
|
Dim lngBestellgruppe As Long
|
|
|
|
|
|
If False Then
|
|
loadForSerienNr = loadForSerienNr_neu(lSerienNr, AuftragNr)
|
|
Exit Function
|
|
End If
|
|
|
|
bln_KZPoderMetrologVonHandEingegeben = False
|
|
|
|
On Error GoTo loadForSerienNrErr
|
|
|
|
Call init
|
|
|
|
Set AuftragpositionSerienNr = loadAuftragPositionSerienNr(lSerienNr, AuftragNr)
|
|
If AuftragpositionSerienNr Is Nothing Then
|
|
loadForSerienNr = False
|
|
Exit Function
|
|
End If
|
|
|
|
DebugMsg "loadForSerienNr " & lSerienNr & " aus " & AuftragpositionSerienNr.getAuftragNr & "/" & AuftragpositionSerienNr.getPositionNr
|
|
|
|
|
|
|
|
|
|
' Auftragsdaten holen
|
|
' -------------------
|
|
Set AuftragPosition = loadAuftragPositionForSerienNr()
|
|
|
|
If AuftragPosition Is Nothing Then
|
|
Exit Function
|
|
End If
|
|
|
|
Set Auftrag = loadAuftrag(AuftragPosition.getAuftragNr())
|
|
If Auftrag Is Nothing Then
|
|
Exit Function
|
|
End If
|
|
Set m_Auftrag = Auftrag
|
|
|
|
' Prüfpunkte laden
|
|
' ----------------
|
|
Set Pruefpunkte = New CPruefpunkte
|
|
|
|
Pruefpunkte.mstr_Kundenmaterialnr = AuftragPosition.m_strKundenmaterialnummer
|
|
|
|
|
|
' PruefklasseKZ bestimmen
|
|
'------------------------
|
|
If AuftragPosition.getMetrolog() <> "" Then
|
|
Metrolog = Trim(AuftragPosition.getMetrolog())
|
|
m_sPruefklasseKZ = Metrolog
|
|
sPruefklasseKZ = m_sPruefklasseKZ
|
|
Else
|
|
Debug.Print "AuftragPosition.getMetrolog ist leer"
|
|
End If
|
|
|
|
' IdentNr laden
|
|
' -------------
|
|
IdentNr = AuftragPosition.getIdentNr()
|
|
Set IdentNrObj = loadIdentNr(IdentNr)
|
|
|
|
If IdentNrObj Is Nothing Then
|
|
DebugMsg "Kein Eintrag in Tabelle IdentNr zur IdentNr=" & IdentNr
|
|
' Exit Function
|
|
GoTo DatenSchreiben
|
|
End If
|
|
|
|
' zuerst in Tabelle Spezifikationen reinschauen
|
|
If GetPruefpunkteFromSpezifikationen(AuftragPosition, Auftrag, IdentNrObj, Pruefpunkte_neu) = True Then
|
|
Set Pruefpunkte = Pruefpunkte_neu
|
|
' wenn was gefunden, dann fertig
|
|
GoTo DatenSchreiben
|
|
End If
|
|
|
|
If IdentNrObj.GetVakoCode <> "" Then
|
|
' VakoCode Behandlung
|
|
|
|
Dim objVakoCode As CVakoCode
|
|
Set objVakoCode = New CVakoCode
|
|
objVakoCode.load IdentNrObj.GetVakoCode
|
|
|
|
If objVakoCode.GetWert("Kaeltezaehler") = "1" Then
|
|
m_bNurKaltPruefbar = True
|
|
End If
|
|
|
|
If Pruefpunkte.createFromVakoCode(objVakoCode, AuftragPosition) Then
|
|
' OK! Prüfunkte konnten geladen werden
|
|
|
|
If m_sPruefklasseKZ = "" And objVakoCode.GetWert("Metrolog") <> "" Then
|
|
m_sPruefklasseKZ = objVakoCode.GetWert("Metrolog")
|
|
End If
|
|
|
|
If Pruefpunkte.getSpezifikationID > 0 Then
|
|
' Spezifikation merken wegen der Fehlergrenzen für PDA
|
|
''''''''''''''''
|
|
' vorhandenen Wert aber nicht überschreiben!
|
|
strSQL = "SELECT len(VakoFehlerrahmen) as AnzahlZeichen from IdentNr where IdentNr = " & IdentNrObj.getNr
|
|
Debug.Print strSQL
|
|
Dim rs As CRecordset
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, True
|
|
If Not rs.EOF Then
|
|
' IdentNr ist vorhanden
|
|
If rs.getLongValue("AnzahlZeichen") = 0 Then
|
|
' kein Wert vorhanden, also SpecifikationsID eintragen
|
|
strSQL = "UPDATE IdentNr set VakoFehlerrahmen = 'SpezifikationID=" & Pruefpunkte.getSpezifikationID & "' where IdentNr = " & IdentNrObj.getNr
|
|
g_App.getDB.getConnection.Execute strSQL
|
|
WriteToLog strSQL
|
|
End If
|
|
End If
|
|
''''''''''''''''
|
|
ElseIf Pruefpunkte.getPruefklasseKZ <> "" Then
|
|
strSQL = "UPDATE IdentNr set VakoFehlerrahmen = 'IdentNr=" & Pruefpunkte.getIdentNr & ";Metrolog=" & Pruefpunkte.getPruefklasseKZ & "' where IdentNr = " & IdentNrObj.getNr
|
|
g_App.getDB.getConnection.Execute strSQL
|
|
WriteToLog strSQL
|
|
End If
|
|
|
|
If Pruefpunkte.getPruefpunkte.Count > 0 Then
|
|
'Erfolg
|
|
GoTo DatenSchreiben
|
|
End If
|
|
Else
|
|
If sPruefklasseKZ = "" Then
|
|
If objVakoCode.GetWert("Metrolog") <> "" Then
|
|
Metrolog = objVakoCode.GetWert("Metrolog")
|
|
End If
|
|
|
|
' Irgendwas ist schiefgelaufen
|
|
' Hier wäre eine Benutzereingabe hilfreich
|
|
'ErrorMsg "Es konnten keine Prüfpunkte für den VakoCode gefunden werden."
|
|
If Metrolog <> "" And IdentNr <> 0 Then
|
|
sPruefklasseKZ = Metrolog
|
|
Else
|
|
GoTo DatenSchreiben
|
|
End If
|
|
End If
|
|
End If
|
|
ElseIf Metrolog <> "" And Metrolog <> "ohne KZP" Then
|
|
' Fall 1: AuftragPosition.Metrolog vorhanden, Prüfklasse direkt bestimmen
|
|
sPruefklasseKZ = Metrolog
|
|
DebugMsg "Fall 1: Metrolog " & Metrolog & " vorhanden"
|
|
Else
|
|
' Fall 2,3,4,5,6: AuftragPosition.Metrolog leer
|
|
' KZP leer ?
|
|
If AuftragPosition.getKZP = Empty Or AuftragPosition.getKZP = 0 Or AuftragPosition.getKZP = 999 Then
|
|
'Fall 4,5,6: KZP leer
|
|
DebugMsg "Fall 4,5,6: KZP ist leer"
|
|
' Bestellcode auswerten
|
|
lngBestellgruppe = IdentNrObj.GetBestellgruppe()
|
|
If lngBestellgruppe > 0 Then
|
|
' Bestellgruppe vorhanden => Prüfpunkte über Bestellcode bestimmen
|
|
strBestellcode = Trim(AuftragPosition.GetBestellcode())
|
|
If InStr(1, strBestellcode, "-") > 0 Then
|
|
' nur den Teil hinter dem Bindestrich betrachten
|
|
strBestellcode = Mid(strBestellcode, InStr(1, strBestellcode, "-") + 1)
|
|
End If
|
|
DebugMsg "Gruppe " & lngBestellgruppe & ", Bestellcode= " & strBestellcode
|
|
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
Dim Bestellcode As CBestellcode
|
|
Set Bestellcode = New CBestellcode
|
|
If Bestellcode.load(strBestellcode, IdentNrObj.GetBestellgruppe) Then
|
|
' Bestellcode konnte geladen werden
|
|
sPruefklasseKZ = Bestellcode.GetWert("Metrolog")
|
|
' Metrolog aus Bestellcode ?
|
|
If sPruefklasseKZ <> "" Then
|
|
' hier ist eine Metrologische Klasse über den Bestellcode definiert
|
|
' zur Zeit bei "Meistream" der Fall
|
|
sPruefklasseKZ = Trim(Bestellcode.GetWert("Metrolog"))
|
|
DebugMsg "Metrolog aus Bestellocde = '" & sPruefklasseKZ & "'"
|
|
AuftragPosition.setMetrolog sPruefklasseKZ
|
|
Else 'sPruefklasseKZ = ""
|
|
' KZP aus Bestellcode ?
|
|
strKZP = Bestellcode.GetWert("KZP")
|
|
If Val(strKZP) > 0 Then
|
|
' KZP aus Bestellcode ist gefüllt
|
|
AuftragPosition.setKZP Val(strKZP)
|
|
DebugMsg "KZP " & strKZP & " aus Bestellcode!"
|
|
sPruefklasseKZ = GetPruefklasseFromKZP(AuftragPosition, Auftrag, IdentNrObj)
|
|
AuftragPosition.setMetrolog sPruefklasseKZ
|
|
Else ' KZP <= 0
|
|
' Bestellcode vorhanden aber weder Metrolog oder KZP
|
|
' dann werden Zähler nach MID geprüft
|
|
|
|
' If Pruefpunkte.CreateMIDPruefpunkteFromBestellcode_NEU(Bestellcode, AuftragPosition, IdentNrObj) Then
|
|
' ''''''''''''''''''''''''''''''''''''''''
|
|
' '
|
|
' ' OK, Zähler wird nach MID geprüft
|
|
' '
|
|
' ''''''''''''''''''''''''''''''''''''''''
|
|
'
|
|
' AuftragPosition.setPrf_nach_MID True
|
|
' AuftragPosition.save Auftrag
|
|
' GoTo DatenSchreiben
|
|
' Else
|
|
' ErrorMsg "Prüfpunkte nach MID konnten nicht ermittelt werden!"
|
|
' sPruefklasseKZ = Pruefklasse_durch_KZP_Metrolog_Eingabe(AuftragPosition, Auftrag, IdentNrObj)
|
|
' End If
|
|
|
|
|
|
If Pruefpunkte.CreateMIDPruefpunkteFromBestellcode(Bestellcode) Then
|
|
''''''''''''''''''''''''''''''''''''''''
|
|
'
|
|
' OK, Zähler wird nach MID geprüft
|
|
'
|
|
''''''''''''''''''''''''''''''''''''''''
|
|
' neu RH 11.2.2013
|
|
|
|
' Sonderregel 7.4.2014 AB
|
|
If Pruefpunkte.CreatePruefpunkteFromSpezifikationen(Bestellcode, Me.getAuftrag) Then
|
|
Pruefpunkte.m_bPruefung_nach_MID = False
|
|
|
|
m_Bemerkung = m_Bemerkung & "Prüfpunkte kommen aus Tabelle 'Spezifikationen' mit ID=" & Pruefpunkte.m_lngSpezifikationID & vbCrLf
|
|
Pruefpunkte.setInfo m_Bemerkung
|
|
GoTo DatenSchreiben
|
|
Else
|
|
AuftragPosition.setPrf_nach_MID True
|
|
AuftragPosition.save Auftrag
|
|
GoTo DatenSchreiben
|
|
End If
|
|
Else
|
|
' keine Metrolog, keine MID, keine KZP aber Bestellcode
|
|
' Metrolog aus Logo und Typ z.B. über Spezifikationen bestimmen
|
|
|
|
If Pruefpunkte.CreatePruefpunkteFromSpezifikationen(Bestellcode, Me.getAuftrag) Then
|
|
m_Bemerkung = m_Bemerkung & "Prüfpunkte kommen aus Spezifikationen " & Pruefpunkte.m_lngSpezifikationID & vbCrLf
|
|
GoTo DatenSchreiben
|
|
Else
|
|
sPruefklasseKZ = GetMetrologFromSpezifikationen(Bestellcode)
|
|
|
|
If sPruefklasseKZ = "" Then
|
|
ErrorMsg "Prüfpunkte nach MID konnten nicht ermittelt werden!"
|
|
sPruefklasseKZ = Pruefklasse_durch_KZP_Metrolog_Eingabe(AuftragPosition, Auftrag, IdentNrObj)
|
|
End If
|
|
End If
|
|
End If 'CreateMIDPruefpunkteFromBestellcode
|
|
|
|
End If ' KZP = 0
|
|
End If 'sPruefklasseKZ = ""
|
|
Else
|
|
ErrorMsg "Bestellcode " & strBestellcode & " konnte nicht ausgewertet werden für SerienNr=" & lSerienNr & " und Bestellgruppe=" & lngBestellgruppe
|
|
sPruefklasseKZ = Pruefklasse_durch_KZP_Metrolog_Eingabe(AuftragPosition, Auftrag, IdentNrObj)
|
|
End If 'Bestellcode.load
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
Else
|
|
ErrorMsg "Der Zähler mit der Serien-Nr. " & lSerienNr & " kann nicht nach MID geprüft werden, da die Eigenschaft 'Bestellgruppe' für IdentNr " & IdentNrObj.getNr & " nicht definiert ist!"
|
|
sPruefklasseKZ = Pruefklasse_durch_KZP_Metrolog_Eingabe(AuftragPosition, Auftrag, IdentNrObj)
|
|
End If
|
|
Else 'AuftragPosition.getKZP = Empty Or AuftragPosition.getKZP = 0
|
|
'Fall 2,3 KZP ist gefüllt
|
|
sPruefklasseKZ = GetPruefklasseFromKZP(AuftragPosition, Auftrag, IdentNrObj)
|
|
End If 'Fall 2,3
|
|
End If
|
|
|
|
PPausMetrologUndIdentNr:
|
|
' Nun ist die PrüfklasseKZ bekannt
|
|
DebugMsg "Die Prüfpunkte werden aus der PruefklasseKZ=" & sPruefklasseKZ & " und der IdentNr = " & AuftragPosition.getIdentNr & " bestimmt."
|
|
|
|
|
|
|
|
' RH neu 18.7.2012
|
|
' nachschauen, ob es in der Spezifikationen eine CSD Sonderregel gibt
|
|
If GetPruefpunkteFromSpezifikationen(AuftragPosition, Auftrag, IdentNrObj, Pruefpunkte_neu) = True Then
|
|
'If MsgBox("Es gibt spezielle Prüfpunkte nach CSD/QA_M für diesen Kunden (" & Auftrag.getKundenNr & "). Möchten Sie diese Prüfpunkte verwenden?", vbYesNo Or vbDefaultButton1) = vbYes Then
|
|
Set Pruefpunkte = Pruefpunkte_neu
|
|
'End If
|
|
Else
|
|
|
|
If Not Pruefpunkte.load(AuftragPosition.getIdentNr(), sPruefklasseKZ) Then
|
|
DebugMsg "CPruefzaehler.load: Pruefpunkte zu IdentNr:" & AuftragPosition.getIdentNr() & " KZP:" & AuftragPosition.getKZP() & " konnte nicht geladen werden."
|
|
Set Pruefpunkte = Nothing
|
|
End If
|
|
|
|
' RH 20.7.2007 (i.A. A.Beyer): Prüfpunkte müssen neu eingegeben werden wenn KZP=10 und Metrolog=SONDERV.
|
|
If AuftragPosition.getKZP = 10 And AuftragPosition.getMetrolog = "SONDERV." Then
|
|
Set Pruefpunkte = Nothing
|
|
' RH 9.7.2009
|
|
Set Pruefpunkte = New CPruefpunkte
|
|
End If
|
|
End If
|
|
|
|
DatenSchreiben:
|
|
|
|
If Not Pruefpunkte Is Nothing Then
|
|
' Neu RH 2016-11-28
|
|
If Pruefpunkte.getSpezifikationID > 0 Then
|
|
' Spezifikation merken wegen der Fehlergrenzen für PDA
|
|
''''''''''''''''
|
|
' vorhandenen Wert aber nicht überschreiben!
|
|
strSQL = "SELECT len(VakoFehlerrahmen) as AnzahlZeichen from IdentNr where IdentNr = " & IdentNrObj.getNr
|
|
Debug.Print strSQL
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, True
|
|
If Not rs.EOF Then
|
|
' IdentNr ist vorhanden
|
|
If rs.getLongValue("AnzahlZeichen") = 0 Then
|
|
' kein Wert vorhanden, also SpezifikationsID eintragen
|
|
strSQL = "UPDATE IdentNr set VakoFehlerrahmen = 'SpezifikationID=" & Pruefpunkte.getSpezifikationID & "' where IdentNr = " & IdentNrObj.getNr
|
|
WriteToLog strSQL
|
|
g_App.getDB.getConnection.Execute strSQL
|
|
End If
|
|
End If
|
|
''''''''''''''''
|
|
End If
|
|
End If
|
|
If Not Pruefpunkte Is Nothing Then
|
|
' Wenn LWL gewählt ist, dann Prüfzeiten aus Tabelle LWL_Pruefzeiten beziehen
|
|
If g_blnPrfMitLWL = True And Pruefpunkte.getPruefpunkteCount > 0 Then
|
|
SetzeLWLPruefzeiten Pruefpunkte.getPruefpunkte, AuftragPosition, IdentNrObj
|
|
m_lng_LWLImpulswertigkeit = GetLWLImpulswertigkeit(IdentNrObj, AuftragPosition)
|
|
End If
|
|
End If
|
|
|
|
' Daten erst jetzt in Member-Variablen schreiben!
|
|
' -----------------------------------------------
|
|
m_lSerienNr = lSerienNr
|
|
m_nKZP = AuftragPosition.getKZP
|
|
m_lIdentNr = AuftragPosition.getIdentNr()
|
|
m_Bemerkung = AuftragpositionSerienNr.getBemerkung()
|
|
m_sPruefklasseKZ = sPruefklasseKZ
|
|
|
|
|
|
m_strKundeneigeneSerienNr = AuftragpositionSerienNr.getKundeneigeneSerienNr
|
|
|
|
Set m_Auftrag = Auftrag
|
|
Set m_AuftragPosition = AuftragPosition
|
|
Set m_IdentNr = IdentNrObj
|
|
Set m_KZP = KZP
|
|
Set m_Pruefpunkte = Pruefpunkte
|
|
|
|
'DebugMsg " AuftragPosition " & m_AuftragPosition.getAuftragNr & "/" & m_AuftragPosition.getNr
|
|
LoadForSerienNrOK:
|
|
loadForSerienNr = True
|
|
Exit Function
|
|
|
|
loadForSerienNrErr:
|
|
Call showError("loadForSerienNrErr")
|
|
|
|
Exit Function
|
|
Resume
|
|
|
|
End Function
|
|
|
|
|
|
Private Function GetPruefpunkteFromSpezifikationen(AuftragPosition As CAuftragPosition, Auftrag As CAuftrag, IdentNrObj As CIdentNr, ByRef Pruefpunkte As CPruefpunkte) As Boolean
|
|
On Error GoTo Errorhandler
|
|
|
|
Dim errorno As Long
|
|
Dim errordesc As String
|
|
|
|
Dim Pruefpunkt As CPruefpunkt
|
|
Dim PPNr As Integer
|
|
Dim Pruefpunktcollection As CPruefpunktCol
|
|
Dim strCSD As String
|
|
Dim strTemp As String
|
|
Dim intRatio As Integer
|
|
Dim strAusfuehrung As String
|
|
|
|
GetPruefpunkteFromSpezifikationen = False
|
|
Dim strSQL As String
|
|
|
|
' Ausführung_Land später aus Vako
|
|
' CSD später aus Vako
|
|
|
|
' neu RH 2015-07-15
|
|
If IdentNrObj.GetVakoCode <> "" Then
|
|
Dim objVako As CVakoCode
|
|
Set objVako = New CVakoCode
|
|
If objVako.load(IdentNrObj.GetVakoCode) Then
|
|
intRatio = Val(Replace(objVako.GetWert("Ratio"), "R", ""))
|
|
|
|
If Left(objVako.GetWert("Ausfuehrung"), 4) = "CSD " Then
|
|
strCSD = objVako.GetWert("Ausfuehrung")
|
|
If UBound(Split(strCSD, " ")) >= 1 Then
|
|
strCSD = Split(strCSD, " ")(0) & " " & Split(strCSD, " ")(1)
|
|
End If
|
|
ElseIf Val(Left(objVako.GetWert("Ausfuehrung"), 2)) > 0 Then
|
|
strAusfuehrung = Left(objVako.GetWert("Ausfuehrung"), 2)
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
' neu RH 5.9.2013
|
|
If AuftragPosition.GetBestellcode <> "" And IdentNrObj.GetBestellgruppe <> 0 Then
|
|
Dim Bestellcode As CBestellcode
|
|
Set Bestellcode = New CBestellcode
|
|
Bestellcode.load AuftragPosition.GetBestellcode, IdentNrObj.GetBestellgruppe
|
|
strCSD = Bestellcode.GetWert("CSD")
|
|
intRatio = Bestellcode.GetWert("Verhaeltnis_Q3_Q1")
|
|
End If
|
|
|
|
'neu RH Benutze die Metrolog des NZ (Lead Auftrag)
|
|
Dim strNZ_Metrolog As String
|
|
Select Case LCase(AuftragPosition.getIdentNrObj.getTyp)
|
|
Case LCase("meitwin")
|
|
If AuftragPosition.m_lLead_AuftragNr <> 0 Then
|
|
Dim NZAuftragPosition As CAuftragPosition
|
|
'' Set NZAuftragPosition = AuftragPosition.getNZAuftragposition
|
|
'' If Not NZAuftragPosition Is Nothing Then
|
|
'' strNZ_Metrolog = NZAuftragPosition.getMetrolog
|
|
'' End If
|
|
End If
|
|
End Select
|
|
|
|
strSQL = "SELECT * From Spezifikationen where 1=1 "
|
|
strSQL = strSQL & " and (KundenNr = " & Auftrag.getKundenNr & " or KundenNr = 0 or KundenNr is NULL) "
|
|
|
|
If AuftragPosition.getKZP > 0 Then
|
|
strSQL = strSQL & " and (KZP = " & AuftragPosition.getKZP & ") "
|
|
Else
|
|
strSQL = strSQL & " and (KZP is NULL) "
|
|
End If
|
|
|
|
'If strCSD <> "" Then
|
|
strSQL = strSQL & " and (CSD = '" & strCSD & "' or CSD is NULL or CSD like '%;" & strCSD & ";%') "
|
|
'End If
|
|
|
|
If AuftragPosition.getMetrolog <> "" Then
|
|
strSQL = strSQL & " and (Metrolog = '" & AuftragPosition.getMetrolog & "' or Metrolog is NULL) "
|
|
End If
|
|
|
|
If IdentNrObj.GetKurzBezeichnung <> "" Then
|
|
strSQL = strSQL & " and (KurzBez = '" & IdentNrObj.GetKurzBezeichnung & "' or KurzBez is NULL) "
|
|
End If
|
|
|
|
If IdentNrObj.getTyp <> "" Then
|
|
strSQL = strSQL & " and (Typ = '" & IdentNrObj.getTyp & "' or Typ is NULL) "
|
|
End If
|
|
|
|
strSQL = strSQL & " and (Typzusatz = '" & IdentNrObj.getTypzusatz & "' or Typzusatz like ';" & IdentNrObj.getTypzusatz & ";' or Typzusatz like '%;*;%' or Typzusatz is NULL)"
|
|
|
|
If IdentNrObj.getNennweite <> 0 Then
|
|
strSQL = strSQL & " and (Nennweite = " & IdentNrObj.getNennweite & " or Nennweite is NULL) "
|
|
End If
|
|
|
|
If IdentNrObj.GetTemperatur > 0 Then
|
|
strSQL = strSQL & " and (Temperatur = " & IdentNrObj.GetTemperatur & " or Temperatur is NULL) "
|
|
End If
|
|
|
|
If IdentNrObj.getDruck > 0 Then
|
|
strSQL = strSQL & " and (Druck = " & IdentNrObj.getDruck & " or Druck is NULL) "
|
|
End If
|
|
|
|
|
|
' NEU RH 10.6.2015 wegen FANr = 3006449 , SNr 15757286 AP 71117933/10
|
|
If intRatio > 0 Then
|
|
strSQL = strSQL & " and (Ratio = 'R" & intRatio & "' or Ratio is null) "
|
|
End If
|
|
|
|
' If strNZ_Metrolog <> "" Then
|
|
' strSQL = strSQL & " and (Metrolog_NZ = '" & strNZ_Metrolog & "' or Metrolog_NZ is NULL) "
|
|
' End If
|
|
'
|
|
strSQL = strSQL & " AND (Q1 is not NULL)"
|
|
|
|
Debug.Print strSQL
|
|
|
|
Dim rs As CRecordset
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, True
|
|
|
|
GetPruefpunkteFromSpezifikationen = False
|
|
|
|
If Not rs.EOF Then
|
|
If rs.RecordCount > 1 Then
|
|
|
|
strTemp = vbCrLf & "Es wurden zuviele (" & rs.RecordCount & ") passende Datensätze in Tabelle Spezifikation gefunden: " & vbCrLf & vbCrLf & strSQL & vbCrLf & vbCrLf & "FANr = " & AuftragPosition.GetFertigungsauftragNr & vbCrLf
|
|
rs.MoveFirst
|
|
Do While Not rs.EOF
|
|
strTemp = strTemp & vbCrLf & "ID=" & rs.getLongValue("ID") & vbCrLf
|
|
rs.MoveNext
|
|
Loop
|
|
rs.MoveFirst
|
|
|
|
BenachrichtigeDatenpflege strTemp
|
|
End If
|
|
|
|
Set Pruefpunkte = New CPruefpunkte
|
|
Set Pruefpunktcollection = New CPruefpunktCol
|
|
For PPNr = 1 To 10
|
|
If rs.getDoubleValue("Q" & PPNr) > 0 Then
|
|
' für mind. einen Durchfluss gibt es Prüfpunkte
|
|
GetPruefpunkteFromSpezifikationen = True
|
|
|
|
Set Pruefpunkt = New CPruefpunkt
|
|
Pruefpunkt.setQ rs.getDoubleValue("Q" & PPNr)
|
|
Pruefpunkt.setFGo rs.getDoubleValue("FGo" & PPNr)
|
|
Pruefpunkt.setFGu rs.getDoubleValue("FGu" & PPNr)
|
|
Pruefpunkt.SetTime rs.getDoubleValue("P" & PPNr & "SollPruefZeit")
|
|
Pruefpunktcollection.Add Pruefpunkt
|
|
End If
|
|
Next
|
|
Pruefpunkte.setPruefpunkte Pruefpunktcollection
|
|
Pruefpunkte.setInfo "PP aus Tabelle Spezifikationen ID=" & rs.getLongValue("ID")
|
|
Pruefpunkte.m_lngSpezifikationID = rs.getLongValue("ID")
|
|
|
|
|
|
|
|
End If
|
|
Exit Function
|
|
Errorhandler:
|
|
GetPruefpunkteFromSpezifikationen = False
|
|
errorno = Err.Number
|
|
errordesc = Err.Description
|
|
LogIntoDB "Fehler " & errorno & " in GetPruefpunkteFromSpezifikationen(): " & Err.Description, "Softwarefehler"
|
|
End Function
|
|
|
|
|
|
|
|
|
|
Private Function GetPruefklasseFromKZP(ByRef AuftragPosition As CAuftragPosition, ByRef Auftrag As CAuftrag, ByRef IdentNrObj As CIdentNr) As String
|
|
Dim KZP As CKZP
|
|
Set KZP = New CKZP
|
|
If Not AuftragPosition.getKZPVersion = Empty And Not AuftragPosition.getKZPVersion = 0 Then
|
|
' Fall 2: KZPVersion vorhanden
|
|
DebugMsg "Fall 2: KZPVersion vorhanden"
|
|
' KZP mit KZP und KZPVersion laden
|
|
' ---------
|
|
If Not KZP.load(AuftragPosition.getKZP(), AuftragPosition.getKZPVersion) Then
|
|
DebugMsg "CPruefzaehler.GetPruefklasseFromKZP(): KZP (mit KZPNr=" & AuftragPosition.getKZP() & " KZPVersion=" & AuftragPosition.getKZPVersion() & ") konnte nicht geladen werden."
|
|
Else
|
|
GetPruefklasseFromKZP = KZP.getPruefklasseKZ
|
|
DebugMsg " Die daraus ermittelte Prüfklasse ist '" & GetPruefklasseFromKZP & "'"
|
|
End If
|
|
Else ' KZPVersion vorhanden
|
|
' Fall 3: nur KZP ohne KZPVersion vorhanden
|
|
' KZP aus Tabelle IdentNr über Typ/Nennweite/Temperatur/KZP bestimmen
|
|
If Not KZP.LoadforParameter(IdentNrObj.getTyp, IdentNrObj.getNennweite, IdentNrObj.GetTemperatur, AuftragPosition.getKZP(), Auftrag.getKundenNr) Then
|
|
DebugMsg "CPruefzaehler.loadForSerienNr: KZP (mit Typ=" & IdentNrObj.getTyp & ",Nennweite=" & IdentNrObj.getNennweite & ",Temperatur=" & IdentNrObj.GetTemperatur & ") konnte nicht geladen werden."
|
|
Else
|
|
GetPruefklasseFromKZP = KZP.getPruefklasseKZ
|
|
DebugMsg " Die daraus ermittelte Prüfklasse ist '" & GetPruefklasseFromKZP & "'"
|
|
End If
|
|
|
|
End If ' Fall 3
|
|
End Function
|
|
|
|
Private Function Pruefklasse_durch_KZP_Metrolog_Eingabe(ByRef AuftragPosition As CAuftragPosition, Auftrag As CAuftrag, IdentNrObj As CIdentNr) As String
|
|
Dim strKZP As String
|
|
Dim Metrolog As String
|
|
Dim KZP As CKZP
|
|
|
|
Dim strKZPVorschlag As String
|
|
strKZPVorschlag = ""
|
|
If IdentNrObj.GetKurzBezeichnung = "ZM" And IdentNrObj.getTyp = "MAG" Then
|
|
strKZPVorschlag = "190"
|
|
End If
|
|
|
|
' MID Angaben fehlen, also KZP oder Metrolog vom Bediener anfordern!
|
|
strKZP = Trim(InputBox("Bitte geben Sie die KZP für Auftrag " & AuftragPosition.getAuftragNr & "/" & AuftragPosition.getNr & " ein." & "Wählen Sie 'Abbrechen' um eine metrologische Klasse eingeben zu können.", "Eingabe der KZP", strKZPVorschlag))
|
|
If IsNumeric(strKZP) Then
|
|
DebugMsg "Der Prüfer hat die KZP " & strKZP & " eingegeben!"
|
|
AuftragPosition.setKZP Val(strKZP)
|
|
Pruefklasse_durch_KZP_Metrolog_Eingabe = GetPruefklasseFromKZP(AuftragPosition, Auftrag, IdentNrObj)
|
|
AuftragPosition.setKZP CLng(strKZP)
|
|
If MsgBox("Möchten Sie die KZP '" & strKZP & "' für diese Auftragposition speichern ?", vbYesNo) = vbYes Then
|
|
AuftragPosition.save Auftrag
|
|
End If
|
|
|
|
Set KZP = New CKZP
|
|
If KZP.load(Val(strKZP)) Then
|
|
Pruefklasse_durch_KZP_Metrolog_Eingabe = KZP.getPruefklasseKZ
|
|
DebugMsg " Die daraus ermittelte Prüfklasse ist '" & Pruefklasse_durch_KZP_Metrolog_Eingabe & "'"
|
|
End If
|
|
Else
|
|
strKZP = ""
|
|
End If
|
|
|
|
If strKZP = "" Then
|
|
Metrolog = Trim(InputBox("Bitte geben Sie die metrologische Prüfklasse für Auftrag " & AuftragPosition.getAuftragNr & "/" & AuftragPosition.getNr & " ein", "Eingabe der Prüfklasse", ""))
|
|
If Metrolog <> "" Then
|
|
DebugMsg "Der Prüfer hat die Metrolog " & Metrolog & " eingegeben!"
|
|
AuftragPosition.setMetrolog Metrolog
|
|
If MsgBox("Möchten Sie die metrologische Klasse '" & Metrolog & "' für diese Auftragposition speichern ?", vbYesNo) = vbYes Then
|
|
AuftragPosition.save Auftrag
|
|
End If
|
|
Pruefklasse_durch_KZP_Metrolog_Eingabe = Metrolog
|
|
End If 'Metrolog <> ""
|
|
End If 'strKZP = ""
|
|
End Function
|
|
|
|
|
|
' @return Auftrag zu dem Prüfzählers
|
|
'
|
|
Public Function getAuftrag() As CAuftrag
|
|
Set getAuftrag = m_Auftrag
|
|
End Function
|
|
|
|
' @return Auftragsposition zu der Serien-Nr. des Prüfzählers oder
|
|
' nothing
|
|
'
|
|
Public Function getAuftragPosition() As CAuftragPosition
|
|
Set getAuftragPosition = m_AuftragPosition
|
|
End Function
|
|
|
|
' Auftragsposition zu der Serien-Nr. des Prüfzählers laden
|
|
'
|
|
Private Function loadAuftragPositionForSerienNr() As CAuftragPosition
|
|
Dim AuftragpositionSerienNr As CAuftragPositionSerienNr
|
|
Dim AuftragPosition As CAuftragPosition
|
|
' Todo: lSeriennr ist überflüssig in dieser Funktion, auch Funktionsaufrufe schlanker machen
|
|
|
|
' Zugehörige Auftragsposition laden. Wenn diese nicht geladen werden
|
|
' kann, liegt eine Inkonsistenz vor, die auf jeden Fall als harter Fehler
|
|
' zu werten ist.
|
|
Set AuftragPosition = New CAuftragPosition
|
|
If Not AuftragPosition.load(m_AuftragPositionSerienNr.getAuftragNr(), m_AuftragPositionSerienNr.getPositionNr()) Then
|
|
ErrorMsg "Es konnte keine Auftragsposition (" & m_AuftragPositionSerienNr.getAuftragNr() & " / " & m_AuftragPositionSerienNr.getPositionNr() & ") geladen werden."
|
|
Exit Function
|
|
End If
|
|
|
|
Set loadAuftragPositionForSerienNr = AuftragPosition
|
|
End Function
|
|
|
|
' Auftrag zu der übergebenen Auftrags-Nr. laden
|
|
'
|
|
Private Function loadAuftrag(lAuftragNr As Long) As CAuftrag
|
|
Dim Auftrag As CAuftrag
|
|
|
|
Set Auftrag = New CAuftrag
|
|
If Not Auftrag.load(lAuftragNr, False) Then
|
|
Exit Function
|
|
End If
|
|
|
|
Set loadAuftrag = Auftrag
|
|
End Function
|
|
|
|
|
|
Private Function loadIdentNr(lIdentNr As Long) As CIdentNr
|
|
Dim IdentNr As CIdentNr
|
|
|
|
Set IdentNr = New CIdentNr
|
|
If Not IdentNr.loadForNr(lIdentNr) Then
|
|
Exit Function
|
|
End If
|
|
|
|
Set loadIdentNr = IdentNr
|
|
End Function
|
|
|
|
Private Function loadAuftragPositionSerienNr(SerienNr As Long, Optional lngAuftragNr As Long) As CAuftragPositionSerienNr
|
|
Set m_AuftragPositionSerienNr = New CAuftragPositionSerienNr
|
|
If m_AuftragPositionSerienNr.load(SerienNr, lngAuftragNr) Then
|
|
Set loadAuftragPositionSerienNr = m_AuftragPositionSerienNr
|
|
End If
|
|
End Function
|
|
|
|
|
|
'------------------------------------------------------------------------------
|
|
' Private Funktionalität
|
|
'------------------------------------------------------------------------------
|
|
' Helper für Fehlerausgaben
|
|
'
|
|
' @param sInfo optionaler Hinweistext
|
|
'
|
|
Private Sub showError(sMethod As String, Optional sInfo As String)
|
|
Call modError.showError("CPruefzaehler." + sMethod, sInfo)
|
|
End Sub
|
|
|
|
Public Function GetImpulseLwl() As Long
|
|
Dim ANZEIGE As String
|
|
Dim ImpulseAnz As Long
|
|
Dim UmrechnungsFaktor As Double
|
|
Dim AnzeigeEinheitFaktor As Long
|
|
Dim EinheitID As Integer
|
|
Dim sSQL As String
|
|
Dim rs As CRecordset
|
|
|
|
On Error GoTo GetImpulseError
|
|
|
|
ANZEIGE = m_AuftragPosition.getAnzeige
|
|
|
|
' Nachschlagen von EinheitID über Tabelle Einheit aus AuftragPosition.Anzeige
|
|
' ---------------------------------------------------------------------------
|
|
sSQL = "SELECT EinheitID "
|
|
sSQL = sSQL & "FROM Einheit where Anzeige = '" & m_AuftragPosition.getAnzeige & "';"
|
|
|
|
Set rs = New CRecordset
|
|
If Not rs.openRS(sSQL) Then
|
|
ErrorMsg ("SQL-Fehler bei CPruefzaehler.GetImpulseLwl")
|
|
End If
|
|
|
|
If Not rs.EOF() Then
|
|
Else
|
|
ErrorMsg ("Die EinheitID konnte für die Anzeige '" & m_AuftragPosition.getAnzeige & "' nicht ermittelt werden.")
|
|
Exit Function
|
|
End If
|
|
|
|
EinheitID = rs.getIntValue("EinheitID")
|
|
Set rs = Nothing
|
|
|
|
Set rs = New CRecordset
|
|
|
|
sSQL = "SELECT LwlPulse_Pro_Anzeige, UmrechnungsFaktor, AnzeigeEinheitFaktor, AnzahlPaletten from IdentNrZaehlwerk where "
|
|
sSQL = sSQL & "EinheitID = " & EinheitID & " "
|
|
sSQL = sSQL & "and Typenbereiche like '%;" & CStr(m_IdentNr.getTyp) & ";%' "
|
|
sSQL = sSQL & "and Typenzusatzbereiche like '%;" & CStr(m_IdentNr.getTypzusatz) & ";%' "
|
|
sSQL = sSQL & "and Temperaturbereiche like '%;" & CStr(m_IdentNr.GetTemperatur) & ";%' "
|
|
sSQL = sSQL & "and Nennweitenbereiche like '%;" & CStr(m_IdentNr.getNennweite) & ";%';"
|
|
rs.openRS (sSQL)
|
|
|
|
If Not rs.EOF() Then
|
|
|
|
Else
|
|
nochmalEingeben:
|
|
LogIntoDB "kein Datensatz bei " & sSQL, "Daten"
|
|
GetImpulseLwl = Val(InputBox("Es ist keine Lwl Impulswertigkeit in der Datenbank hinterlegt." & vbCrLf & "Bitte Impulswertigkeit eingeben:"))
|
|
If GetImpulseLwl = 0 Then
|
|
GoTo nochmalEingeben
|
|
End If
|
|
|
|
Exit Function
|
|
End If
|
|
|
|
ImpulseAnz = rs.getLongValue("LwlPulse_Pro_Anzeige")
|
|
UmrechnungsFaktor = rs.getDoubleValue("UmrechnungsFaktor")
|
|
'AnzeigeEinheitFaktor = rs.getLongValue("AnzeigeEinheitFaktor")
|
|
|
|
m_intAnzahlPaletten = rs.getIntValue("AnzahlPaletten")
|
|
|
|
GetImpulseLwl = ImpulseAnz / UmrechnungsFaktor
|
|
|
|
DebugMsg "LWL ImpulseAnz:" & ImpulseAnz & " / UmrechnungsFaktor: " & UmrechnungsFaktor & " = GetImpulseLwl: " & GetImpulseLwl
|
|
' wird nicht benutzt
|
|
'DebugMsg "AnzeigeEinheitFaktor :" & AnzeigeEinheitFaktor
|
|
|
|
Set rs = Nothing
|
|
Exit Function
|
|
GetImpulseError:
|
|
Set rs = Nothing
|
|
ErrorMsg ("CPruefzaehler.GetImpulseLwl Error: " & Err.Description)
|
|
Exit Function
|
|
Resume
|
|
End Function
|
|
|
|
|
|
Public Function GetAnzahlPaletten() As Integer
|
|
If m_intAnzahlPaletten = -1 Then
|
|
Call GetImpulseQM
|
|
End If
|
|
GetAnzahlPaletten = m_intAnzahlPaletten
|
|
End Function
|
|
|
|
Public Function GetImpulseQM() As Double
|
|
Dim ANZEIGE As String
|
|
Dim ImpulseAnz As Double
|
|
Dim UmrechnungsFaktor As Double
|
|
Dim AnzeigeEinheitFaktor As Long
|
|
Dim EinheitID As Integer
|
|
Dim sSQL As String
|
|
Dim rs As CRecordset
|
|
|
|
On Error GoTo GetImpulseError
|
|
|
|
ANZEIGE = m_AuftragPosition.getAnzeige
|
|
|
|
' Nachschlagen von EinheitID über Tabelle Einheit aus AuftragPosition.Anzeige
|
|
' ---------------------------------------------------------------------------
|
|
sSQL = "SELECT EinheitID "
|
|
sSQL = sSQL & "FROM Einheit where Anzeige = '" & m_AuftragPosition.getAnzeige & "';"
|
|
|
|
Set rs = New CRecordset
|
|
If Not rs.openRS(sSQL) Then
|
|
ErrorMsg ("SQL-Fehler bei CPruefzaehler.GetImpulseQM")
|
|
End If
|
|
|
|
If Not rs.EOF() Then
|
|
Else
|
|
ErrorMsg ("Die EinheitID konnte für die Anzeige '" & m_AuftragPosition.getAnzeige & "' nicht ermittelt werden.")
|
|
Exit Function
|
|
End If
|
|
|
|
EinheitID = rs.getIntValue("EinheitID")
|
|
Set rs = Nothing
|
|
|
|
Set rs = New CRecordset
|
|
|
|
sSQL = "SELECT OptoPulse_Pro_Anzeige, UmrechnungsFaktor, AnzeigeEinheitFaktor from IdentNrZaehlwerk where "
|
|
sSQL = sSQL & "EinheitID = " & EinheitID & " "
|
|
sSQL = sSQL & "and Typenbereiche like '%;" & CStr(m_IdentNr.getTyp) & ";%' "
|
|
sSQL = sSQL & "and Typenzusatzbereiche like '%;" & CStr(m_IdentNr.getTypzusatz) & ";%' "
|
|
sSQL = sSQL & "and Temperaturbereiche like '%;" & CStr(m_IdentNr.GetTemperatur) & ";%' "
|
|
sSQL = sSQL & "and Nennweitenbereiche like '%;" & CStr(m_IdentNr.getNennweite) & ";%';"
|
|
rs.openRS (sSQL)
|
|
|
|
If Not rs.EOF() Then
|
|
|
|
Else
|
|
nochmalEingeben:
|
|
LogIntoDB "kein Datensatz bei " & sSQL, "Daten"
|
|
GetImpulseQM = Val(InputBox("Es ist keine Impulswertigkeit in der Datenbank hinterlegt." & vbCrLf & "Bitte Impulswertigkeit eingeben:"))
|
|
If GetImpulseQM = 0 Then
|
|
GoTo nochmalEingeben
|
|
End If
|
|
|
|
Exit Function
|
|
End If
|
|
|
|
ImpulseAnz = rs.getDoubleValue("OptoPulse_Pro_Anzeige")
|
|
UmrechnungsFaktor = rs.getDoubleValue("UmrechnungsFaktor")
|
|
AnzeigeEinheitFaktor = rs.getLongValue("AnzeigeEinheitFaktor")
|
|
|
|
GetImpulseQM = ImpulseAnz / UmrechnungsFaktor
|
|
|
|
DebugMsg "ImpulseAnz:" & ImpulseAnz & " / UmrechnungsFaktor: " & UmrechnungsFaktor & " = GetImpulseQM: " & GetImpulseQM
|
|
' wird nicht benutzt
|
|
'DebugMsg "AnzeigeEinheitFaktor :" & AnzeigeEinheitFaktor
|
|
|
|
Set rs = Nothing
|
|
Exit Function
|
|
GetImpulseError:
|
|
Set rs = Nothing
|
|
ErrorMsg ("CPruefzaehler.GetImpulse Error: " & Err.Description)
|
|
Exit Function
|
|
Resume
|
|
End Function
|
|
|
|
Private Sub Class_Initialize()
|
|
Set m_Prueffehler = New CPrueffehler
|
|
m_intAnzahlPaletten = -1
|
|
End Sub
|
|
|
|
Private Sub loadVorpruefpunkte()
|
|
Set m_Vorpruefpunkte = New CVorpruefpunkte
|
|
If Not m_AuftragPosition Is Nothing Then
|
|
If Not m_Vorpruefpunkte.load(m_AuftragPosition.getIdentNr(), m_sPruefklasseKZ) Then
|
|
Set m_Vorpruefpunkte = Nothing
|
|
End If
|
|
End If
|
|
End Sub
|
|
|
|
Public Function GetLWLImpulswertigkeit(IdentNrObj As CIdentNr, AuftragPosition As CAuftragPosition) As Long
|
|
On Error GoTo Errorhandler
|
|
|
|
Dim strTyp As String
|
|
Dim strTypzusatz As String
|
|
Dim lngNennweite As Long
|
|
Dim rs As CRecordset
|
|
Dim strSQL As String
|
|
Dim strZulassungskennzeichen As String
|
|
|
|
|
|
strTyp = IdentNrObj.getTyp
|
|
strTypzusatz = IdentNrObj.getTypzusatz
|
|
lngNennweite = IdentNrObj.getNennweite
|
|
|
|
strZulassungskennzeichen = GetWertFromZusatztext(AuftragPosition.getZusatztext, "Zulassungskennzeichen :")
|
|
|
|
|
|
|
|
strSQL = "SELECT * from LWL_Impulswertigkeit "
|
|
strSQL = strSQL & " Where (Typ like '%;" & strTyp & ";%' OR Typ = ';*;') "
|
|
strSQL = strSQL & " AND (Typzusatz like '%;" & strTypzusatz & ";%' OR Typzusatz = ';*;') "
|
|
strSQL = strSQL & " AND (Nennweite like '%;" & lngNennweite & ";%' OR Nennweite = ';*;') "
|
|
strSQL = strSQL & " AND (Zulassungskennzeichen like '%;" & strZulassungskennzeichen & ";%' OR Zulassungskennzeichen = ';*;') "
|
|
|
|
strSQL = strSQL & " AND (Metrolog like '%;" & AuftragPosition.getMetrolog & ";%' OR Metrolog = ';*;') "
|
|
strSQL = strSQL & " AND (PrfNachMID like '%" & IIf(AuftragPosition.getPrf_nach_MID, "1", "0") & "%' OR PrfNachMID like '%*%') "
|
|
|
|
strSQL = strSQL & " AND (Kundennummern like '%" & AuftragPosition.getKundenNr & "%' OR Kundennummern like '%*%') "
|
|
|
|
strSQL = strSQL & " ORDER BY Sortorder "
|
|
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, True
|
|
Debug.Print strSQL
|
|
|
|
If rs.EOF Then
|
|
' todo nicetohave: Dummy-Datensatz anlegen und benachrichtigen
|
|
' rs.addNew
|
|
' rs.setValue "Typ", ";" & strTyp & ";"
|
|
' rs.setValue "Typzusatz", ";" & strTypZusatz & ";"
|
|
' rs.setValue "Nennweite", ";" & lngNennweite & ";"
|
|
' rs.setValue "ImpulswertigkeitLWL", 0
|
|
' rs.update
|
|
GetLWLImpulswertigkeit = 0
|
|
Else
|
|
GetLWLImpulswertigkeit = rs.getLongValue("ImpulswertigkeitLWL")
|
|
End If
|
|
|
|
Exit Function
|
|
Errorhandler:
|
|
GetLWLImpulswertigkeit = 0
|
|
LogIntoDB "Fehler " & Err.Number & " in GetLWLImpulswertigkeit(): " & Err.Description, "Softwarefehler"
|
|
End Function
|
|
|
|
|
|
Private Sub SetzeLWLPruefzeiten(Pruefpunkte As CPruefpunktCol, AuftragPosition As CAuftragPosition, IdentNrObj As CIdentNr)
|
|
On Error GoTo Errorhandler
|
|
|
|
Dim lngIdentNr As Long
|
|
Dim strMetrolog As String
|
|
Dim strKurzBez As String
|
|
Dim strTyp As String
|
|
Dim strTypzusatz As String
|
|
Dim lngNennweite As Long
|
|
Dim blnIsEncoder As Boolean
|
|
Dim lngTemperatur As Long
|
|
Dim intPruefpunktanzahl As Integer
|
|
Dim objBestellcode As CBestellcode
|
|
|
|
Dim strSQL As String
|
|
Dim strSQL2 As String
|
|
Dim strVerhaeltnisQ3Q1 As String
|
|
Dim strZulassungskennzeichen As String
|
|
|
|
Dim rs As CRecordset
|
|
Dim intPPNr As Integer
|
|
|
|
DebugMsg "SetzeLWLPruefzeiten():"
|
|
|
|
intPruefpunktanzahl = Pruefpunkte.getCollection.Count
|
|
|
|
strMetrolog = AuftragPosition.getMetrolog
|
|
|
|
lngIdentNr = IdentNrObj.getNr
|
|
strKurzBez = IdentNrObj.GetKurzBezeichnung
|
|
strTyp = IdentNrObj.getTyp
|
|
strTypzusatz = IdentNrObj.getTypzusatz
|
|
lngNennweite = IdentNrObj.getNennweite
|
|
lngTemperatur = IdentNrObj.GetTemperatur
|
|
strZulassungskennzeichen = GetWertFromZusatztext(AuftragPosition.getZusatztext, "Zulassungskennzeichen :")
|
|
|
|
If IdentNrObj.GetBestellgruppe > 0 And AuftragPosition.GetBestellcode <> "" Then
|
|
Set objBestellcode = New CBestellcode
|
|
objBestellcode.load AuftragPosition.GetBestellcode, IdentNrObj.GetBestellgruppe
|
|
blnIsEncoder = IsEncoder(objBestellcode)
|
|
strVerhaeltnisQ3Q1 = objBestellcode.GetWert("Verhaeltnis_Q3_Q1")
|
|
End If
|
|
|
|
|
|
|
|
strSQL = "SELECT * from LWL_Pruefzeiten "
|
|
strSQL = strSQL & " WHERE aktiv=1 "
|
|
strSQL = strSQL & " AND (IdentNr like '%;" & lngIdentNr & ";%' OR IdentNr = ';*;')"
|
|
|
|
|
|
' If AuftragPosition.getPrf_nach_MID Then
|
|
' strSQL = strSQL & " AND (Metrolog like '%;MID%;' OR Metrolog = ';*;') "
|
|
' Else
|
|
strSQL = strSQL & " AND (Metrolog like '%;" & strMetrolog & ";%' OR Metrolog = ';*;') "
|
|
' End If
|
|
|
|
If strVerhaeltnisQ3Q1 <> "" Then
|
|
strSQL = strSQL & " AND (VerhaeltnisQ3Q1 like '%;" & strVerhaeltnisQ3Q1 & ";%' OR VerhaeltnisQ3Q1 = ';*;') "
|
|
End If
|
|
|
|
strSQL = strSQL & " AND (KurzBez like '%;" & strKurzBez & ";%' OR KurzBez = ';*;') "
|
|
strSQL = strSQL & " AND (Typ like '%;" & strTyp & ";%' OR Typ = ';*;') "
|
|
|
|
strSQL = strSQL & " AND (Typzusatz like '%;" & strTypzusatz & ";%' OR Typzusatz = ';*;') "
|
|
strSQL = strSQL & " AND (Nennweite like '%;" & lngNennweite & ";%' OR Nennweite = ';*;') "
|
|
strSQL = strSQL & " AND (Temperatur like '%;" & lngTemperatur & ";%' OR Temperatur = ';*;') "
|
|
strSQL = strSQL & " AND (Encoder like '%;" & IIf(blnIsEncoder, "1", "0") & ";%' OR Encoder = ';*;') "
|
|
strSQL = strSQL & " AND (Zulassungskennzeichen like '%;" & strZulassungskennzeichen & ";%' OR Zulassungskennzeichen = ';*;') "
|
|
strSQL = strSQL & " ORDER BY Prioritaet"
|
|
Set rs = New CRecordset
|
|
|
|
rs.openRS strSQL, True
|
|
DebugMsg strSQL
|
|
|
|
If rs.EOF Then
|
|
' es wurde kein aktiver Datensatz gefunden.
|
|
|
|
' suchen nach einem inaktiven Datensatz
|
|
strSQL = Replace(strSQL, " aktiv=1 ", " aktiv=0 ")
|
|
DebugMsg strSQL
|
|
|
|
rs.openRS strSQL, False
|
|
|
|
If rs.EOF Then
|
|
' es gibt auch keinen inaktiven Datensatz
|
|
' also Dummy Datensatz anlegen
|
|
rs.addNew
|
|
rs.setValue "aktiv", 0
|
|
rs.setValue "Metrolog", ";" & strMetrolog & ";"
|
|
rs.setValue "KurzBez", ";" & strKurzBez & ";"
|
|
rs.setValue "Typ", ";" & strTyp & ";"
|
|
rs.setValue "Typzusatz", ";" & strTypzusatz & ";"
|
|
rs.setValue "Nennweite", ";" & lngNennweite & ";"
|
|
rs.setValue "Encoder", IIf(blnIsEncoder, ";1;", ";0;")
|
|
rs.setValue "Temperatur", ";" & lngTemperatur & ";"
|
|
rs.setValue "VerhaeltnisQ3Q1", ";" & strVerhaeltnisQ3Q1 & ";"
|
|
rs.setValue "Zulassungskennzeichen", ";" & strZulassungskennzeichen & ";"
|
|
|
|
For intPPNr = 1 To intPruefpunktanzahl
|
|
Debug.Print "PP" & intPPNr
|
|
rs.setValue "T" & intPPNr, Pruefpunkte.Item(intPPNr).GetTime
|
|
Next
|
|
rs.update
|
|
|
|
Dim strMailtext As String
|
|
Dim varFeld As Variant
|
|
|
|
strMailtext = "LWL Prüfung an Prüfstation " & g_App.PruefstationNr & vbCrLf
|
|
strMailtext = strMailtext & "Es wurde ein neuer Datensatz in Tabelle LWL_Pruefzeiten eingefügt. Bitte pflegen!" & vbCrLf & vbCrLf
|
|
|
|
strMailtext = strMailtext & "Eigenschaften: " & vbCrLf
|
|
For Each varFeld In rs.GetRecordsetObject.Fields
|
|
strMailtext = strMailtext & varFeld.Name & " = " & rs.GetRecordsetObject.Fields(varFeld.Name).value & vbCrLf
|
|
Next
|
|
|
|
strMailtext = strMailtext & "" & vbCrLf
|
|
strMailtext = strMailtext & "zugehoerige Datenbank Abfrage:" & vbCrLf
|
|
strMailtext = strMailtext & "" & strSQL & vbCrLf
|
|
strMailtext = strMailtext & "" & vbCrLf
|
|
strMailtext = strMailtext & "Um die LWL Prüfzeiten für diesen Zähler zu ändern, können sie nun die Eigenschaft aktiv=1 setzen." & vbCrLf
|
|
|
|
SendMail "nobody@sensus.com", "peter.buch@sensus.com", "Neuer Datensatz in LWL_Pruefzeiten", strMailtext
|
|
Else
|
|
' es gibt bereits einen inaktiven Datensatz
|
|
' hier muss nichts getan werden
|
|
' Stattdessen sollten die Prüfpunkte überprüft u. gepflegt und dann aktiv werden
|
|
End If
|
|
Else
|
|
Select Case rs.RecordCount
|
|
Case 1
|
|
'm_lng_LWLImpulswertigkeit = rs.getLongValue("Impulswertigkeit")
|
|
|
|
For intPPNr = 1 To intPruefpunktanzahl
|
|
Debug.Print "T" & intPPNr & "=" & rs.getLongValue("T" & intPPNr)
|
|
DebugMsg "T" & intPPNr & "=" & rs.getLongValue("T" & intPPNr)
|
|
Pruefpunkte.Item(intPPNr).SetTime rs.getLongValue("T" & intPPNr)
|
|
Next
|
|
Case Else
|
|
MsgBox "mehrere passende Datensätze in Tabelle LWL_Pruefzeiten " & vbCrLf & strSQL
|
|
End Select
|
|
End If
|
|
|
|
Exit Sub
|
|
Errorhandler:
|
|
LogIntoDB "Fehler " & Err.Number & " in SetzeLWLPruefzeiten(): " & Err.Description, "Softwarefehler"
|
|
Exit Sub
|
|
Resume
|
|
|
|
End Sub
|
|
|
|
Private Function IsEncoder(objBestellcode As CBestellcode) As Boolean
|
|
Dim strTemp As String
|
|
|
|
strTemp = objBestellcode.GetWert("Anzeige")
|
|
If InStr(1, LCase(strTemp), LCase("Encoder")) > 0 Then
|
|
IsEncoder = True
|
|
WriteToLog "Zähler wird als Encoder identifiziert, da im Bestellcode 'Encoder' in Anzeige='" & strTemp & "'"
|
|
End If
|
|
|
|
If InStr(1, LCase(strTemp), LCase("Hybrid")) > 0 Then
|
|
IsEncoder = True
|
|
WriteToLog "Zähler wird als Encoder identifiziert, da im Bestellcode 'Hybrid' in Anzeige='" & strTemp & "'"
|
|
End If
|
|
|
|
If InStr(1, LCase(strTemp), LCase("Electr ")) > 0 Then
|
|
IsEncoder = True
|
|
WriteToLog "Zähler wird als Encoder identifiziert, da im Bestellcode 'Electr ' in Anzeige='" & strTemp & "'"
|
|
End If
|
|
|
|
strTemp = objBestellcode.GetWert("GWZ_NEBENZAEHLER")
|
|
If InStr(1, LCase(strTemp), LCase("Encoder")) > 0 Then
|
|
WriteToLog "Zähler wird als Encoder identifiziert, da im Bestellcode 'Encoder' in GWZ_NEBENZAEHLER='" & strTemp & "'"
|
|
IsEncoder = True
|
|
End If
|
|
|
|
strTemp = objBestellcode.GetWert("GWZ_WERKE_UND_ANZEIGE")
|
|
If InStr(1, LCase(strTemp), LCase("Encoder")) > 0 Then
|
|
WriteToLog "Zähler wird als Encoder identifiziert, da im Bestellcode 'Encoder' in GWZ_WERKE_UND_ANZEIGE='" & strTemp & "'"
|
|
IsEncoder = True
|
|
End If
|
|
|
|
strTemp = objBestellcode.GetWert("Modultyp")
|
|
If InStr(1, LCase(strTemp), LCase("Encoder")) > 0 Then
|
|
WriteToLog "Zähler wird als Encoder identifiziert, da im Bestellcode 'Encoder' in Modultyp='" & strTemp & "'"
|
|
IsEncoder = True
|
|
End If
|
|
|
|
strTemp = objBestellcode.GetWert("Zählwerk")
|
|
If InStr(1, LCase(strTemp), LCase("Encoder")) > 0 Then
|
|
WriteToLog "Zähler wird als Encoder identifiziert, da im Bestellcode 'Encoder' in Zählwerk='" & strTemp & "'"
|
|
IsEncoder = True
|
|
End If
|
|
|
|
strTemp = objBestellcode.GetWert("Encoder")
|
|
Select Case LCase(strTemp)
|
|
Case "1", "ja", "true"
|
|
WriteToLog "Zähler wird als Encoder identifiziert, da im Bestellcode Encoder=" & strTemp
|
|
IsEncoder = True
|
|
Case "0", "nein", "false"
|
|
WriteToLog "Zähler wird nicht als Encoder identifiziert, da im Bestellcode Encoder=" & strTemp
|
|
IsEncoder = False
|
|
Case Else
|
|
' keine Angabe
|
|
End Select
|
|
|
|
m_blnIsEncoder = IsEncoder
|
|
End Function
|
|
|
|
|
|
|
|
Private Function GetMetrologFromSpezifikationen(Bestellcode As CBestellcode) As String
|
|
Dim rs As CRecordset
|
|
Dim strSQL As String
|
|
Dim strNennweite As String
|
|
|
|
Dim strTyp As String
|
|
Dim strTypzusatz As String
|
|
Dim strCSD As String
|
|
|
|
strTyp = Bestellcode.GetWert("Typ")
|
|
strTypzusatz = Bestellcode.GetWert("Typzusatz")
|
|
strCSD = Bestellcode.GetWert("CSD")
|
|
strNennweite = Bestellcode.GetWert("Nennweite")
|
|
|
|
'1(5): Produktbezeichnung=Meistream
|
|
'1(5): Typ=MS
|
|
'2(1): KurzBez=WZ
|
|
'2(1): MS_Hochgenauigkeit=Plus, Komplettzähler
|
|
'2(1): Typzusatz=Plus
|
|
'3(M): Eichkennzeichnung=International (Sensuswerte)
|
|
'4(19): CSD=CSD 38134-3-SA
|
|
'4(19): Logo=Sabesp CSD 38134-3-SA
|
|
'6(B): Nennweite=50
|
|
'9(1): Druck=16
|
|
'10(F): Baulaenge=270
|
|
'11(8): Bohrung=NBR 7669/1982 PN16
|
|
'12(1): Temperatur=30
|
|
'12(1): Temperaturstufe=kalt
|
|
'13(A): Zählwerk=D-Werk mech.
|
|
'14(1): Anzeige=m³
|
|
'15(X): Modultyp=kein MODULME
|
|
|
|
strSQL = "SELECT ID, Metrolog from Spezifikationen where (Typ = '" & strTyp & "' or Typ like '%;" & strTyp & ";%' or Typ like ';*;')"
|
|
If strTypzusatz <> "" Then
|
|
strSQL = strSQL & " and (Typzusatz = '" & strTypzusatz & "' or Typzusatz like ';" & strTypzusatz & ";' or Typzusatz like '%;*;%')"
|
|
Else
|
|
strSQL = strSQL & " and (Typzusatz = '' or Typzusatz like '%;;%' or Typzusatz like '%;*;%' or Typzusatz is NULL)"
|
|
End If
|
|
|
|
If strNennweite <> "" Then
|
|
strSQL = strSQL & " and (Nennweite = '" & strNennweite & "' or Nennweite like ';*;%' or Nennweite is null) "
|
|
End If
|
|
|
|
If strCSD <> "" Then
|
|
strSQL = strSQL & " and (CSD = '" & strCSD & "' or CSD like '%;" & strCSD & ";%' or CSD like ';*;') "
|
|
End If
|
|
|
|
|
|
If Me.getAuftrag.getKundenNr <> 0 Then
|
|
strSQL = strSQL & " and (KundenNr = " & Me.getAuftrag.getKundenNr & " or KundenNr is null) "
|
|
End If
|
|
|
|
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, True
|
|
Debug.Print strSQL
|
|
|
|
If Not rs.EOF Then
|
|
If rs.RecordCount > 1 Then
|
|
BenachrichtigeDatenpflege "Es ist mehr als eine (=" & rs.RecordCount & ") passende Metrolog in der Tabelle Spezifikationen vorhanden. Bitte Daten pflegen!" & vbCrLf & strSQL
|
|
End If
|
|
GetMetrologFromSpezifikationen = rs.getStringValue("Metrolog")
|
|
DebugMsg "Es wird die Metrolog '" & GetMetrologFromSpezifikationen & "' aus der Spezifikation " & rs.getLongValue("ID") & " verwendet."
|
|
End If
|
|
Exit Function
|
|
Errorhandler:
|
|
LogIntoDB "Fehler " & Err.Number & " in GetMetrologFromSpezifikationen(): " & Err.Description, "Softwarefehler"
|
|
Exit Function
|
|
Resume
|
|
End Function
|
|
|
|
|
|
|
|
Public Function loadForSerienNr_neu(lSerienNr As Long, Optional AuftragNr As Long) As Boolean
|
|
Dim AuftragpositionSerienNr As CAuftragPositionSerienNr
|
|
Dim AuftragPosition As CAuftragPosition
|
|
Dim Auftrag As CAuftrag
|
|
Dim Pruefpunkte As CPruefpunkte
|
|
Dim sPruefklasseKZ As String
|
|
Dim IdentNr As Long
|
|
Dim IdentNrObj As CIdentNr
|
|
Dim Bestellcode As CBestellcode
|
|
Dim VakoCode As CVakoCode
|
|
Dim Ratio As Double
|
|
Dim dblNenndurchfluss As Double
|
|
Dim KZP As CKZP
|
|
Dim intKZP As Integer
|
|
|
|
m_strPruefpunktInfo = ""
|
|
|
|
Set AuftragpositionSerienNr = loadAuftragPositionSerienNr(lSerienNr, AuftragNr)
|
|
If AuftragpositionSerienNr Is Nothing Then
|
|
loadForSerienNr_neu = False
|
|
Exit Function
|
|
End If
|
|
|
|
DebugMsg "loadForSerienNr_neu: " & lSerienNr & " aus " & AuftragpositionSerienNr.getAuftragNr & "/" & AuftragpositionSerienNr.getPositionNr
|
|
|
|
' Auftragsdaten holen
|
|
' -------------------
|
|
Set AuftragPosition = loadAuftragPositionForSerienNr()
|
|
If AuftragPosition Is Nothing Then
|
|
Exit Function
|
|
End If
|
|
|
|
Set Auftrag = loadAuftrag(AuftragPosition.getAuftragNr())
|
|
If Auftrag Is Nothing Then
|
|
Exit Function
|
|
End If
|
|
Set m_Auftrag = Auftrag
|
|
|
|
' Prüfpunkte laden
|
|
' ----------------
|
|
Set Pruefpunkte = New CPruefpunkte
|
|
|
|
If AuftragPosition.getMetrolog <> "" Then
|
|
Debug.Print "Metrolog '" & AuftragPosition.getMetrolog & "' vorhanden "
|
|
End If
|
|
|
|
' PruefklasseKZ bestimmen
|
|
'------------------------
|
|
If AuftragPosition.getMetrolog() <> "" Then
|
|
sPruefklasseKZ = Trim(AuftragPosition.getMetrolog())
|
|
Debug.Print "AuftragPosition getMetrolog = '" & sPruefklasseKZ & "'"
|
|
Else
|
|
Debug.Print "AuftragPosition.getMetrolog ist leer"
|
|
End If
|
|
|
|
' IdentNr laden
|
|
' -------------
|
|
IdentNr = AuftragPosition.getIdentNr()
|
|
Set IdentNrObj = loadIdentNr(IdentNr)
|
|
Debug.Print IdentNrObj.GetBestellgruppe
|
|
|
|
If AuftragPosition.GetBestellcode <> "" And IdentNrObj.GetBestellgruppe <> 0 Then
|
|
Debug.Print "Bestellcode " & AuftragPosition.GetBestellcode & " auswerten nach Gruppe " & IdentNrObj.GetBestellgruppe
|
|
Set Bestellcode = New CBestellcode
|
|
If Bestellcode.load(AuftragPosition.GetBestellcode, IdentNrObj.GetBestellgruppe) Then
|
|
' setze Eigenschaften vom Bestellcode
|
|
' Metrolog
|
|
If Bestellcode.GetWert("Metrolog") <> "" Then
|
|
sPruefklasseKZ = Bestellcode.GetWert("Metrolog")
|
|
End If
|
|
|
|
If Bestellcode.GetWert("KZP") <> "" Then
|
|
intKZP = Bestellcode.GetWert("KZP")
|
|
End If
|
|
|
|
If Bestellcode.GetWert("Nenndurchfluss") > 0 And Bestellcode.GetWert("Nenndurchfluss") > 0 Then
|
|
' Nenndurchfluss
|
|
' Verhaeltnis_Q3_Q1 (Ratio)
|
|
' Prüfpunkte nach MID
|
|
If Pruefpunkte.CreateMIDPruefpunkteFromBestellcode(Bestellcode) Then
|
|
' Prüfpunkte nach MID wurden erzeugt
|
|
m_strPruefpunktInfo = m_strPruefpunktInfo & "Prf nach MID aus Bestellcode."
|
|
GoTo DatenSchreiben
|
|
End If
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
If IdentNrObj.GetVakoCode <> "" Then
|
|
Set VakoCode = New CVakoCode
|
|
If VakoCode.load(IdentNrObj.GetVakoCode) Then
|
|
m_strPruefpunktInfo = "Vakocode "
|
|
If VakoCode.GetWert("Metrolog") <> "" Then
|
|
' Die Metrolog im VakoCode kann in der Auftragposition überschrieben werden
|
|
' sPruefklasseKZ = VakoCode.GetWert("Metrolog")
|
|
' m_strPruefpunktInfo = m_strPruefpunktInfo & "Metrolog aus Vakocode. "
|
|
End If
|
|
If Pruefpunkte.CreateMIDPruefpunkteFromVakoCode(VakoCode) Then
|
|
m_strPruefpunktInfo = m_strPruefpunktInfo & "Nach MID aus Vakocode."
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
If intKZP > 0 Then
|
|
Set KZP = New CKZP
|
|
If KZP.load(intKZP) Then
|
|
If KZP.getPruefklasseKZ <> "" Then
|
|
sPruefklasseKZ = KZP.getPruefklasseKZ
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
If sPruefklasseKZ <> "" Then
|
|
If Pruefpunkte.load(IdentNr, sPruefklasseKZ) Then
|
|
m_strPruefpunktInfo = m_strPruefpunktInfo & "PP Tabelle aus IdenTnr " & IdentNr & " u. Metrolog '" & sPruefklasseKZ & "'"
|
|
End If
|
|
End If
|
|
|
|
|
|
|
|
DatenSchreiben:
|
|
|
|
If Not Pruefpunkte Is Nothing Then
|
|
' Wenn LWL gewählt ist, dann Prüfzeiten aus Tabelle LWL_Pruefzeiten beziehen
|
|
If g_blnPrfMitLWL = True And Pruefpunkte.getPruefpunkteCount > 0 Then
|
|
SetzeLWLPruefzeiten Pruefpunkte.getPruefpunkte, AuftragPosition, IdentNrObj
|
|
m_lng_LWLImpulswertigkeit = GetLWLImpulswertigkeit(IdentNrObj, AuftragPosition)
|
|
End If
|
|
End If
|
|
|
|
' Daten erst jetzt in Member-Variablen schreiben!
|
|
' -----------------------------------------------
|
|
m_lSerienNr = lSerienNr
|
|
m_nKZP = AuftragPosition.getKZP
|
|
m_lIdentNr = AuftragPosition.getIdentNr()
|
|
m_Bemerkung = AuftragpositionSerienNr.getBemerkung()
|
|
m_sPruefklasseKZ = sPruefklasseKZ
|
|
m_strKundeneigeneSerienNr = AuftragpositionSerienNr.getKundeneigeneSerienNr
|
|
|
|
Set m_Auftrag = Auftrag
|
|
Set m_AuftragPosition = AuftragPosition
|
|
Set m_IdentNr = IdentNrObj
|
|
Set m_KZP = KZP
|
|
Set m_Pruefpunkte = Pruefpunkte
|
|
|
|
LoadForSerienNrOK:
|
|
loadForSerienNr_neu = True
|
|
Exit Function
|
|
|
|
loadForSerienNrErr:
|
|
Call showError("loadForSerienNrErr")
|
|
|
|
Exit Function
|
|
Resume
|
|
End Function
|
|
|
|
|
|
Public Function IstRueckläufer() As Boolean
|
|
Dim rs As CRecordset
|
|
Dim strSQL As String
|
|
IstRueckläufer = False
|
|
' Nachschauen, ob dieser Zähler ein Rückläufer ist
|
|
|
|
strSQL = "SELECT * from Ruecklaeuferanalyse where SerienNr = " & getSerienNr() & " order by ID"
|
|
Debug.Print strSQL
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, True
|
|
If Not rs.EOF Then
|
|
' Dieser Zähler ist oder war schon einmal ein Rückläufer
|
|
' man muss den letzten Eintrag betrachten, um zu sehen, ob die Reparatur erfolgreich war
|
|
rs.MoveLast
|
|
If rs.getBooleanValue("ReparaturErfolgreich") = True Then
|
|
' Nachdem die Reparatur erfolgreich war, ist dieser Zähler nun kein Rückläufer mehr.
|
|
' Der Vorgang ist abgeschlossen!
|
|
IstRueckläufer = False
|
|
Else
|
|
IstRueckläufer = True
|
|
End If
|
|
Else
|
|
IstRueckläufer = False
|
|
End If
|
|
End Function
|
|
|
|
|
|
|
|
|