marekf/laatzen
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
main
laatzen/Pruef2000/source/frmGenesisPruefung.frm
Rowlander 70e2645059 Initial commit 3
2021-10-01 11:11:04 +02:00

9151 lines
379 KiB
Plaintext
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.2#0"; "MSCOMCTL.OCX"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx"
Begin VB.Form frmGenesisPruefung
Caption = "Pruef2000 eRegister Prüfung"
ClientHeight = 13470
ClientLeft = 165
ClientTop = 450
ClientWidth = 17685
LinkTopic = "Form1"
ScaleHeight = 13470
ScaleWidth = 17685
StartUpPosition = 3 'Windows-Standard
Begin VB.Frame frameTest
Caption = "Test"
Height = 1095
Left = 5520
TabIndex = 36
Top = 10320
Visible = 0 'False
Width = 10395
Begin VB.CommandButton cmdFunkadresse
Caption = "Funkadresse"
Height = 315
Left = 5460
TabIndex = 56
Top = 240
Width = 1095
End
Begin VB.CommandButton cmdInit
Caption = "Prf init"
Height = 315
Left = 60
TabIndex = 55
Top = 240
Width = 795
End
Begin VB.CommandButton cmdLEDausSleep
Caption = "Aus"
Height = 315
Left = 2040
TabIndex = 54
ToolTipText = "LED und Funk aus"
Top = 240
Width = 675
End
Begin VB.CommandButton cmdAbschluss
Caption = "Abbschluss"
Height = 315
Left = 900
TabIndex = 53
Top = 240
Width = 1095
End
Begin VB.CommandButton cmdOptoStart
Caption = "Opto an"
Height = 315
Left = 2760
TabIndex = 52
Top = 240
Width = 735
End
Begin VB.CommandButton cmdOptoAus
Caption = "Opto aus"
Height = 315
Left = 3540
TabIndex = 51
Top = 240
Width = 795
End
Begin VB.CommandButton cmdVerwKonrolle
Caption = "Verw Check"
Height = 315
Left = 4380
TabIndex = 50
Top = 240
Width = 1035
End
Begin VB.CommandButton cmdLEDAn
Caption = "LED an"
Height = 315
Left = 6660
TabIndex = 49
Top = 240
Width = 735
End
Begin VB.CommandButton cmd1Messung
Caption = "Mess"
Height = 315
Left = 7440
TabIndex = 48
Top = 240
Width = 495
End
Begin VB.CommandButton cmdInitSirt
Caption = "Init SIRT"
Height = 315
Left = 2880
TabIndex = 47
Top = 660
Width = 855
End
Begin VB.CommandButton cmdCheckFunk
Caption = "RadioCheck"
Height = 435
Left = 8880
TabIndex = 46
Top = 180
Width = 735
End
Begin VB.CommandButton cmdSetDateTime
Caption = "DateTime"
Height = 255
Left = 60
TabIndex = 45
Top = 600
Width = 1035
End
Begin VB.CommandButton cmdRelease
Caption = "Release SIRT"
Height = 315
Left = 3780
TabIndex = 44
Top = 660
Width = 1155
End
Begin VB.CommandButton cmdTextFunkschluesel
Caption = "funkschlüssel Test"
Height = 375
Left = 5100
TabIndex = 43
Top = 600
Width = 1455
End
Begin VB.CommandButton cmdClearPamReg
Caption = "ClearPamReg"
Height = 375
Left = 6660
TabIndex = 42
Top = 600
Width = 1095
End
Begin VB.CommandButton cmdErgebnis
Caption = "Ergebnis Simu"
Height = 315
Left = 1440
TabIndex = 41
Top = 660
Width = 1335
End
Begin VB.CommandButton cmdPowerlevel
Caption = "PowerLevel"
Height = 315
Left = 8580
TabIndex = 40
Top = 660
Width = 1035
End
Begin VB.CommandButton cmdSchliessen
Caption = "S"
Height = 315
Left = 9660
TabIndex = 39
Top = 660
Width = 675
End
Begin VB.CommandButton cmdOeffnen
Caption = "Ö"
Height = 315
Left = 9660
TabIndex = 38
Top = 240
Width = 675
End
Begin VB.CommandButton cmdActFlow
Caption = "ActFlow"
Height = 375
Left = 7800
TabIndex = 37
Top = 600
Width = 735
End
End
Begin VB.Frame frmRegulierungErgebnisse
Caption = "Regulierung / Messung"
Height = 3495
Left = 10380
TabIndex = 26
Top = 6180
Visible = 0 'False
Width = 5295
Begin VB.Label Label9
Caption = "%"
BeginProperty Font
Name = "Arial Narrow"
Size = 36
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Index = 3
Left = 4380
TabIndex = 32
Top = 2220
Width = 555
End
Begin VB.Label Label9
Caption = "%"
BeginProperty Font
Name = "Arial Narrow"
Size = 36
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Index = 2
Left = 4380
TabIndex = 31
Top = 600
Width = 555
End
Begin VB.Label Label9
Caption = "2"
BeginProperty Font
Name = "Arial Narrow"
Size = 36
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Index = 1
Left = 240
TabIndex = 30
Top = 2100
Width = 435
End
Begin VB.Label Label9
Caption = "1"
BeginProperty Font
Name = "Arial Narrow"
Size = 36
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Index = 0
Left = 180
TabIndex = 29
Top = 660
Width = 435
End
Begin VB.Label lblFehler
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
BeginProperty Font
Name = "Arial"
Size = 60
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1395
Index = 2
Left = 780
TabIndex = 28
Top = 1920
Width = 3315
End
Begin VB.Label lblFehler
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
BeginProperty Font
Name = "Arial"
Size = 60
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1335
Index = 1
Left = 780
TabIndex = 27
Top = 420
Width = 3315
End
End
Begin VB.Frame frmOeffnenSchliessen
Caption = "Öffnen / Schließen Status"
Height = 6195
Left = 8940
TabIndex = 18
Top = 0
Visible = 0 'False
Width = 6735
Begin VB.Label lblHZNZ
Caption = "NZ"
BeginProperty Font
Name = "Arial Narrow"
Size = 36
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Index = 4
Left = 180
TabIndex = 35
Top = 4920
Width = 795
End
Begin VB.Label lblHZNZ
Caption = "HZ"
BeginProperty Font
Name = "Arial Narrow"
Size = 36
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Index = 3
Left = 180
TabIndex = 34
Top = 3780
Width = 795
End
Begin VB.Label lblHZNZ
Caption = "NZ"
BeginProperty Font
Name = "Arial Narrow"
Size = 36
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Index = 2
Left = 180
TabIndex = 33
Top = 2100
Width = 795
End
Begin VB.Label Label4
Caption = "1"
BeginProperty Font
Name = "Courier New"
Size = 30
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3480
TabIndex = 25
Top = 120
Width = 375
End
Begin VB.Label lblAufZu
Alignment = 2 'Zentriert
BorderStyle = 1 'Fest Einfach
Caption = "---------"
BeginProperty Font
Name = "Courier New"
Size = 48
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Index = 4
Left = 1140
TabIndex = 24
Top = 4860
Width = 5415
End
Begin VB.Label lblAufZu
Alignment = 2 'Zentriert
BorderStyle = 1 'Fest Einfach
Caption = "---------"
BeginProperty Font
Name = "Courier New"
Size = 48
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Index = 3
Left = 1140
TabIndex = 23
Top = 3660
Width = 5415
End
Begin VB.Label lblAufZu
Alignment = 2 'Zentriert
BorderStyle = 1 'Fest Einfach
Caption = "---------"
BeginProperty Font
Name = "Courier New"
Size = 48
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Index = 2
Left = 1140
TabIndex = 22
Top = 1920
Width = 5415
End
Begin VB.Label lblHZNZ
Caption = "HZ"
BeginProperty Font
Name = "Arial Narrow"
Size = 36
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Index = 1
Left = 180
TabIndex = 21
Top = 960
Width = 795
End
Begin VB.Label Label3
Caption = "2"
BeginProperty Font
Name = "Courier New"
Size = 30
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 3540
TabIndex = 20
Top = 3120
Width = 675
End
Begin VB.Label lblAufZu
Alignment = 2 'Zentriert
BorderStyle = 1 'Fest Einfach
Caption = "---------"
BeginProperty Font
Name = "Courier New"
Size = 48
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Index = 1
Left = 1140
TabIndex = 19
Top = 720
Width = 5415
End
End
Begin VB.Frame frameButtons
Height = 975
Left = 9780
TabIndex = 15
Top = 11460
Width = 5415
Begin VB.CommandButton cmdCancel
BackColor = &H00C0C0FF&
Caption = "Abbruch"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 675
Left = 3240
Style = 1 'Grafisch
TabIndex = 17
ToolTipText = "aktuellen Vorgang abbrechen"
Top = 180
Width = 1995
End
Begin VB.CommandButton cmdWeiter
BackColor = &H0080FF80&
Caption = "Weiter"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 675
Left = 180
MaskColor = &H8000000B&
Style = 1 'Grafisch
TabIndex = 16
ToolTipText = "weiter mit dem nächsten Schritt"
Top = 180
Width = 2955
End
End
Begin VB.Timer Timer2
Left = 0
Top = 0
End
Begin VB.Frame frameVerwechselungskontrolle
Caption = "Verwechslungskontrolle "
Height = 975
Left = 0
TabIndex = 10
Top = 11460
Visible = 0 'False
Width = 9735
Begin VB.TextBox txtBarcodeScanner
BackColor = &H00FFFFFF&
Height = 315
Left = 8520
TabIndex = 11
Top = 240
Width = 1095
End
Begin VB.Label lblEinbauplatzNr
BorderStyle = 1 'Fest Einfach
BeginProperty Font
Name = "MS Sans Serif"
Size = 24
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 7860
TabIndex = 13
Top = 240
Width = 615
End
Begin VB.Label lblBarcodeScan
BorderStyle = 1 'Fest Einfach
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 120
TabIndex = 12
Top = 240
Width = 7695
End
End
Begin MSComctlLib.ProgressBar ProgressBar1
Height = 255
Left = 60
TabIndex = 9
Top = 9960
Visible = 0 'False
Width = 15135
_ExtentX = 26696
_ExtentY = 450
_Version = 393216
Appearance = 1
End
Begin VB.Timer Timer1
Left = 15060
Top = 10080
End
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Unten ausrichten
Height = 315
Left = 0
TabIndex = 4
Top = 13155
Width = 17685
_ExtentX = 31194
_ExtentY = 556
Style = 1
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
EndProperty
End
Begin MSFlexGridLib.MSFlexGrid MSFlexGridRZ
Height = 4035
Left = 15900
TabIndex = 3
Top = 4260
Width = 2595
_ExtentX = 4577
_ExtentY = 7117
_Version = 393216
End
Begin VB.TextBox txtOut
Height = 4245
Left = 15900
MultiLine = -1 'True
ScrollBars = 2 'Vertikal
TabIndex = 2
Top = 60
Width = 2565
End
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1
Height = 9855
Left = 60
TabIndex = 0
Top = 0
Width = 15735
_ExtentX = 27755
_ExtentY = 17383
_Version = 393216
End
Begin MSCommLib.MSComm MSComm1
Index = 0
Left = 16980
Top = 7680
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin VB.Frame FrameRegulierung
Caption = "Regulierung"
Height = 1095
Left = 0
TabIndex = 5
Top = 10380
Visible = 0 'False
Width = 4755
Begin VB.CheckBox chkKontinuierlich
Caption = "kontinuierlich Messen"
Height = 375
Left = 3240
TabIndex = 14
Top = 360
Width = 1275
End
Begin VB.ComboBox cmbRegulierPruefzeit
Height = 315
Left = 1920
TabIndex = 7
Text = "Combo1"
Top = 420
Width = 930
End
Begin VB.CommandButton cmdRegulierungMessung
Caption = " Messung"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 240
TabIndex = 6
Top = 420
Width = 1515
End
Begin VB.Label Label1
Caption = "s"
Height = 315
Left = 2940
TabIndex = 8
Top = 420
Width = 135
End
End
Begin VB.Label lblAutosize
AutoSize = -1 'True
BorderStyle = 1 'Fest Einfach
Caption = "Label1"
Height = 255
Left = 8340
TabIndex = 1
Top = 10080
Width = 540
End
End
Attribute VB_Name = "frmGenesisPruefung"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const FUNKSCHLUESSEL_SENSUS_STANDARD = "E6C88800DEB868C0D6A84880CE982840"
Public m_colEinbauplatz As Collection ' wird vom parent Formular übergeben, enthält alle Einbauplatz Objekte
Private mstrBuffer(10) As String ' für jeden Einbauplatz ein String für empfangende Daten
Private m_Referenzzaehler As CRefzaehler ' der ausgewähle RefZähler für den anzuwhlenden Strang
Private m_iErsterBelegterEinbauplatz As Integer 'dient zur Auswahl des FM85 für den Refzähler
Private m_iGescannterEinbauplatz As Integer
Public m_dblSolldurchfluss As Double ' Solldurchfluss laut Prüfpunkt
Public m_dblRefZfehler As Double ' Fehler des Referenzzählers im Solldurchfluss
Public m_lSollPruefzeit_s As Long ' Soll Prüfzeit laut Prüfpunkt
Public m_dblReferenzvolumen As Double ' gemessenes Volumen, das vom Referenzzähler während der Prüfung durchflossen wurde
Public m_dblRefzDurchfluss As Double ' gemessener Durchfluss im Referenzzähler aus Voumen / Prüfzeit
Public m_PPNr As Integer
Private m_FMBus As CFMBus ' FM85 Objekt
Private m_SPS As CSPS ' SPS Objekt
Private WithEvents m_Display As CEAKIT ' Display Objekt
Attribute m_Display.VB_VarHelpID = -1
Private m_blnWeiter As Boolean
Public m_blnAbbruch As Boolean
Private mcol_BUPS As Collection
Private m_PAMZeile As Integer
Public WithEvents mSIRTStatemashine As SIRTCOM.Statemashine
Attribute mSIRTStatemashine.VB_VarHelpID = -1
Public mSIRTWrapper As SIRTCOM.Wrapper
Public mdblPruefzeitReferenz As Double
Private mblnActivated As Boolean
Private mobjInfo_DEBUG_1(10) As SIRTCOM.DEBUG
Private mobjInfo_SEMI_1(10) As SIRTCOM.SEMI
Private mobjInfo_DEBUG_2(10) As SIRTCOM.DEBUG
Private mobjInfo_SEMI_2(10) As SIRTCOM.SEMI
Private mblnCOMBusy As Boolean
Private mintFrequenz As Integer
Public mblnManuellePruefung As Boolean
Public mblnVorbereitungEbeling As Boolean
Public mblnVorbereitungFuzhoe As Boolean
Const FORMCAPTION = "Pruef2000 eRegister"
Public m_Verbundzaehler_Pruefmodus As PRUEFMODUS
'add for genesis
Public GenesisBatch As MeterBatch
Public Request As Boolean
Public Calibration As Boolean
Public CalibrationStore As Boolean
Private Enum fgRZZeile
Zeile_Rz_NW = 1
Zeile_Rz_Impulswertigkeit = 2
Zeile_Rz_SollDurchfluss = 3
Zeile_Rz_SollPruefzeit = 4
Zeile_Rz_Sollvolumen = 5
Zeile_Rz_SollImpulse = 6
Zeile_Rz_VerbleibendeImpulse = 7
Zeile_Rz_Periodendauer = 8
Zeile_Rz_FehlerInQ = 9
Zeile_Rz_RefDurchfluss = 10
Zeile_Rz_RefDurchfluss_korr = 11
End Enum
' Zählerfortschrittserkennung / CounterChangeDetection
Private m_sErsterZaehlerstand(10) As String
Public m_blnCounterChangeDetection As Boolean
Const MINIMALE_SIRTCOM_VERSION = 0.4
' Entfernt alle eRegister Daten aus den Einbauplatz-Daten, damit diese wieder neu eingelesen werden können
Private Sub Entferne_eRegister_Daten()
Dim Einbauplatz As CEinbauplatz
For Each Einbauplatz In m_colEinbauplatz
Set Einbauplatz.eRegister = Nothing
Next
End Sub
Public Function GetLeakDetectionParameter(Einbauplatz As CEinbauplatz) As Byte
On Error GoTo Errorhandler
Dim lngNennweite As Long
lngNennweite = Einbauplatz.getPruefzaehler.getIdentNrObj.getNennweite
Select Case lngNennweite
Case 50
GetLeakDetectionParameter = 87
Case 80
GetLeakDetectionParameter = 199
Case 100
GetLeakDetectionParameter = 31
Case 150
GetLeakDetectionParameter = 95
Case Else
GetLeakDetectionParameter = Val(InputBox("Bitte geben Sie den Leak Detection Parameter für Einbauplatz " & Einbauplatz.getNr & " ein"))
End Select
Exit Function
Errorhandler:
MsgBox "Fehler " & Err.Number & " : " & Err.Description
End Function
Private Function GetBrokenPipeByte(Einbauplatz As CEinbauplatz) As Byte
On Error GoTo Errorhandler
Dim lngNennweite As Long
lngNennweite = Einbauplatz.getPruefzaehler.getIdentNrObj.getNennweite
Select Case lngNennweite
Case 50
GetBrokenPipeByte = 78
Case 80
GetBrokenPipeByte = 207
Case 100
GetBrokenPipeByte = 23
Case 150
GetBrokenPipeByte = 87
Case Else
GetBrokenPipeByte = Val(InputBox("Bitte geben sie das BrokenPie Byte an", "eRegister Daten fehlen"))
End Select
Exit Function
Errorhandler:
MsgBox "Fehler " & Err.Number & " : " & Err.Description
End Function
Private Function GetMetersize(Einbauplatz As CEinbauplatz, Optional ByRef Ruecklaufsperre As Boolean) As Byte
Dim strSQL As String
Dim rs As CRecordset
Dim strDefault As String
' Achtung: später bei WPD muss die Info Rücklaufsperre aus SAP übermittelt werden.
strSQL = "SELECT * from [eRegister_Metersize] where (Typliste like '%;" & Einbauplatz.getPruefzaehler.getIdentNrObj.getTyp & ";%' "
strSQL = strSQL & " or Typliste = '" & Einbauplatz.getPruefzaehler.getIdentNrObj.getTyp & "') "
If Einbauplatz.getPruefzaehler.getIdentNrObj.getTypzusatz = "Plus" Then
strSQL = strSQL & " and Typzusatz like '%Plus%' "
ElseIf Einbauplatz.getPruefzaehler.getIdentNrObj.getTypzusatz = "MB" Then
strSQL = strSQL & " and Typzusatz like '%MB%' "
Else
strSQL = strSQL & " and (Typzusatz is null or Typzusatz ='') "
End If
If Einbauplatz.getPruefzaehler.getIdentNrObj.getTypzusatz <> "MB" Then
strSQL = strSQL & " and Nennweite = " & Einbauplatz.getPruefzaehler.getIdentNrObj.getNennweite
Else
' MB ohne Nennweite
End If
Set rs = New CRecordset
Debug.Print strSQL
rs.openRS strSQL
If Not rs.EOF Then
If rs.RecordCount = 1 Then
GetMetersize = rs.getByteValue("Metersize")
Ruecklaufsperre = rs.getBooleanValue("Ruecklaufsperre")
Exit Function
Else
MsgBox "Es wurden " & rs.RecordCount & " passende Datensätze gefunden wobei genau 1 Datensatz erwartet wurde: " & vbCrLf & strSQL
GetMetersize = 0
End If
Else
MsgBox "Kein Datensatz gefunden: " & vbCrLf & strSQL
GetMetersize = 0
End If
End Function
Private Function ParametersatzNeuerVakoCmdHex(Einbauplatz As CEinbauplatz) As String
Dim strCMDHex As String
Dim intKupplungswertigkeit As Integer
Dim Laenge As Byte
Dim curValue As Currency
If Einbauplatz.getPruefzaehler Is Nothing Then Exit Function
If Einbauplatz.eRegister Is Nothing Then Exit Function
WriteToLog "Parametersatz für Einbauplatz " & Einbauplatz.getNr
Dim MeterSize As Byte
Dim blnRuecklaufsperre As Boolean
MeterSize = GetMetersize(Einbauplatz, blnRuecklaufsperre)
If MeterSize < 0 Then
MeterSize = InputBox("Metersize konnte aus den Zählereigenschaften nicht ermittelt werden. Bitte geben Sie die Metersize ein", , 37)
End If
'''''''''''''''''''''''''''''''''''''''''''''''''
'Seite 29 ESAAP Electronic Register Feature Summary Software Specification V1 0.13
'Set Metrology Parameters, Data Bytes: 16, Single Cmd (Production Mode), Auth Level 3
'''''''''''''''''''''''''''''''''''''''''''''''''
'0 Pam Length
'1-4 Volume Per Pulse (Signed, Big Endian)
'5-8 Offset Factor (Big Endian)
'9 Offset time
'10 Factory Calibration
'11 (4:0) Units
'11 (6:5) Decimal Point/Comma location
'11 (7) Use C&I rules (don't allow reverse volume)
'12 Meter Size
'13-16 Volume Per LED Pulse (Big Endian)
' Länge = 0x12 = 18 Bytes wird am Ende hinzugefügt
strCMDHex = "9210" 'PAM 146 (92h): Set Metrology Parameters, PAM Length = 16 (10h)
' CCW
curValue = (Einbauplatz.eRegister.mobj_eRegister_Auftragposition.mdblVolume_Per_puls * 65536 Or &H80000000)
' 625 oder 6250 je nach Nennweite
' Byte 1-4 Volume Per Pulse (Signed, Big Endian) as a 4 byte value where volume = value * (1/65536) ml.
' Positive value indicates clockwise rotation is forward flow when looking through the register to the meter body.
' 9210 82710000 = 130,113,0,0 = - 40960000 (/65536) = -625 ml
' 9210 986A0000 = 152,106,0,0 = - 409600000 (/65536) = -6250 ml
strCMDHex = strCMDHex & Hex8(curValue) ' 130,113,0,0 = - 40960000 (/65536) = -625 ml
'Byte 5-8 Offset Factor (Big Endian)
strCMDHex = strCMDHex & Hex8(Einbauplatz.eRegister.mobj_eRegister_Auftragposition.mcurOffset_Factor)
' "00000000" ' O-Val = 0 ml
'Byte 9 Offset time
strCMDHex = strCMDHex & Hex2(Einbauplatz.eRegister.mobj_eRegister_Auftragposition.mbytOffset_Time)
' O-Time = 5s = 05
'Byte 10 Factory Calibration
strCMDHex = strCMDHex & Hex2(Einbauplatz.eRegister.mobj_eRegister_Auftragposition.mbytFactory_calibration) ' F-Cal = 0%
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Byte11 As Byte
'Byte 11 (bit 4-0 = x * 2^0) Units
'Set Metrology Parameters Byte
'Val = Meaning Value reported in SEMI
'---------------------------------------------
'0x00=Cubic Meters (m3) 19 = 0x13 = b0001 0011
'0x01=Cubic Feet (CF) 35 = 0xA3 = b1010 0011
'0x04=US Gallons (GAL) 24 = 0x98 = b1001 1000
'0x05=Imperial Gallons (IGAL) 144 = 0x90 = b1001 0000
'0x06=Acre Feet(AF) Not implemented Not implemented
'0x07=Kiloliters (kl) 19 = 0x13 = b0001 0011
Byte11 = Einbauplatz.eRegister.mobj_eRegister_Auftragposition.GetUnitByte11
Einbauplatz.eRegister.mb_Programming_Unit = Einbauplatz.eRegister.mobj_eRegister_Auftragposition.GetUnit_bytSEMI_Value + Einbauplatz.eRegister.mobj_eRegister_Auftragposition.GetDecimalPoint_Bit56
Byte11 = Byte11 Or 2 ^ 5 * Einbauplatz.eRegister.mobj_eRegister_Auftragposition.GetDecimalPoint_Bit56
'Byte 11 (bit 6-5 x * 2^5 = x * 32 ) Decimal Point/Comma location
' value Meaning
' 0 = 3 digits to the right of the decimal point or comma ; Nennweite < 150
' 1 (32) = 2 digits to the right of the decimal point or comma; Nennweite >= 150
' 2 (64) = 1 digits to the right of the decimal point or comma (not currently supported)
' 3 (96) = No decimal point or comma
' ' Nennweite >= 150 : Byte11 = Byte11 Or 1 * 2 ^ 5 '= 2 digits to the right of the decimal point or comma
' ' Nennweite < 150 : Byte11 = Byte11 Or 0 * 2 ^ 5 '= 3 digits to the right of the decimal point or comma
'Byte 11 (bit 7) Use C&I rules (don't allow reverse volume)
Byte11 = Byte11 Or 2 ^ 7 * IIf(blnRuecklaufsperre, 1, 0)
PrintStatus "Byte11 : " & Byte11
strCMDHex = strCMDHex & Hex2(Byte11) 'Byte 11 (Unit & DecimalPint & reverse volume)
Einbauplatz.eRegister.mb_Programming_Metersize = Einbauplatz.eRegister.mobj_eRegister_Auftragposition.mbytMeter_Size
'Byte 12 Meter Size
strCMDHex = strCMDHex & Hex2(CByte(Einbauplatz.eRegister.mb_Programming_Metersize))
'strCMDHex = strCMDHex & "25" ' M-SIZE = 37 = Meistream Plus DN 50 fr Thames Water 'TODO!!! 1.1.1.8. Meter Size Tabelle nutzen
curValue = (Einbauplatz.eRegister.mobj_eRegister_Auftragposition.mdblVolume_Per_LED_Pulse * 65536)
strCMDHex = strCMDHex & Hex8(curValue)
'13-16 Volume Per LED Pulse (Big Endian, unsigned)
' "02710000" ' 2,113,0,0 = 40960000 ' 40960000/65536 = 625 ml
' "186A0000" ' 24,106,0,0 = 409600000 ' 409600000 /65536 = 6250 ml
Laenge = Len(strCMDHex) / 2
strCMDHex = Hex2(Laenge) & strCMDHex
ParametersatzNeuerVakoCmdHex = strCMDHex
' LL PmSM VolPerPu OffFactr ot FC 11 MS VpLEDPul
' 12 9210 800424A8 00000000 05 00 00 35 000424A8 (Metersize 53 mit VolPP = 4,0747944054265 ml)
' 12 9210 82710000 00000000 05 00 00 25 02710000
End Function
Private Function ParametersatzCmdHex(Einbauplatz As CEinbauplatz) As String
Dim strCMDHex As String
Dim intKupplungswertigkeit As Integer
Dim Laenge As Byte
If Einbauplatz.getPruefzaehler Is Nothing Then Exit Function
If Einbauplatz.eRegister Is Nothing Then Exit Function
WriteToLog "Parametersatz für Einbauplatz " & Einbauplatz.getNr
Dim MeterSize As Byte
Dim blnRuecklaufsperre As Boolean
MeterSize = GetMetersize(Einbauplatz, blnRuecklaufsperre)
If MeterSize < 0 Then
MeterSize = InputBox("Metersize konnte aus den Zählereigenschaften nicht ermittelt werden. Bitte geben Sie die Metersize ein", , 37)
End If
Einbauplatz.eRegister.mb_Programming_Metersize = MeterSize
'''''''''''''''''''''''''''''''''''''''''''''''''
'0 Pam Length
'1-4 Volume Per Pulse (Signed, Big Endian)
'5-8 Offset Factor (Big Endian)
'9 Offset time
'10 Factory Calibration
'11 (4:0) Units
'11 (6:5) Decimal Point/Comma location
'11 (7) Use C&I rules (don't allow reverse volume)
'12 Meter Size
'13-16 Volume Per LED Pulse (Big Endian)
' Länge = 0x12 = 18 Bytes wird am Ende hinzugefügt
strCMDHex = "9210" 'PAM 146 (92h): Set Metrology Parameters, 16 (10h) = ?
' Byte 1-4 Volume Per Pulse (Signed, Big Endian) as a 4 byte value where volume = value * (1/65536) ml.
' Positive value indicates clockwise rotation is forward flow when looking through the register to the meter body.
If Einbauplatz.getPruefzaehler.getIdentNrObj.getNennweite <= 125 Then
intKupplungswertigkeit = 10
strCMDHex = strCMDHex & "82710000" ' 130,113,0,0 = - 40960000 (/65536) = -625 ml
Einbauplatz.eRegister.mdbl_Programming_Volume_Per_Pulse = -625
Else
intKupplungswertigkeit = 100
Einbauplatz.eRegister.mdbl_Programming_Volume_Per_Pulse = -6250
strCMDHex = strCMDHex & "986A0000" ' 152,106,0,0 = - 409600000 (/65536) = -6250 ml
End If
'Byte 5-8 Offset Factor (Big Endian)
strCMDHex = strCMDHex & "00000000" ' O-Val = 0 ml
'Byte 9 Offset time
strCMDHex = strCMDHex & "05" ' O-Time = 5s
'Byte 10 Factory Calibration
strCMDHex = strCMDHex & "00" ' F-Cal = 0%
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Byte11 As Byte
'Byte 11 (bit 4-0 = x * 2^0) Units
'Set Metrology Parameters Byte
'Val = Meaning Value reported in SEMI
'---------------------------------------------
'0x00=Cubic Meters (m3) 19 = 0x13 = b0001 0011
'0x01=Cubic Feet (CF) 35 = 0xA3 = b1010 0011
'0x04=US Gallons (GAL) 24 = 0x98 = b1001 1000
'0x05=Imperial Gallons (IGAL) 144 = 0x90 = b1001 0000
'0x06=Acre Feet(AF) Not implemented Not implemented
'0x07=Kiloliters (kl) 19 = 0x13 = b0001 0011
Select Case Einbauplatz.getPruefzaehler.getAuftragPosition.getAnzeige
Case "m³"
Byte11 = 0 '00 * 2^0 'Cubic Meters (m3)
Einbauplatz.eRegister.mb_Programming_Unit = 19 ' reported in SEMI
Case Else
MsgBox "Bitte Byte11 für Anzeige '" & Einbauplatz.getPruefzaehler.getAuftragPosition.getAnzeige & "' pflegen! "
End Select
'Byte 11 (bit 6-5 x * 2^5) Decimal Point/Comma location
' value Meaning
' 0 = 3 digits to the right of the decimal point or comma ; Nennweite < 150
' 1 = 2 digits to the right of the decimal point or comma; Nennweite >= 150
' 2 = 1 digits to the right of the decimal point or comma (not currently supported)
' 3 = No decimal point or comma
If Einbauplatz.getPruefzaehler.getIdentNrObj.getNennweite >= 150 Then
Byte11 = Byte11 Or 1 * 2 ^ 5 '= 2 digits to the right of the decimal point or comma
Else
Byte11 = Byte11 Or 0 * 2 ^ 5 '= 3 digits to the right of the decimal point or comma
End If
'Byte 11 (bit 7) Use C&I rules (don't allow reverse volume)
Byte11 = Byte11 Or 2 ^ 7 * IIf(blnRuecklaufsperre, 1, 0)
strCMDHex = strCMDHex & Hex2(Byte11) 'UNIT
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Byte 12 Meter Size
strCMDHex = strCMDHex & Hex2(CByte(MeterSize))
'strCMDHex = strCMDHex & "25" ' M-SIZE = 37 = Meistream Plus DN 50 fr Thames Water 'TODO!!! 1.1.1.8. Meter Size Tabelle nutzen
'13-16 Volume Per LED Pulse (Big Endian, unsigned)
Select Case intKupplungswertigkeit
Case 10
strCMDHex = strCMDHex & "02710000" ' 2,113,0,0 = 40960000 ' 40960000/65536 = 625 ml
PrintStatus "Sende an Ebp " & Einbauplatz.getNr & " 'Parametersatz (10)' " & strCMDHex
Einbauplatz.eRegister.mdbl_Programming_Volume_Per_LED_Pulse = 625
Case 100
strCMDHex = strCMDHex & "186A0000" ' 24,106,0,0 = 409600000 ' 409600000 /65536 = 6250 ml
PrintStatus "Sende an Ebp" & Einbauplatz.getNr & " 'Parametersatz (100)' " & strCMDHex
Einbauplatz.eRegister.mdbl_Programming_Volume_Per_LED_Pulse = 6250
End Select
Laenge = Len(strCMDHex) / 2
strCMDHex = Hex2(Laenge) & strCMDHex
ParametersatzCmdHex = strCMDHex
End Function
Public Function GetHexForString(strText As String) As String
Dim pos As Integer
Dim strChar As String
Dim intByte As Byte
GetHexForString = ""
For pos = 1 To Len(strText)
strChar = Mid(strText, pos, 1)
intByte = Asc(strChar)
GetHexForString = GetHexForString & Right("0" & Hex(intByte), 2)
Next
End Function
'Private Function MeterID_Alarm_Programmieren() As Boolean
' Dim Einbauplatz As CEinbauplatz
' Dim strCMDHex As String
' Dim intKupplungswertigkeit As Integer
' Dim strSerienNr As String
' Dim strKey As String
'
' mSIRTStatemashine.ClearPam
' m_PAMZeile = m_PAMZeile + 1
'
' For Each Einbauplatz In m_colEinbauplatz
' If Not Einbauplatz.getPruefzaehler Is Nothing And Not Einbauplatz.eRegister Is Nothing Then
'
' If Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getStatusFertigung >= 30 Then
' '''''''''''''''''''''''''''''''''''''''''''''''''
' ' Länge wird am Ende errechnet ''strCMDHex = "25" ' Länge 37 Bytes
' strCMDHex = ""
' strCMDHex = strCMDHex & "31" & Hex8(Einbauplatz.eRegister.m_sRadioAdress) ' 49h FADR(4)
' strCMDHex = strCMDHex & "0600" '6, 0 AL-MASK = 0
' strCMDHex = strCMDHex & "03FF" '3, 255 Reset all Alarms
'
' strSerienNr = Left(Trim(CStr(Einbauplatz.getPruefzaehler.getSerienNr)) & vbNullChar & vbNullChar & vbNullChar & vbNullChar & vbNullChar & vbNullChar & vbNullChar & vbNullChar & vbNullChar, 9)
'
' strCMDHex = strCMDHex & "50" & GetHexForString(strSerienNr) ' 80 + SerienNr (9 Stellig)
' strCMDHex = strCMDHex & "3000000000" ' 8,0,,0,0 Vol=0
' strCMDHex = strCMDHex & "0ACC" ' 10, 204 LEAK=87,5 l/h 1day
' strCMDHex = strCMDHex & "0B48" ' 11, 72 BRO-PI37,5m³/h 15min
'
' Stop
' If False Then
' strCMDHex = strCMDHex & "33003C0003" ' 51,0,60,0,3 LOG=Cnt|Alarm 60 min ==> PAM-Status = 17 Command not supported. Value out of Range
' ' 05 33003C0003 als singlecommand funktioniert
'
' strCMDHex = strCMDHex & "20010003" ' 32,1,0,3 FDR=Cnt|Alarm DD=1 ==> PAM-Status = 1 Command not supported.
' ' 04 20010003 als singlecommand funktioniert nicht
' End If
'
'
' Dim Laenge As Byte
' Laenge = Len(strCMDHex) / 2
' strCMDHex = Hex2(Laenge) & strCMDHex
' '''''''''''''''''''''''''''''''''''''''''''''''''
'
' ''ret = mSIRTStatemashine.SendPAM(Einbauplatz.eRegister.m_sRadioAdress, strCMDHex, "", 16, CByte(Einbauplatz.getNr), 0, "", "0", False)
'
' SetFlexgridRow m_PAMZeile, MSFlexGrid1, "MeterID/Alarm"
'
' MSFlexGrid1.col = Einbauplatz.getNr
' MSFlexGrid1.text = "Meter ID_Alarm"
' Else
'
' End If
' End If
' Next
'
'
' Do
' SleepWithEvents 10, True
' Aktualisiere_PAM_Status "MeterID/Alarm"
' Loop While Not mSIRTStatemashine.AllPAMsAreFinished And m_blnAbbruch = False
'
' For Each Einbauplatz In m_colEinbauplatz
' If Not Einbauplatz.getPruefzaehler Is Nothing Then
' If Not Einbauplatz.eRegister Is Nothing Then
' If mSIRTStatemashine.GetPAM(Einbauplatz.getNr).SEMI.PAM_status <> 0 Then
' MsgBox "Einbaulatz " & Einbauplatz.getNr & " PAMStatus=" & mSIRTStatemashine.GetPAM(Einbauplatz.getNr).SEMI.PAM_status & " = " & mSIRTStatemashine.GetPAM(Einbauplatz.getNr).SEMI.GetPamErrorMessage
' End If
' End If
' End If
' Next
'
'' 25 ($25=37=Länge)
'' 31 (13 03 8D CA) ($31=49=Meter-ID)
'' 06 00 ($06= 6=Deactivate Alarms)
'' 03 FF ($03=03=Reset Alarms)
'' 50 (31 35 37 32 35 32 33 30 00) ($50=80= Cust-text)
'' 30 00 00 00 00 ($30=48=Meter-Reading=Vol)
'' 00 0A CC ($0A=10=Leak)
'' 0B 48 ($0B=11=BroPi)
'' 33 00 3C 00 03 80 (51 =Log) ($33=51=Log)
'' 20 01 00 03 ($20=32=FDR)
'
'
' ' Todo SEMI Pam Status auswerten
'
' PrintStatus "MeterID/Alarm fertig"
'
' If m_blnAbbruch Then
' MeterID_Alarm_Programmieren = False
' Else
' MeterID_Alarm_Programmieren = True
' End If
'
'End Function
Public Function Sind_eRegister_Noch_Eingelesen() As Boolean
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim eRegister As CeRegister
Sind_eRegister_Noch_Eingelesen = True
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
Set eRegister = Einbauplatz.eRegister
If eRegister Is Nothing Then
Sind_eRegister_Noch_Eingelesen = False
Else
If Val(MSFlexGrid1.TextMatrix(fgZeile.Zeile_Pz_RadioAdr, Einbauplatz.getNr)) = 0 Then
Sind_eRegister_Noch_Eingelesen = False
End If
End If
End If
Next
End Function
Public Function PruefungsAbschlussNeuerVako() As Boolean
Dim Einbauplatz As CEinbauplatz
Dim strCMDHex As String
Dim lngRet As Long
Dim strFinaleFunkadresse As String
Dim strKey As String
Dim Laenge As Byte
Dim strSerienNr As String
Dim objPAM As SIRTCOM.PAM
Dim strRadioAdresseBUP As String
Dim curVolumeAnzeige As Currency
Dim byteValue As Byte
Dim curValue As Currency
Dim intWdhZaehler As Integer
Dim eRegister_Auftragposition As CeRegister_Auftragposition
Dim strRadioAdresseSEMI As String
' Todo On Error goto Errorhandler
' Errorhandler:
' err.resumeNext => mit dem nächsten Befehl weiter
' err.resume => Wdh Befehl
' Ganz neu PruefungsAbschlussNeuerVako
' PruefungsAbschlussNeuerVako beenden
Me.caption = FORMCAPTION & " Prüfungsabschluss"
'' SIRT Comport öffnen und Funkreceiver einschalten
If Not InitSirt(mintFrequenz) Then
' SIRT kann nicht initialisiert werden, also abbrechen
PruefungsAbschlussNeuerVako = False
Exit Function
End If
PruefungsAbschlussNeuerVako = False
cmdCancel.Enabled = True
m_blnAbbruch = False
If mblnManuellePruefung Then
' Zählerdaten neu einlesen
' todo: wenn notwendig
If Not Sind_eRegister_Noch_Eingelesen() Then
'PruefungsAbschlussNeuerVako = PruefungInitialisierung_NeuerVako(True)
'If PruefungsAbschlussNeuerVako = False Then Exit Function
End If
If mblnVorbereitungEbeling = False And Not mblnVorbereitungFuzhoe Then
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "Wake Up"
For Each Einbauplatz In m_colEinbauplatz
strCMDHex = ""
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
If Einbauplatz.eRegister.m_StateClosed Then
' verschlossene Zähler wecken
strCMDHex = "0000"
strCMDHex = strCMDHex & ProvideAuthLevelHexCommand(2)
Einbauplatz.eRegister.m_bUseKey = True
' Länge der PAM berechnen
Laenge = Len(strCMDHex) / 2
strCMDHex = Hex2(Laenge) & strCMDHex
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
Else
If mblnManuellePruefung Then
' manuell geprüfte Zähler für den Prüfungsabschluss wecken
strCMDHex = "0000"
Laenge = Len(strCMDHex) / 2
strCMDHex = Hex2(Laenge) & strCMDHex
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
Else
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
MSFlexGrid1.text = " - "
End If
End If
End If
End If
Next
PruefungsAbschlussNeuerVako = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("Wake Up", 20)
End If 'mblnVorbereitungEbeling or mblnVorbereitungFuzhoe
End If 'mblnManuellePruefung
Call StopOptoEmpfang
Call ResetMesswertAnzeige
m_PAMZeile = MSFlexGrid1.Rows - 1
If Not m_Display Is Nothing Then
' alle DIsplays Licht an
m_Display.Adressierung 255
Sleep 100
m_Display.Licht 1
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Anzeige Ergebniss der hydraulischen Prüfung
' 25 = ausserhalb der Fehlergrenzen, 30 = erfolgreich geprüft
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If mblnVorbereitungEbeling = False And Not mblnVorbereitungFuzhoe Then
MSFlexGrid1.TextMatrix(fgZeile.Zeile_Pz_HydrPrf, 0) = "Hydraul.Prf"
For Each Einbauplatz In m_colEinbauplatz
MSFlexGrid1.row = fgZeile.Zeile_Pz_HydrPrf
MSFlexGrid1.col = Einbauplatz.getNr
If Not Einbauplatz.getPruefzaehler Is Nothing Then
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If False Then
' Simulation eines erfolgreich geprüften Zählers
Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.setStatusFertigung 30
PrintStatus "Simulation: Prüfergebnis am Einbauplatz innerhalb der Fehlergrenzen."
Else
If IsInIDE() Then
' Es darf nur in der Entwicklungsumgebung hier gestoppt werden
Stop
End If
End If
If False Then
' Simulation eines NICHT erfolgreich geprüften Zählers
PrintStatus "Simulation: Prüfergebnis am Einbauplatz ausserhalb der Fehlergrenzen."
Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.setStatusFertigung 25
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getStatusFertigung = 0 Then
MSFlexGrid1.text = "ungeprüft"
MSFlexGrid1.CellBackColor = vbRed Or &HA08080
ElseIf Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getStatusFertigung < 30 Then
MSFlexGrid1.text = "fehlerhaft"
MSFlexGrid1.CellBackColor = vbRed Or &H808080
ElseIf Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getStatusFertigung >= 30 Then
MSFlexGrid1.text = "OK"
MSFlexGrid1.CellBackColor = vbGreen Or &H808080
End If
End If ''Einbauplatz.getPruefzaehler Is Nothing
Next ' Einbauplatz
End If 'mblnVorbereitungEbeling And Not mblnVorbereitungFuzhoe
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' alle nicht erfolgreichen Zähler (Status < 30)
' bekommen den Zählerstand 333333.333 = Markierung für Error
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If mblnVorbereitungEbeling = False And Not mblnVorbereitungFuzhoe Then
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "Vol=333..."
For Each Einbauplatz In m_colEinbauplatz
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
If Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getStatusFertigung < 30 And Einbauplatz.eRegister.m_StateClosed = False Then
' Nur durchgefallende offene Zähler
' Vol = 333333.333 (NW < 150)
' Vol = 3333333.33 (NW >= 150)
PrintStatus "Sende AnzeigeVolumen=333333333 an eRegister am Einbauplatz " & Einbauplatz.getNr
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = "0530" & Var2Hex(333333333#)
Else
MSFlexGrid1.text = " - "
End If
End If ' eRegister
End If ' Pruefzaehler
Next
PruefungsAbschlussNeuerVako = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("Vol=333...")
If PruefungsAbschlussNeuerVako = False Then Exit Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' Verwechselungskontrolle
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
PruefungsAbschlussNeuerVako = Verwechselungskontrolle()
If PruefungsAbschlussNeuerVako = False Then Exit Function
End If ' ebeling or Fuzhoe
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''' endgültige Funkadresse schreiben!
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
m_PAMZeile = m_PAMZeile + 1
Funkadresse_aendern_wdh:
SetFlexgridRow m_PAMZeile, MSFlexGrid1, ""
For Each Einbauplatz In m_colEinbauplatz
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
' nur erfolgreich geprüfte unverschlossene und kontrollierte Zähler bekommen die finale Funkadresse
If (Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getStatusFertigung >= 30 And Einbauplatz.eRegister.m_StateClosed = False And Einbauplatz.eRegister.m_StateClosingAllowed = True) Or (mblnVorbereitungEbeling Or mblnVorbereitungFuzhoe) Then
strFinaleFunkadresse = Einbauplatz.eRegister.m_sRadioAdressFinal
If Val(strFinaleFunkadresse) <> Val(Einbauplatz.eRegister.m_sRadioAdress) Then
' nur wenn Finale Funkadresse noch nicht programmiert
If g_blnVersuch Or IsInIDE() Then
If MsgBox("Funkadresse am Ebp " & Einbauplatz.getNr & " ändern?", vbYesNo Or vbDefaultButton2, "Sicherheitsabfrage für Versuchsprüfer und Entwickler") = vbYes Then
GoTo Funkadresse_aendern
Else
MSFlexGrid1.text = "(übersprungen)"
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
PrintStatus "Die finale Funkadresse vom eRegister an Ebp " & Einbauplatz.getNr & " wurde auf Wunsch nicht geändert."
End If
Else
Funkadresse_aendern:
' Produktion
Einbauplatz.eRegister.m_sTempRadioaddress = Einbauplatz.eRegister.m_sRadioAdress
strCMDHex = "0535" & Hex8(CCur(strFinaleFunkadresse))
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
PrintStatus "Sende Finale Funkadresse=" & strFinaleFunkadresse & ", PAM:" & strCMDHex & " an FAdr:" & Einbauplatz.eRegister.m_sRadioAdress & ", Ebp:" & Einbauplatz.getNr
End If
Else
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
MSFlexGrid1.text = "(gleich)"
MSFlexGrid1.CellBackColor = RGB(128, 255, 128)
PrintStatus "eRegister an Ebp " & Einbauplatz.getNr & " nutzt schon engdültige Funkadresse " & strFinaleFunkadresse
End If
Else
' bei StatusFertigung < 30 oder geschlossenen Werken
MSFlexGrid1.text = " - "
End If
End If 'Einbauplatz.eRegister
End If 'Einbauplatz.getPruefzaehler
Next
PruefungsAbschlussNeuerVako = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("Finale Funkadr", 32, True)
If PruefungsAbschlussNeuerVako = False Then Exit Function
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ' Finale Funkadresse mit Funkadresse in SEMI vergleichen, dazu letzte PAM verwenden
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
MSFlexGrid1.row = fgZeile.Zeile_Pz_RadioAdr
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
MSFlexGrid1.col = Einbauplatz.getNr
Set objPAM = mSIRTStatemashine.GetPAM(Einbauplatz.getNr)
If Not objPAM Is Nothing Then
' es gab einen Finale-FAdr-PAM-Befehl an diesen Einbauplatz
If Not objPAM.SEMI Is Nothing Then
' Es wurde zu dieser PAM eine SEMI empfangen
' letzte SEMI kam von dieser Adresse:
strRadioAdresseSEMI = objPAM.SEMI.RadioAdr
End If
If Not objPAM.BUP Is Nothing Then
' letzte BUP kam von dieser Adresse
strRadioAdresseBUP = objPAM.BUP.RadioAdr
End If
If Val(strRadioAdresseBUP) = Val(Einbauplatz.eRegister.m_sRadioAdressFinal) Or Val(strRadioAdresseSEMI) = Val(Einbauplatz.eRegister.m_sRadioAdressFinal) Then
' einer dieser Funkadresse (von PAM und SEMI) stimmt mit der finalen Funkadresse überein
' das ist ein Hinweis, dass die Funkadressen-Änderung geklappt hat
' aktuelle Funkadresse anzeigen
MSFlexGrid1.text = Einbauplatz.eRegister.m_sRadioAdressFinal
' Aktuelle Funkadresse hat sich geändert!!
Einbauplatz.eRegister.m_sRadioAdress = Einbauplatz.eRegister.m_sRadioAdressFinal
Einbauplatz.eRegister.m_dFunkadresseDatum = Now()
Einbauplatz.eRegister.save Einbauplatz.getPruefzaehler.getSerienNr
MSFlexGrid1.CellBackColor = RGB(128, 255, 128) ' Grün
Else
' beide Funkadress in BUP und ggf SEMI stimmen NICHT mit der finalen Funkadresse überein
MSFlexGrid1.CellBackColor = RGB(255, 128, 128)
lngRet = MsgBox("Die Funkadresse an Einbauplatz " & Einbauplatz.getNr & " hat sich nicht geändert. Möchten Sie das Schreiben der Funkadresse wiederholen? ", vbYesNoCancel Or vbDefaultButton1)
If lngRet = vbYes Then
GoTo Funkadresse_aendern_wdh
End If
If lngRet = vbCancel Then
PruefungsAbschlussNeuerVako = False
Exit Function
End If
End If
Else
' keine PAM
If Einbauplatz.eRegister.m_sRadioAdress = Einbauplatz.eRegister.m_sRadioAdressFinal Then
' aktuelle Funkadresse stimmt mit Finaler überein
MSFlexGrid1.CellBackColor = RGB(128, 255, 128)
End If
End If
End If
End If
Next
'' SIRT Comport öffnen und Funkreceiver einschalten
If Not InitSirt(mintFrequenz) Then
' SIRT kann nicht initialisiert werden, also abbrechen
PruefungsAbschlussNeuerVako = False
Exit Function
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''' LED Protokoll auswerten, Funkadresse mit Finaler vergeichen
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''' LED Protokoll aus für alle Einbauplätze
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, ""
PruefungsAbschlussNeuerVako = Sende_LED(False, False)
If PruefungsAbschlussNeuerVako = False Then
Exit Function
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''' Meter-ID, Alarm Mask usw
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, ""
For Each Einbauplatz In m_colEinbauplatz
strCMDHex = ""
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
Set eRegister_Auftragposition = Einbauplatz.eRegister.mobj_eRegister_Auftragposition
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
' nur erfolgreich geprüfte Zähler mit unverschlossenen eRegister oder Vorbereitung für Ebeling
If (Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getStatusFertigung >= 30 And Einbauplatz.eRegister.m_StateClosed = False) Or (mblnVorbereitungEbeling Or mblnVorbereitungFuzhoe) Then
WriteToLog "Programmierung des eRegisters mit SerienNr = " & Einbauplatz.getPruefzaehler.getSerienNr
' PAM 49
Select Case Einbauplatz.eRegister.mstr_CSD
Case "CSD 769400"
' Meter-ID = FADR(4)
WriteToLog "Sonderregel 'CSD 769400': Meter-ID = Funkadresse "
Einbauplatz.eRegister.m_MeterID = Right(Einbauplatz.eRegister.m_sRadioAdressFinal, 10)
Case Else
' neu RH 9.11.2015, AnPf
' Meter-ID = Sensus SerienNr
WriteToLog "Default: Meter-ID = Sensus SerienNr"
Einbauplatz.eRegister.m_MeterID = Einbauplatz.getPruefzaehler.getSerienNr
End Select
If Val(Einbauplatz.eRegister.m_MeterID) > 4294967295# Then
MsgBox "Meter-ID " & Einbauplatz.eRegister.m_MeterID & " ist ausserhalb des zulässigen Wertebereichs! Meter-ID wird nicht programmiert.", vbCritical, "WARNUNG"
WriteToLog "Meter-ID " & Einbauplatz.eRegister.m_MeterID & " ist ausserhalb des zulässigen Wertebereichs 0-4294967295 ! Meter-ID wird nicht programmiert."
Else
strCMDHex = strCMDHex & "31" & Hex8(Einbauplatz.eRegister.m_MeterID)
WriteToLog "PAM 49 MeterID = " & Val(Einbauplatz.eRegister.m_MeterID) & " : 0x31 " & Hex8(Einbauplatz.eRegister.m_MeterID)
End If
Dim bytAlarmMask As Byte
bytAlarmMask = eRegister_Auftragposition.getAlarmByte
strCMDHex = strCMDHex & "06" & Hex2(bytAlarmMask) '6, Thames: AL-MASK = LowBattery + Magnetic Tamper 160
WriteToLog "PAM 6 AlarmMask = " & bytAlarmMask & " : 0x06 " & Hex2(bytAlarmMask)
strCMDHex = strCMDHex & "03FF" '3, 255 Reset all Alarms
WriteToLog "PAM 3 Reset all Alarms = 255: 0x03 FF"
'''''''''''''''''''''''''''''''''''''''''''''
''''''''''' CUSTOMER TEXT '''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''
' Festgelegt am 9.11.2015 AnPf, JeSc
' Ausnahme Arquiva: immer leer lassen = 9 * 0x00
' Festgelegt am 18.07.2016 PeBu
' customer-text = leer = 9 * 0x00
Dim strNULLBYTES As String
strNULLBYTES = Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0)
Select Case Einbauplatz.eRegister.mstr_CSD
Case "CSD 769400"
' Sonderregel laut Kundenvereinbarung mit Aquiva Thames Water
strSerienNr = ""
Case Else
' für alle andderen Kunden (auch)
strSerienNr = ""
End Select
' ggf mit 9 Nullbytes auffüllen und auf maximal 9 Stellen abschneiden
strSerienNr = Left(strSerienNr & strNULLBYTES, 9)
' für den Vergleich
Einbauplatz.eRegister.m_CustText = strSerienNr
strCMDHex = strCMDHex & "50" & GetHexForString(strSerienNr) ' PAM 80 + SerienNr (9 Stellig)
WriteToLog "PAM 80 CustTxt = " & Replace(strSerienNr, Chr(0), "") & " : 0x50 " & GetHexForString(strSerienNr)
'''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''
' NW abhängig bis NW 125: 0.500m³ , ab NW 150: 0,50
If Einbauplatz.getPruefzaehler.getIdentNrObj.getNennweite < 150 Then
' bis NW 125: 0.500 m³
curVolumeAnzeige = 500
Else
' bis NW 125: 0.50 m³
curVolumeAnzeige = 50
End If
strCMDHex = strCMDHex & "30" & Hex8(curVolumeAnzeige)
WriteToLog "PAM 48 Anzeige = " & curVolumeAnzeige & " : 0x30 " & Hex8(curVolumeAnzeige)
' Parameterize Leakage-Detection with PAM 10
byteValue = eRegister_Auftragposition.GetLeakage_PeriodBit20
byteValue = byteValue Or eRegister_Auftragposition.GetLeakage_ThresholdBit37 * 2 ^ 3
strCMDHex = strCMDHex & "0A" & Hex2(byteValue) ' 10, 204 LEAK=87,5 l/h 1day
WriteToLog "PAM 10 Leakage-Parameter = " & byteValue & ": 0x0A " & Hex2(byteValue)
' Parameterize Broken-Pipe-Detection with PAM 11
byteValue = eRegister_Auftragposition.GetBrokenPipe_PeriodBit20
byteValue = byteValue Or eRegister_Auftragposition.GetBrokenPipe_ThresholdBit37 * 2 ^ 3
strCMDHex = strCMDHex & "0B" & Hex2(byteValue) ' 11, 78= 0B 4E wenn BRO-PI37,5m³/h 5min
WriteToLog "PAM 11 BrokenPipe = " & byteValue & " : 0x0B " & Hex2(byteValue)
' Set historical error limit (alarm persistence) with PAM 12
' Hex: 12 01
strCMDHex = strCMDHex & "0C" & Hex2(eRegister_Auftragposition.mbytHistory_Error_Limits_Days) ' 12 01
WriteToLog "PAM 12 AlarmPersistence = " & eRegister_Auftragposition.mbytHistory_Error_Limits_Days & " : 0x0C " & Hex2(eRegister_Auftragposition.mbytHistory_Error_Limits_Days)
' Change settings for data logger with PAM 51
' So PAM 51 had to write 4 bytes
' Timeinterval (2) = 0x05A0 = 1440 minutes = 1 day
' LogContent (2) = 0x0C03 = Time of Minimum Flow, Minimum Flow,
' Counter and Alarm-State
' Hex: 33 05A0 0C03"
strCMDHex = strCMDHex & "33" & Var2Hex(eRegister_Auftragposition.mlngData_Logging_Period, 4)
WriteToLog " DataLogger_Period=" & eRegister_Auftragposition.mlngData_Logging_Period & ": " & "0x" & Var2Hex(eRegister_Auftragposition.mlngData_Logging_Period, 4)
strCMDHex = strCMDHex & Var2Hex(eRegister_Auftragposition.GetDataLoggingContentByte, 4)
WriteToLog " DataLogger_LogContent=" & eRegister_Auftragposition.GetDataLoggingContentByte & ": " & "0x" & Var2Hex(eRegister_Auftragposition.GetDataLoggingContentByte, 4)
WriteToLog "PAM 51 : 0x33 " & Var2Hex(eRegister_Auftragposition.mlngData_Logging_Period, 4) & " " & Var2Hex(eRegister_Auftragposition.GetDataLoggingContentByte, 4)
' Change Fixed Date Reading Settings
' Counter and Alarm State (Bit 0/1) are set by default and can’t be reset.
' So even you write a log Content of zero; a three will be read back (Bit 0/1 set)
' So PAM 32 (x20) had to write 3 bytes:
' FDRdoMonth(1 Byte) = 01
' logContent(2 Bytes) = 0003
' Hex 20 01 00 03
strCMDHex = strCMDHex & "20"
strCMDHex = strCMDHex & Var2Hex(eRegister_Auftragposition.mbytFDR_Day_Of_Data_Reading, 2)
strCMDHex = strCMDHex & Var2Hex(eRegister_Auftragposition.GetFDRContentByte, 4)
WriteToLog " FDR Day_Of_Data_Reading = " & eRegister_Auftragposition.mbytFDR_Day_Of_Data_Reading & ": " & Var2Hex(eRegister_Auftragposition.mbytFDR_Day_Of_Data_Reading, 2)
WriteToLog " FDR Log-Content = " & eRegister_Auftragposition.GetFDRContentByte & ": " & Var2Hex(eRegister_Auftragposition.GetFDRContentByte, 4)
WriteToLog "PAM 32 : 0x20 " & Var2Hex(eRegister_Auftragposition.mbytFDR_Day_Of_Data_Reading, 2) & " " & Var2Hex(eRegister_Auftragposition.GetFDRContentByte, 4)
' Calculate the lengt of all combined PAMs
Laenge = Len(strCMDHex) / 2
strCMDHex = Hex2(Laenge) & strCMDHex
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
Debug.Print strCMDHex
'''''''''''''''''''''''''''''''''''''''''''''''''
Else
' StatusFertigung ist < 30
MSFlexGrid1.text = " - "
End If
End If
End If
Next
PruefungsAbschlussNeuerVako = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("MeterID/Alarms...") '
If PruefungsAbschlussNeuerVako = False Then Exit Function
' Ln_MetId=FAdr_Alrm_RstA_Custumer--Text=SerNr_Anzeige---_Leak_BrPi_AlPe_DLPeriCont_FDPeCont
' alt 27 3113038EB8 06A0 03FF 50333139303030323438 30000001F4 0A57 0B4E 0C01 3305A00C03 20010003
' neu 27 3113038EB8 06A0 03FF 50333139303030323438 30000001F4 0A57 0B4E 0C01 3305A00C03 20010003
' Ln_MetId=FAdr_Alrm_RstA_Custumer-Text=KndSNr_Anzeige---_Leak_BrPi_AlPe_DLPeriCont_FDPeCont
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''' Uhrzeit setzen und kontrollieren
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
PruefungsAbschlussNeuerVako = SetDateTime()
If PruefungsAbschlussNeuerVako = False Then Exit Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''' MBUS
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, ""
intWdhZaehler = 0
For Each Einbauplatz In m_colEinbauplatz
strCMDHex = ""
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
If Einbauplatz.eRegister.m_StateClosed = False Then
strCMDHex = ""
strCMDHex = strCMDHex & "0507" ' M-Bus Status = 7
Laenge = Len(strCMDHex) / 2
strCMDHex = Hex2(Laenge) & strCMDHex
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
Else
MSFlexGrid1.text = " - "
Einbauplatz.eRegister.m_bytAuthLevel = 0
Einbauplatz.eRegister.m_curPIN = 0
End If
End If
End If
Next
PruefungsAbschlussNeuerVako = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("MBUS=7") '
If PruefungsAbschlussNeuerVako = False Then Exit Function
'********** MBUS Status überprüfen
Wdh_MBUS_ueberpruefen:
Dim blnWdhErforderlich As Boolean
blnWdhErforderlich = False
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
Set objPAM = mSIRTStatemashine.GetPAM(Einbauplatz.getNr)
If Not objPAM Is Nothing Then
If objPAM.SEMI.OM_Status = 7 Then
' MBUS Status OK
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
Else
strCMDHex = "0507"
Laenge = Len(strCMDHex) / 2
strCMDHex = Hex2(Laenge) & strCMDHex
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
blnWdhErforderlich = True
End If
End If
End If
End If
Next
If blnWdhErforderlich Then
intWdhZaehler = intWdhZaehler + 1
If intWdhZaehler > 3 Then
MsgBox "Achtung M-BUS=7 wurde wiederholt gesendet."
Else
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "MBUS"
PruefungsAbschlussNeuerVako = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("MBUS") '
If PruefungsAbschlussNeuerVako = False Then Exit Function
GoTo Wdh_MBUS_ueberpruefen
End If
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''' RF Powerlevel
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
PruefungsAbschlussNeuerVako = ChangePowerLevel()
If PruefungsAbschlussNeuerVako = False Then Exit Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''' FW Update OTA deaktvieren
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If mblnVorbereitungEbeling = False And Not mblnVorbereitungFuzhoe Then
PruefungsAbschlussNeuerVako = DisableOTA()
If PruefungsAbschlussNeuerVako = False Then Exit Function
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''' Set Activation By Flow Threshold
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Produktiv ab 26.9.2017
If Not mblnVorbereitungEbeling And Not mblnVorbereitungFuzhoe Then
PruefungsAbschlussNeuerVako = SetActivationByFlowThreshold()
If PruefungsAbschlussNeuerVako = False Then Exit Function
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''' TXIV =15s LAT=3s KEY setzen
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If mblnVorbereitungEbeling = False Then
' Für die Vorbereitung der Prüfung bei Ebeling&Sohn ist nach dem Programmieren aller für die Prüfung notwendigen Schritte Schluss
' Die für den Endkunden nötigen Programmierschritte werden im Prüfungsabschluss nachgeholt.
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, ""
For Each Einbauplatz In m_colEinbauplatz
strCMDHex = ""
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
' nur erfolgreich geprüfte und offene, kontrollierte Zähler oder für Fuzhoe
If (Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getStatusFertigung >= 30 And Einbauplatz.eRegister.m_StateClosingAllowed And Einbauplatz.eRegister.m_StateClosed = False) Or (mblnVorbereitungFuzhoe) Then
'Change Transmission Interval = PAM 16 + 2 Data Bytes, no single Cmd 2, Auth Level 2
curValue = Einbauplatz.eRegister.mobj_eRegister_Auftragposition.mlngTransmission_Intervall
strCMDHex = strCMDHex & "10" & Var2Hex(curValue, 4) ' TX-IV=15s => 16,0,15 = 10 00 0F
WriteToLog "PAM 16 TX-IV = " & curValue & " : 0x10 " & Var2Hex(curValue, 4)
' Change number of LAT Windows N = PAM 02 + 1 Data Byte, no single Cmd, only in Production Mode
curValue = Einbauplatz.eRegister.mobj_eRegister_Auftragposition.mbytLAT_interval
strCMDHex = strCMDHex & "02" & Var2Hex(curValue, 2) ' LAT = 3 => 2,3 = 02 03
WriteToLog "PAM 02 LAT = " & curValue & " : 0x02 " & Var2Hex(curValue, 4)
' Change SensusRF Encryption Key = PAM 108 + 16 Data Bytes, no single Cmd, Auth Level 2
If Einbauplatz.eRegister.m_sKeyHex <> "" Then
strCMDHex = strCMDHex & "6C" & Einbauplatz.eRegister.m_sKeyHex '108 + Key(16)
If Len(Einbauplatz.eRegister.m_sKeyHex) <> 32 Then
MsgBox "Fehler: PAM 108 erwartet 32 Hex Zeichen = 16 Data Bytes Encryption Key!"
End If
WriteToLog "PAM 108 + KeyHex (" & Len(Einbauplatz.eRegister.m_sKeyHex) / 2 & " Zeichen)"
Else
MsgBox "Kein Key für eRegister an Einbauplatz " & Einbauplatz.getNr & " vorhanden"
' kein Key
End If
'Länge berechnen und PAM Befehl bauen
strCMDHex = Hex2(Len(strCMDHex) / 2) & strCMDHex
PrintDebugDezimal strCMDHex
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
Else
' StatusFertigung ist < 30 order m_StateClosingAllowed = false oder m_StateClosed = true
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
MSFlexGrid1.text = " - "
End If
End If
End If
Next
PruefungsAbschlussNeuerVako = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("TXIV+LAT+KEY") '
If PruefungsAbschlussNeuerVako = False Then Exit Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''' Lese DEBUG & SEMI
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Get debug: PAM 31 + 2 Data Bytes, Single Cmd, Auth Level 3
' 00 00 : get DEBUG Telegram
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Einsprung_Wdh_Vergleich:
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, ""
For Each Einbauplatz In m_colEinbauplatz
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
If (Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getStatusFertigung >= 30 Or mblnVorbereitungFuzhoe) And Einbauplatz.eRegister.m_StateClosed = False Then
' nur erfolgreich geprüfte noch offene Zähler
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = "031F0000"
Else
' StatusFertigung ist < 30
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
MSFlexGrid1.text = " - "
End If
End If
End If
Next
PruefungsAbschlussNeuerVako = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("Lese DEBUG SEMI", , , True)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DEBUG & SEMI speichern '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
If (Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getStatusFertigung >= 30 Or mblnVorbereitungFuzhoe) And Einbauplatz.eRegister.m_StateClosed = False Then
Set objPAM = mSIRTStatemashine.GetPAM(Einbauplatz.getNr)
' todo DEBUG SEMI BUP holen
Set Einbauplatz.eRegister.m_lastSEMI = objPAM.SEMI
Set Einbauplatz.eRegister.m_lastBUP = objPAM.BUP
Set Einbauplatz.eRegister.m_lastDEBUG = objPAM.DEBUG
' nur erfolgreich geprüfte noch offene Zähler
Einbauplatz.eRegister.save Einbauplatz.getPruefzaehler.getSerienNr
End If
End If
End If
Next
If PruefungsAbschlussNeuerVako = False Then Exit Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Vergleiche DEBUG1 mit Vorgaben
' Vergleiche in INFO1, fehlgeschlagen ? ==> Problem!
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim strMeldungEbp As String
Dim strMeldungGes As String
Dim bln_BackFlow_needs_correction As Boolean
bln_BackFlow_needs_correction = False
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "Vergleich"
strMeldungGes = ""
For Each Einbauplatz In m_colEinbauplatz
strMeldungEbp = ""
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
' zurücksetzen
Set mobjInfo_DEBUG_1(Einbauplatz.getNr) = Nothing
Set mobjInfo_SEMI_1(Einbauplatz.getNr) = Nothing
'
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
' nur erfolgreich geprüfte Zähler ODER Fuzhoe Beide mit offenem Zählwerk
If (Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getStatusFertigung >= 30 Or mblnVorbereitungFuzhoe) And Einbauplatz.eRegister.m_StateClosed = False Then
' DEBUG in INFO1 speichern
Set objPAM = mSIRTStatemashine.GetPAM(Einbauplatz.getNr)
If Not objPAM Is Nothing Then
If Not objPAM.DEBUG Is Nothing Then
Set mobjInfo_DEBUG_1(Einbauplatz.getNr) = objPAM.DEBUG
Set mobjInfo_SEMI_1(Einbauplatz.getNr) = objPAM.SEMI
Set eRegister_Auftragposition = Einbauplatz.eRegister.mobj_eRegister_Auftragposition
PrintStatus "Vergleiche Werte für Einbauplatz " & Einbauplatz.getNr & ":"
' CCW
VergleicheWerte "Volume_Per_Pulse", Round(Abs(mobjInfo_DEBUG_1(Einbauplatz.getNr).Volume_Per_pulse), 5), strMeldungEbp, Round(eRegister_Auftragposition.mdblVolume_Per_puls, 5)
VergleicheWerte "Offset_Factor", Val(mobjInfo_DEBUG_1(Einbauplatz.getNr).Offset_Factor), strMeldungEbp, 0
VergleicheWerte "Offset_Time", mobjInfo_DEBUG_1(Einbauplatz.getNr).Offset_Time, strMeldungEbp, 5
VergleicheWerte "Factory_calibration", mobjInfo_DEBUG_1(Einbauplatz.getNr).Factory_calibration, strMeldungEbp, 0
If Einbauplatz.getPruefzaehler.getAuftragPosition.getIdentNrObj.getNennweite >= 150 Then
' Todo errechnen
VergleicheWerte "Unit", mobjInfo_SEMI_1(Einbauplatz.getNr).Volume_Unit, strMeldungEbp, 20
Else
VergleicheWerte "Unit", mobjInfo_SEMI_1(Einbauplatz.getNr).Volume_Unit, strMeldungEbp, eRegister_Auftragposition.GetUnit_bytSEMI_Value
End If
VergleicheWerte "Meter_Size", mobjInfo_DEBUG_1(Einbauplatz.getNr).Meter_Size, strMeldungEbp, eRegister_Auftragposition.mbytMeter_Size
VergleicheWerte "Volume_Per_LED_Pulse", Round(mobjInfo_DEBUG_1(Einbauplatz.getNr).Volume_Per_LED_Pulse, 5), strMeldungEbp, Round(eRegister_Auftragposition.mdblVolume_Per_LED_Pulse, 5)
VergleicheWerte "Alarm_Mask", mobjInfo_SEMI_1(Einbauplatz.getNr).Alarm_Mask_Active_Information, strMeldungEbp, eRegister_Auftragposition.getAlarmByte
VergleicheWerte "Meter-Id", Val(mobjInfo_SEMI_1(Einbauplatz.getNr).Meter_ID), strMeldungEbp, Val(Einbauplatz.eRegister.m_MeterID)
VergleicheWerte "Data Log Content", mobjInfo_SEMI_1(Einbauplatz.getNr).Log_Content, strMeldungEbp, eRegister_Auftragposition.GetDataLoggingContentByte
VergleicheWerte "Data Log Interval", mobjInfo_SEMI_1(Einbauplatz.getNr).Logging_interval, strMeldungEbp, eRegister_Auftragposition.mlngData_Logging_Period
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' historical error limit = alarm persistence
VergleicheWerte "History_Error_Limits", mobjInfo_SEMI_1(Einbauplatz.getNr).History_Error_Limit_days, strMeldungEbp, eRegister_Auftragposition.mbytHistory_Error_Limits_Days
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
VergleicheWerte "Customer_specific_text", Left(mobjInfo_SEMI_1(Einbauplatz.getNr).Customer_specific_text, 9), strMeldungEbp, Einbauplatz.eRegister.m_CustText
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 4900 <= Billing_Volume <= 5100
'bzw 490 <= Billing_Volume <= 510
VergleicheWerte "Billing_Volume", Val(mobjInfo_SEMI_1(Einbauplatz.getNr).Billing_Volume), strMeldungEbp, , 0, curVolumeAnzeige * 2
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' leckage 375 l³/h 14 days
VergleicheWerte "Leakage_Detection_Parameters", mobjInfo_SEMI_1(Einbauplatz.getNr).Leakage_Detection_Parameters, strMeldungEbp, eRegister_Auftragposition.GetLeakage_PeriodBit20 Or eRegister_Auftragposition.GetLeakage_ThresholdBit37 * 2 ^ 3 ' 87
'Broken Pipe BRO-PI 37,5m³/h 5min = 78
VergleicheWerte "Broken_Pipe_Detection_Parameters", mobjInfo_SEMI_1(Einbauplatz.getNr).Broken_Pipe_Detection_Parameters, strMeldungEbp, eRegister_Auftragposition.GetBrokenPipe_PeriodBit20 Or eRegister_Auftragposition.GetBrokenPipe_ThresholdBit37 * 2 ^ 3 ' 78
VergleicheWerte "Logging_interval", mobjInfo_SEMI_1(Einbauplatz.getNr).Logging_interval, strMeldungEbp, eRegister_Auftragposition.mlngData_Logging_Period
VergleicheWerte "Fixed_Date_ReadingContent", mobjInfo_SEMI_1(Einbauplatz.getNr).Fixed_Date_ReadingContent, strMeldungEbp, eRegister_Auftragposition.GetFDRContentByte
VergleicheWerte "Transmission_Interval", mobjInfo_SEMI_1(Einbauplatz.getNr).Transmission_interval, strMeldungEbp, eRegister_Auftragposition.mlngTransmission_Intervall
VergleicheWerte "LAT_Interval", mobjInfo_SEMI_1(Einbauplatz.getNr).LAT_interval, strMeldungEbp, eRegister_Auftragposition.mbytLAT_interval
VergleicheWerte "MBUS Status", mobjInfo_SEMI_1(Einbauplatz.getNr).OM_Status, strMeldungEbp, 7
If (mobjInfo_SEMI_1(Einbauplatz.getNr).Backward_Volume > 0) Then
bln_BackFlow_needs_correction = True
End If
' Factory State
VergleicheWerte "Factory_State", mobjInfo_DEBUG_1(Einbauplatz.getNr).Factory_State, strMeldungEbp, 1
VergleicheWerte "Finale Funkadresse", Val(mobjInfo_DEBUG_1(Einbauplatz.getNr).RadioAdr), strMeldungEbp, Val(Einbauplatz.eRegister.m_sRadioAdressFinal)
If strMeldungEbp <> "" Then
Einbauplatz.eRegister.m_StateClosingAllowed = False
strMeldungEbp = "fehlerhafter Vergleich am Einbauplatz " & Einbauplatz.getNr & ": " & vbCrLf & strMeldungEbp
strMeldungGes = strMeldungGes & vbCrLf & strMeldungEbp
MSFlexGrid1.text = "Fail"
MSFlexGrid1.CellBackColor = RGB(255, 128, 128)
Einbauplatz.eRegister.m_strAbbruch_Fehler = Einbauplatz.eRegister.m_strAbbruch_Fehler & strMeldungEbp & vbCrLf
Else
MSFlexGrid1.text = "OK"
MSFlexGrid1.CellBackColor = RGB(128, 255, 128)
End If
Else
' kein DEBUG bekommen
MSFlexGrid1.text = "(no DEBUG)"
MSFlexGrid1.CellBackColor = vbRed
MsgBox "Es wurde kein DEBUG Telegramm empfangen an Einbauplatz " & Einbauplatz.getNr & vbCrLf & "Ein Vergleich konnte nicht durchgeführt werden."
Einbauplatz.eRegister.m_strAbbruch_Fehler = Einbauplatz.eRegister.m_strAbbruch_Fehler & "kein DEBUG empfangen. Vergleich konnte nicht durchgeführt werden." & vbCrLf
End If
Else
' KEINE PAM
Einbauplatz.eRegister.m_StateClosingAllowed = False
MSFlexGrid1.text = "(no PAM)"
MSFlexGrid1.CellBackColor = vbRed
MsgBox "Fehler: keine PAM an Einbauplatz " & Einbauplatz.getNr & vbCrLf & "Ein Vergleich konnte nicht durchgeführt werden."
End If
Else
MSFlexGrid1.text = " - "
End If
End If
End If
Next
If strMeldungGes <> "" Then
MsgBox strMeldungGes
End If
If bln_BackFlow_needs_correction = True Then
ResetFlow_and_Backflow
GoTo Einsprung_Wdh_Vergleich
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''' Schloss schliessen
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, ""
For Each Einbauplatz In m_colEinbauplatz
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
' nur (erfolgreich geprüfte Zähler ODER Werke für Fuzhoe) und noch unverschlossenen Zähler, die den Vergleich bestanden haben
If ((Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getStatusFertigung >= 30 And Einbauplatz.eRegister.m_StateClosingAllowed) Or mblnVorbereitungFuzhoe) And Einbauplatz.eRegister.m_StateClosed = False Then
' nur wenn Finale Funkadresse noch nicht programmiert
If g_blnVersuch Or IsInIDE() Then
If MsgBox("Schloss schliessen an Einbauplatz " & Einbauplatz.getNr, vbYesNo Or vbDefaultButton2) = vbYes Then
GoTo Schloss_schliessen
Else
MSFlexGrid1.text = "(übersprungen)"
PrintStatus "Schloss schliessen am Einbauplatz " & Einbauplatz.getNr & " wird auf Wunsch übersprungen."
' Schloss schliessen wurde vom Benutzer NICHT erlaubt
Einbauplatz.eRegister.m_StateClosingAllowed = False
Einbauplatz.eRegister.m_strAbbruch_Fehler = Einbauplatz.eRegister.m_strAbbruch_Fehler & "Schloss schliessen wurde manuell übersrungen." & vbCrLf
' Werk schliessen wurde übersprungen
End If
Else
' In production mode: Schloss immer schliessen
Schloss_schliessen:
' 1) keine pins verwenden
Einbauplatz.eRegister.m_bytAuthLevel = 0
'''''''''''''''''''''''''''''''''''''''''''''
' PAM unverschlüsselt senden
Einbauplatz.eRegister.m_bUseKey = False
' aber SEMI Antwort kommt verschlüsselt!
'''''''''''''''''''''''''''''''''''''''''''''
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = "031F0101" ' Schloss schliessen
MSFlexGrid1.text = "Schloss schliessen"
PrintStatus "Schloss schliessen am Einbauplatz " & Einbauplatz.getNr & " wird ausgeführt."
End If
Else
' StatusFertigung ist < 30
PrintStatus "Schloss schliessen am Einbauplatz " & Einbauplatz.getNr & " nicht ausgeführt, da Zähler nicht erfolgreich geprüft."
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
Einbauplatz.eRegister.m_bUseKey = False
Einbauplatz.eRegister.m_StateClosingAllowed = False
MSFlexGrid1.text = " - "
End If
End If
End If
Next
' Schloss schliessen, mit Decrypt
PruefungsAbschlussNeuerVako = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi_SchlossSchliessen("Schloss schliessen")
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''' GET DEBUG zum Überprüfen des Schloss Status
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "Get DEBUG"
For Each Einbauplatz In m_colEinbauplatz
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
' nur erfolgreich geprüfte Zähler
If Not IsNull(Einbauplatz.eRegister.m_dGeschlossenDatum) And Einbauplatz.eRegister.m_StateClosingAllowed = False Then
If Val(Einbauplatz.eRegister.m_dGeschlossenDatum) > 0 Then
' Dieser Zähler wurde in einem früheren Prüfungsabschluss (laut Datenbank) geschlossen
Einbauplatz.eRegister.m_StateClosingAllowed = True
End If
End If
If ((Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getStatusFertigung >= 30 Or mblnVorbereitungFuzhoe) And Einbauplatz.eRegister.m_StateClosingAllowed = True) Then
' davon ausgehen, dass das Werk jetzt verschlossen ist
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' mit Key
Einbauplatz.eRegister.m_bUseKey = True
strCMDHex = "1F0000" ' Get Debug
' mit PIN 3
strCMDHex = strCMDHex & ProvideAuthLevelHexCommand(3)
strCMDHex = Hex2(Len(strCMDHex) / 2) & strCMDHex
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
MSFlexGrid1.text = "Get Debug"
PrintStatus "Get Debug am Einbauplatz " & Einbauplatz.getNr & " wird ausgeführt."
Else
' Das werk ist nicht verschlossen, also ohne Key ansprechen
Einbauplatz.eRegister.m_bUseKey = False
strCMDHex = "1F0000" ' Get Debug
strCMDHex = Hex2(Len(strCMDHex) / 2) & strCMDHex
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
MSFlexGrid1.text = "Get Debug"
PrintStatus "Get Debug am Einbauplatz " & Einbauplatz.getNr & " wird ausgeführt."
End If
End If
End If
Next
PruefungsAbschlussNeuerVako = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("Lese DEBUG", , False, True)
If PruefungsAbschlussNeuerVako = False Then Exit Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''' DEBUG in INFO2 vergleiche mît INFO1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Ab hier schlägt der Crypt-Key zu. Ist er falsch, sind DEBUG und SEMI Datensalat
' Vergleiche INFO1 mit INFO2
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "Vergl.vorh/hinterhr"
strMeldungGes = ""
For Each Einbauplatz In m_colEinbauplatz
strMeldungEbp = ""
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
If Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getStatusFertigung >= 30 Or mblnVorbereitungFuzhoe Then
Set objPAM = mSIRTStatemashine.GetPAM(Einbauplatz.getNr)
If Not objPAM Is Nothing Then
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set Einbauplatz.eRegister.m_lastSEMI = objPAM.SEMI
Set Einbauplatz.eRegister.m_lastBUP = objPAM.BUP
Set Einbauplatz.eRegister.m_lastDEBUG = objPAM.DEBUG
Einbauplatz.eRegister.m_dSEMIDEBUGDatum = Now()
If objPAM.DEBUG.Factory_State = 2 Then
' Information, ob Zähler geschlossen ist, in Datenbank speichern
Einbauplatz.eRegister.m_dGeschlossenDatum = Now()
Einbauplatz.eRegister.m_StateClosed = True
End If
Einbauplatz.eRegister.save Einbauplatz.getPruefzaehler.getSerienNr
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set mobjInfo_DEBUG_2(Einbauplatz.getNr) = objPAM.DEBUG
Set mobjInfo_SEMI_2(Einbauplatz.getNr) = objPAM.SEMI
If Not mobjInfo_DEBUG_1(Einbauplatz.getNr) Is Nothing And Not mobjInfo_DEBUG_2(Einbauplatz.getNr) Is Nothing And Not mobjInfo_SEMI_1(Einbauplatz.getNr) Is Nothing And Not mobjInfo_SEMI_2(Einbauplatz.getNr) Is Nothing Then
'''''''''''''''''''''' für Thames Water hart codiert
' CCW
VergleicheWerte "Volume_Per_Pulse", mobjInfo_DEBUG_2(Einbauplatz.getNr).Volume_Per_pulse, strMeldungEbp, mobjInfo_DEBUG_1(Einbauplatz.getNr).Volume_Per_pulse
VergleicheWerte "Offset_Factor", Val(mobjInfo_DEBUG_2(Einbauplatz.getNr).Offset_Factor), strMeldungEbp, Val(mobjInfo_DEBUG_1(Einbauplatz.getNr).Offset_Factor)
VergleicheWerte "Offset_Time", mobjInfo_DEBUG_2(Einbauplatz.getNr).Offset_Time, strMeldungEbp, mobjInfo_DEBUG_1(Einbauplatz.getNr).Offset_Time
VergleicheWerte "Factory_calibration", mobjInfo_DEBUG_2(Einbauplatz.getNr).Factory_calibration, strMeldungEbp, mobjInfo_DEBUG_1(Einbauplatz.getNr).Factory_calibration
'Value reported in SEMI 0x00=Cubic Meters (m3) 19 = 0x13 = b0001 0011
VergleicheWerte "Unit", mobjInfo_SEMI_2(Einbauplatz.getNr).Volume_Unit, strMeldungEbp, mobjInfo_SEMI_1(Einbauplatz.getNr).Volume_Unit
VergleicheWerte "Meter_Size", mobjInfo_DEBUG_2(Einbauplatz.getNr).Meter_Size, strMeldungEbp, mobjInfo_DEBUG_1(Einbauplatz.getNr).Meter_Size
VergleicheWerte "Volume_Per_LED_Pulse", mobjInfo_DEBUG_2(Einbauplatz.getNr).Volume_Per_LED_Pulse, strMeldungEbp, mobjInfo_DEBUG_1(Einbauplatz.getNr).Volume_Per_LED_Pulse
VergleicheWerte "Alarm_Mask_Active_Information", mobjInfo_SEMI_2(Einbauplatz.getNr).Alarm_Mask_Active_Information, strMeldungEbp, mobjInfo_SEMI_1(Einbauplatz.getNr).Alarm_Mask_Active_Information
VergleicheWerte "Alarm", mobjInfo_SEMI_2(Einbauplatz.getNr).Alarm, strMeldungEbp, mobjInfo_SEMI_1(Einbauplatz.getNr).Alarm
VergleicheWerte "Customer_specific_text", Val(mobjInfo_SEMI_2(Einbauplatz.getNr).Customer_specific_text), strMeldungEbp, Val(mobjInfo_SEMI_1(Einbauplatz.getNr).Customer_specific_text)
''VergleicheWerte "Billing_Volume", Val(mobjInfo_SEMI_2(Einbauplatz.getNr).Billing_Volume), strMeldungEbp, Val(mobjInfo_SEMI_1(Einbauplatz.getNr).Billing_Volume)
VergleicheWerte "Leakage_Detection_Parameters", mobjInfo_SEMI_2(Einbauplatz.getNr).Leakage_Detection_Parameters, strMeldungEbp, mobjInfo_SEMI_1(Einbauplatz.getNr).Leakage_Detection_Parameters
VergleicheWerte "Broken_Pipe_Detection_Parameters", mobjInfo_SEMI_2(Einbauplatz.getNr).Broken_Pipe_Detection_Parameters, strMeldungEbp, mobjInfo_SEMI_1(Einbauplatz.getNr).Broken_Pipe_Detection_Parameters
VergleicheWerte "Logging_interval", mobjInfo_SEMI_2(Einbauplatz.getNr).Logging_interval, strMeldungEbp, mobjInfo_SEMI_1(Einbauplatz.getNr).Logging_interval
VergleicheWerte "Fixed_Date_ReadingContent", mobjInfo_SEMI_2(Einbauplatz.getNr).Fixed_Date_ReadingContent, strMeldungEbp, mobjInfo_SEMI_1(Einbauplatz.getNr).Fixed_Date_ReadingContent
VergleicheWerte "Transmission_Interval", mobjInfo_SEMI_2(Einbauplatz.getNr).Transmission_interval, strMeldungEbp, mobjInfo_SEMI_1(Einbauplatz.getNr).Transmission_interval
VergleicheWerte "LAT_Interval", mobjInfo_SEMI_2(Einbauplatz.getNr).LAT_interval, strMeldungEbp, mobjInfo_SEMI_1(Einbauplatz.getNr).LAT_interval
' Shipment Mode
VergleicheWerte "Factory_State", mobjInfo_DEBUG_2(Einbauplatz.getNr).Factory_State, strMeldungEbp, 2
' Factory State muss 2 sein, Shipment mode
If mobjInfo_DEBUG_2(Einbauplatz.getNr).Factory_State <> 2 Then
strMeldungEbp = strMeldungEbp & "Werk ist nicht verschlossen und darf nicht ausgeliefert werden" & vbCrLf
Else
' Werk wurde verschlossen
' von jetzt an das Werk verschlüsselt ansprechen
Einbauplatz.eRegister.m_StateClosed = True
Einbauplatz.eRegister.m_bUseKey = True
' Fortschrittsrückmeldung für einen einzelnes Werk
Call Fortschrittrueckmeldung_eRegister_Geschlossen(Einbauplatz.getPruefzaehler.getAuftragPosition.GetFertigungsauftragNr, 1)
End If
If strMeldungEbp <> "" Then
strMeldungEbp = "fehlerhafter Vergleich am Einbauplatz " & Einbauplatz.getNr & ": " & vbCrLf & strMeldungEbp
strMeldungGes = strMeldungGes & vbCrLf & strMeldungEbp
Einbauplatz.eRegister.m_strAbbruch_Fehler = Einbauplatz.eRegister.m_strAbbruch_Fehler & strMeldungEbp & vbCrLf
MSFlexGrid1.text = "Fail"
MSFlexGrid1.CellBackColor = RGB(255, 128, 128)
Else
MSFlexGrid1.text = "OK"
MSFlexGrid1.CellBackColor = RGB(128, 255, 128)
End If
End If
End If
Else
MSFlexGrid1.text = " - "
End If
End If
End If
Next
If strMeldungGes <> "" Then
MsgBox strMeldungGes
End If
End If 'ebeling
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''' Go Sleep and set WUP-IV ( 3 sec oder 6 sec)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Not mblnVorbereitungFuzhoe Then
'Fuzhoe muss die LED noch seperat angesprcohen werden über funk
GoSleepWUPIV
End If
AutoSpaltenBreite MSFlexGrid1, lblAutosize
If mblnVorbereitungEbeling = False And Not mblnVorbereitungFuzhoe Then
ShowErgebnis
Else
' Kein Weiter-Button wenn VorbereitungEbeling
m_blnAbbruch = False
PruefungsAbschlussNeuerVako = True
Unload frmeRegisterErgebnis
Exit Function
End If
m_blnAbbruch = False
' Warten, bis Weiter-Button oder Abbruch Button
WarteAufWeiterButton "Weiter", 0
Unload frmeRegisterErgebnis
If m_blnAbbruch Then Exit Function
PrintStatus "eRegister Prüfungs-Abschluss beendet"
PruefungsAbschlussNeuerVako = True
End Function
Private Function UeberpruefeFunkadresse() As Boolean
Dim blnEbpAdresseGeaendert As Boolean
Dim Einbauplatz As CEinbauplatz
Dim strRadioAdresseSEMI As String
Dim strRadioAdresseBUP As String
Dim objPAM As SIRTCOM.PAM
UeberpruefeFunkadresse = True
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Finale Funkadresse mit Funkadresse in SEMI oder BUP vergleichen, dazu letzte PAM verwenden
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
MSFlexGrid1.row = fgZeile.Zeile_Pz_RadioAdr
For Each Einbauplatz In m_colEinbauplatz
strRadioAdresseSEMI = ""
strRadioAdresseBUP = ""
blnEbpAdresseGeaendert = False
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
MSFlexGrid1.col = Einbauplatz.getNr
Set objPAM = mSIRTStatemashine.GetPAM(Einbauplatz.getNr)
If Not objPAM Is Nothing Then
If Einbauplatz.eRegister.m_sRadioAdress <> Einbauplatz.eRegister.m_sRadioAdressFinal Then
' es gab einen Finale-FAdr-PAM-Befehl an diesen Einbauplatz
If Not objPAM.SEMI Is Nothing Then
' Es wurde zu dieser PAM eine SEMI empfangen
' letzte SEMI kam von dieser Adresse:
strRadioAdresseSEMI = objPAM.SEMI.RadioAdr
If Val(strRadioAdresseSEMI) = Val(Einbauplatz.eRegister.m_sRadioAdressFinal) Then
' kommt eigentlich nur vor, wenn Adresse und Zieladresse die selben waren,
' also das Werk bereits die finale Funkadresse hatte
' denn bei Adresseänderung kommt nie eine SEMI von der alten Adresse
blnEbpAdresseGeaendert = True
PrintStatus "SEMI von neuer Funkadresse " & strRadioAdresseSEMI & " empfangen!"
End If
Else
If Not objPAM.BUP Is Nothing Then
' letzte BUP kam von dieser Adresse
strRadioAdresseBUP = objPAM.BUP.RadioAdr
If Val(strRadioAdresseBUP) = Val(Einbauplatz.eRegister.m_sRadioAdressFinal) Then
blnEbpAdresseGeaendert = True
PrintStatus "BUP von neuer Funkadresse " & strRadioAdresseBUP & " empfangen!"
objPAM.Zieladresse = ""
End If
Else
Debug.Print "Weder BUP noch SEMI"
End If
End If
End If
If blnEbpAdresseGeaendert = True Then
' einer dieser Funkadresse (von PAM und SEMI) stimmt mit der finalen Funkadresse überein
' das ist ein Hinweis, dass die Funkadressen-Änderung geklappt hat
' aktuelle Funkadresse anzeigen
If Einbauplatz.eRegister.m_sRadioAdress <> Einbauplatz.eRegister.m_sRadioAdressFinal Then
' GANZ WICHTIG: Adresse des eRegisters aktualisieren
Einbauplatz.eRegister.m_sRadioAdress = Einbauplatz.eRegister.m_sRadioAdressFinal
' anzeigen
MSFlexGrid1.text = Einbauplatz.eRegister.m_sRadioAdressFinal
' speichern
Einbauplatz.eRegister.m_dFunkadresseDatum = Now()
Einbauplatz.eRegister.save Einbauplatz.getPruefzaehler.getSerienNr
' alles ok.
' Workaround: in der SIRTSTATEMASHINE nicht mehr versuchen, diese PAM aus dem PAMReg zu löschen
objPAM.Zieladresse = "0"
Else
' Adresse wurde bereits geändert
End If
Else
' Funkadresse in BUP und ggf in SEMI stimmen NICHT mit der finalen Funkadresse überein
MSFlexGrid1.CellBackColor = RGB(255, 255, 128) 'Gelb
UeberpruefeFunkadresse = False
End If
Else
If Not objPAM Is Nothing Then
' PAM is nothing
If Val(Einbauplatz.eRegister.m_sRadioAdress) = Val(Einbauplatz.eRegister.m_sRadioAdressFinal) Then
' aktuelle Funkadresse stimmt mit Finaler überein
MSFlexGrid1.CellBackColor = RGB(128, 255, 128)
MSFlexGrid1.text = Einbauplatz.eRegister.m_sRadioAdress
End If
End If
End If
End If
End If
Next
End Function
Private Function ResetFlow_and_Backflow() As Boolean
Dim objPAM As PAM
Dim objSEMI As SEMI
Dim curVolumeAnzeige As Currency
Dim Einbauplatz As CEinbauplatz
Dim strCMDHex As String
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "Backflow Reset"
For Each Einbauplatz In m_colEinbauplatz
strCMDHex = ""
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
If Einbauplatz.eRegister.m_StateClosed = False Then
If (Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getStatusFertigung >= 30 Or mblnVorbereitungFuzhoe) Then
Set objPAM = mSIRTStatemashine.GetPAM(Einbauplatz.getNr)
If Not objPAM Is Nothing Then
Set objSEMI = objPAM.SEMI
If objSEMI.Backward_Volume > 0 Then
' NW abhängig bis NW 125: 0.500m³ , ab NW 150: 0,50
If Einbauplatz.getPruefzaehler.getIdentNrObj.getNennweite < 150 Then
' bis NW 125: 0.500 m³
curVolumeAnzeige = 500
Else
' bis NW 125: 0.50 m³
curVolumeAnzeige = 50
End If
strCMDHex = strCMDHex & "30" & Hex8(curVolumeAnzeige)
WriteToLog "PAM 48 Anzeige = " & curVolumeAnzeige & " : 0x30 " & Hex8(curVolumeAnzeige)
strCMDHex = Hex2(Len(strCMDHex) / 2) & strCMDHex
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
End If ' Backvol > 0
End If ' PAM is nothing
End If ' StateClosed
End If ' StatusFertigung >= 30
End If ' Einbauplatz.eRegister
End If 'Einbauplatz.getPruefzaehler
Next ' Einbauplatz
ResetFlow_and_Backflow = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("Backflow Reset", , False, False)
End Function
Private Function WarteAufWeiterButton(strText As String, Optional SekundenBisWeiter As Integer = 0) As Boolean
' nur diese Funktion darf den Weiter Button beeinflussen
cmdWeiter.caption = strText
cmdWeiter.Enabled = True
cmdWeiter.Visible = True
cmdWeiter.Default = True
Dim iCountDown As Integer
m_blnWeiter = False
If SekundenBisWeiter > 0 Then
iCountDown = SekundenBisWeiter * 10
End If
Do
If SekundenBisWeiter > 0 Then
cmdWeiter.caption = strText & " (" & Int(iCountDown / 10) & " s)"
iCountDown = iCountDown - 1
If iCountDown < 1 Then
m_blnWeiter = True
End If
End If
SleepWithEvents 100, True
Loop While m_blnWeiter = False And m_blnAbbruch = False
WarteAufWeiterButton = Not m_blnAbbruch
cmdWeiter.Enabled = False
cmdWeiter.Visible = False
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Go Sleep and set WUP-IV 3s
' nur erfolgreich geprüfte eRegister verwenden CryptKey
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function GoSleepWUPIV(Optional byteWUPIV As Byte = 3)
Dim Einbauplatz As CEinbauplatz
Dim strCMDHex As String
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, ""
For Each Einbauplatz In m_colEinbauplatz
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
strCMDHex = ""
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
If Not Einbauplatz.eRegister.mobj_eRegister_Auftragposition Is Nothing Then
byteWUPIV = Einbauplatz.eRegister.mobj_eRegister_Auftragposition.mbytWake_Up_Interval
Else
byteWUPIV = 3
End If
If Einbauplatz.eRegister.m_StateClosed = False Then
' Wenn dieser Zähler nicht verschlossen wurde, und ggf noch mal geprüft wird,
' dann muss er sich wieder per Wasser aufwecken lassen.
byteWUPIV = 3
End If
' WUP-IV=3s
strCMDHex = "00" & Hex2(byteWUPIV)
If Einbauplatz.eRegister.m_StateClosed Then
' verschlossen, dann mit Key
Einbauplatz.eRegister.m_bytAuthLevel = 2
strCMDHex = strCMDHex & ProvideAuthLevelHexCommand(2)
Einbauplatz.eRegister.m_bUseKey = True
Else
Einbauplatz.eRegister.m_bUseKey = False
End If
strCMDHex = Hex2(Len(strCMDHex) / 2) & strCMDHex
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
End If
End If
Next
GoSleepWUPIV = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("Sleep, WUP-Iv")
If GoSleepWUPIV = False Then Exit Function
End Function
Private Function VergleicheWerte(strName As String, value As Variant, ByRef strMeldung As String, Optional varExpectedValue As Variant, Optional varExpectedMinValue As Variant, Optional varExpectedMaxValue As Variant) As Boolean
VergleicheWerte = True
If Not IsMissing(varExpectedValue) Then
If value <> varExpectedValue Then
strMeldung = strMeldung & strName & "=" & value & " <> " & varExpectedValue & vbCrLf
PrintStatus " " & strName & ": " & value & " <> " & varExpectedValue & " FAIL"
VergleicheWerte = False
Else
PrintStatus " " & strName & ": " & value & " = " & varExpectedValue & " OK"
End If
End If
If Not IsMissing(varExpectedMaxValue) Then
If value > Val(varExpectedMaxValue) Then
strMeldung = strMeldung & strName & "=" & value & " > " & varExpectedMaxValue & vbCrLf
PrintStatus " " & strName & ": " & value & " > " & varExpectedMaxValue & " FAIL"
VergleicheWerte = False
Else
PrintStatus " " & strName & ": " & value & " <= " & varExpectedMaxValue & " OK"
End If
End If
If Not IsMissing(varExpectedMinValue) Then
If value < varExpectedMinValue Then
strMeldung = strMeldung & strName & "=" & value & " < " & varExpectedMinValue & vbCrLf
PrintStatus " " & strName & ": " & value & " < " & varExpectedMinValue & " FAIL"
VergleicheWerte = False
Else
PrintStatus " " & strName & ": " & value & " >= " & varExpectedMinValue & " OK"
End If
End If
End Function
Private Function Ist_Eine_PAM_noch_im_PAM_Register() As Boolean
Dim objPAM As SIRTCOM.PAM
Dim Einbauplatz As CEinbauplatz
Ist_Eine_PAM_noch_im_PAM_Register = False
For Each Einbauplatz In m_colEinbauplatz
Set objPAM = mSIRTStatemashine.GetPAM(Einbauplatz.getNr)
If Not objPAM Is Nothing Then
Select Case objPAM.State
Case SIRTCOM.PAMStates.PAMStates_InPamRegister
Ist_Eine_PAM_noch_im_PAM_Register = True
End Select
End If
Next
End Function
Public Sub ClearPamregister()
Dim strOutputhex As String
Dim strCmd As String
Dim byteAck As Byte
' 55 = direction PC -> SIRT
' 81 = Write To PAM-Pool
' 80 = P81-1 = delete all entries from pool, regardless of address
' 00 = P81-2 Until now this byte will not be interpreted
' 00 00 00 00 = Adr
' 00 = Length Of Data
' 20 Data ??
' 20 95 = CRC
' 16 = Fix
strCmd = "55 81 80 00 00 00 00 00 00 20 95 16"
Call SIRTSendTransparent(strCmd, strOutputhex)
WriteToLog "ClearPamregister SendTransparent(" & strCmd & "), Antwort: " & strOutputhex
End Sub
' Sendet Befehl transparent direkt an SIRT
' Gibt ACK (P12) zurück
Private Function SIRTSendTransparent(strCmd As String, Optional ByRef strResponse As String) As Long
Dim objWrapper As SIRTCOM.Wrapper
Dim arbytes() As Byte
Dim intStelle As Integer
Dim lengthACK As Byte
Debug.Print "SendTransparent " & strCmd
strCmd = Replace(strCmd, " ", "")
Set objWrapper = New SIRTCOM.Wrapper
SIRTSendTransparent = objWrapper.SendTransparent(strCmd, arbytes, lengthACK)
Debug.Print " ACK=" & SIRTSendTransparent
'Debug.Print "lengthACK= " & lengthACK
If SIRTSendTransparent <> 0 Then
WriteToLog "SIRTSendTransparent: " & strCmd & " ACK=" & SIRTSendTransparent & "=" & objWrapper.GetLastErrorMessage
End If
strResponse = ""
For intStelle = 0 To lengthACK - 1
strResponse = strResponse & Right("0" & Hex(arbytes(intStelle)), 2) & " "
Next
strResponse = Trim(strResponse)
Debug.Print " Receive=" & strResponse
'#define SIRT_DLL_ACK 0
'#define SIRT_ERROR_USB_BLUETOOTH_FAILURE 1
'#define SIRT_ERROR_DEVNAME_ACCCODE_NOMATCH 2
'#define SIRT_ERROR_BUP_OR_SEMI_STACKEMPTY 3
'#define SIRT_ERROR_BUP_OR_SEMI_STACKOVERFLOW 4 /* no way to report that to application */
'#define SIRT_ERROR_NOMORE_SEMI_INSTACK 5
'#define SIRT_ERROR_PAM_STACK_FULL 6
'#define SIRT_ERROR_PAM_STACK_EMPTY 7 /* no way/need to report that to application */
'#define SIRT_ERROR_CRC_FAILURE 8
'#define SIRT_ERROR_TIMEOUT 9
'#define SIRT_ERROR_NOT_OPEN 10
'#define SIRT_ERROR_ALREADY_OPEN 11
'#define SIRT_ERROR_WRITE_FAILED 12
'#define SIRT_ERROR_READ_ERROR 13
'#define SIRT_ERROR_OUTOFMEMORY 14
End Function
Private Function Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi(strBeschreibung As String, Optional P81_1 As Byte = 16, Optional blnFunkAdressAendern As Boolean = False, Optional blnDEBUGRequired As Boolean = False, Optional blnSchlossSchliessen As Boolean = False) As Boolean
Dim Einbauplatz As CEinbauplatz
Dim strCMDHex As String
Dim strKeyHex As String
Dim strMeldung As String
Dim objPAM As SIRTCOM.PAM
Dim blnWdh As Boolean
Dim intWdh As Integer
Dim ret As Long
Dim strZielAdresse As String
Dim byteP81_1 As Byte
Dim blnNichtsZuTun As Boolean
On Error GoTo Errorhandler
blnNichtsZuTun = True
m_blnAbbruch = False
intWdh = 0
PAM_Senden_Wiederholen:
' Lösche alle PAMs aus Statemashine
' empty the Recs
' delete all entries from pool, regardless of address
' // REC_Parameter = 4 = delete all SEMI from stack and return without a result (only DLL_ACK)
mSIRTStatemashine.ClearPam
PAM_Senden_Wiederholen_mit_allen_Pams:
' neu RH 30.3.2016 Delete all Entrys from PAM Register per Send_Transparent
Call ClearPamregister
blnWdh = False
SetFlexgridRow m_PAMZeile, MSFlexGrid1, strBeschreibung & IIf(intWdh >= 1, "(" & intWdh & ")", "")
ScrolleNachUnten
' am 25.1.2017 wegen P12 = 68
Sleep 1000, True
DoEvents
mSIRTStatemashine.Timeout_s = 180
' Senden an alle
For Each Einbauplatz In m_colEinbauplatz
'If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
If Einbauplatz.eRegister.m_sRadioAdress <> "" Then
' Funkadresse ist vorhanden
MSFlexGrid1.col = Einbauplatz.getNr
If Einbauplatz.eRegister.m_sNaechsterPAMBefehl <> "" Then
' PAM Befehl ist vorhanden
blnNichtsZuTun = False
strCMDHex = Einbauplatz.eRegister.m_sNaechsterPAMBefehl
SetFlexgridRow m_PAMZeile, MSFlexGrid1, strBeschreibung
If blnFunkAdressAendern Then
strZielAdresse = Einbauplatz.eRegister.m_sRadioAdressFinal
Else
strZielAdresse = ""
End If
If Einbauplatz.eRegister.m_bUseKey = True Then
' use encryption key to encrypt PAM and to decrypt SEMI/DEBUG
strKeyHex = Einbauplatz.eRegister.m_sKeyHex
Else
strKeyHex = ""
End If
If P81_1 = 0 Then
' nutze individuellen P81_1 Paremeter für jeden Einbauplatz
byteP81_1 = Einbauplatz.eRegister.m_bytP81_1
If byteP81_1 = 0 Then
' byteP81_1 ist nicht gesetzt
If IsInIDE() Then
Stop
End If
byteP81_1 = 16
End If
Else
' nutze den gelichen P81_1 Parameter Wert für alle Einbauplaetze
byteP81_1 = P81_1
End If
SleepWithEvents 50, True
ret = mSIRTStatemashine.SendPAM(Einbauplatz.eRegister.m_sRadioAdress, strCMDHex, strZielAdresse, byteP81_1, Einbauplatz.getNr, Einbauplatz.eRegister.m_bytAuthLevel, strKeyHex, Einbauplatz.eRegister.m_curPIN, Einbauplatz.eRegister.m_bUseKey)
Log_To_eRegister_Radio_Log CCur(Einbauplatz.eRegister.m_sRadioAdress), "PAM", strCMDHex, strBeschreibung & "," & strZielAdresse & ", P81_1=" & byteP81_1 & ", Keyhex=" & Left(strKeyHex, 10) & ", ret = " & ret, Einbauplatz.getNr
Set objPAM = mSIRTStatemashine.GetPAM(Einbauplatz.getNr)
If objPAM.P12 <> 0 And objPAM.P12 <> 8 Then
If IsInIDE() Then
Stop
End If
End If
If Not objPAM Is Nothing Then
If objPAM.State = PAMStates_Error Then
If IsInIDE() Then
' Fehler schon in der IDE abfangen
Stop
End If
End If
End If
mSIRTStatemashine.LogToFile strBeschreibung & ": * an Adr " & Einbauplatz.eRegister.m_sRadioAdress
PrintStatus "Sende PAM '" & strCMDHex & "',(mit AuthLevel=" & Einbauplatz.eRegister.m_bytAuthLevel & ") FAdr=" & Einbauplatz.eRegister.m_sRadioAdress & ", Ebp=" & Einbauplatz.getNr & ", Zieladr=" & strZielAdresse & ", " & strBeschreibung & ", Status=" & ret & ", Wdh=" & intWdh
If blnSchlossSchliessen Then
' nach dem "Schloss schliessen" muessen SEMI und DEBUG entschluesselt werden!
objPAM.IsEncrypted = True
End If
Else
' kein PAM Befehl für diesen Einbauplatz
End If
Else
PrintStatus "Keine Funkadresse für Ebp " & Einbauplatz.getNr & "."
End If
Else
End If
'End If
Next
If blnNichtsZuTun Then
Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi = True
Exit Function
End If
mSIRTStatemashine.start
Aktualisiere_PAM_Status
AutoSpaltenBreite MSFlexGrid1, lblAutosize
'''''''''''''''''''''''''''''''''''''
' Warte auf SEMI oder Abbruch
Do
'MSFlexGrid1.Rows = MSFlexGrid1.Rows + 1
'MSFlexGrid1.Rows = MSFlexGrid1.Rows - 1
SleepWithEvents 500, True
Aktualisiere_PAM_Status
DoEvents
Sleep 100
'AutoSpaltenBreite MSFlexGrid1, lblAutosize
If mSIRTStatemashine Is Nothing Then
' Notausgang
Exit Do
End If
If blnFunkAdressAendern Then
If UeberpruefeFunkadresse() Then
Debug.Print "Alle FA Fertig"
Else
Debug.Print "noch nicht alle FA Fertig"
End If
End If
Loop While Not mSIRTStatemashine.AllPAMsAreFinished And m_blnAbbruch = False
''''''''''''''''''''''''''''''''''''''''''''''''''''
If blnFunkAdressAendern Then
If UeberpruefeFunkadresse() Then
Debug.Print "Alle FA Fertig"
Else
Debug.Print "noch nicht alle FA Fertig"
End If
End If
Sleep 2000, True
' Anzeige noch einmal aktualisieren
Aktualisiere_PAM_Status
'''''''''''''''''''''''''''''''''''''
If mSIRTStatemashine Is Nothing Then
' Notausgang
Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi = False
Exit Function
Else
mSIRTStatemashine.Stop
End If
AutoSpaltenBreite MSFlexGrid1, lblAutosize
If m_blnAbbruch Then
' Abbruch Taste wurde gedrückt
If blnSchlossSchliessen = False Then
' beim Schloss schliessen diese Frage nicht so stellen
ret = MsgBox("Möchten Sie diesen PAM Befehl für alle eRegister Werke wiederholen?" & vbCrLf & "'Abbruch' bricht die Prüfung ab," & vbCrLf & "mit 'Nein' wird fortgefahren.", vbYesNoCancel Or vbDefaultButton1, "manueller Abbruch des PAM-Befehls")
Select Case ret
Case vbYes
' manuellen Abbruch stoppen
m_blnAbbruch = False
' wiederholen
GoTo PAM_Senden_Wiederholen
Case vbNo
' manuellen Abbruch stoppen, normal weitermachen
m_blnAbbruch = False
Case vbCancel
Exit Function
End Select
Else
' Abbruch während blnSchlossSchliessen = true
MsgBox "Abbruch beim Befehl 'Schloss schliessen' nicht erlaubt!"
m_blnAbbruch = False
End If
End If
' SEMI / SEMI.PAM Status auswerten, ggF wiederholen
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.eRegister Is Nothing Then
' Einbauplatz ist belegt
Set objPAM = mSIRTStatemashine.GetPAM(Einbauplatz.getNr)
If Einbauplatz.eRegister.m_sNaechsterPAMBefehl <> "" And Einbauplatz.eRegister.m_sRadioAdress <> "" Then
' Hier wurde ein Befehl ausgeführt
If Not objPAM Is Nothing Then
' PAM ist auch vorhanden
If objPAM.State = PAMStates_SEMI_Received Or objPAM.State = PAMStates_Addr_Changed Then
' SEMI empfangen oder die Adresse der BUP hat gewechselt, also Antwort ist vorhanden
If Not objPAM.SEMI Is Nothing Then
' SEMI ist vorhanden, auswerten!
Set Einbauplatz.eRegister.m_lastSEMI = objPAM.SEMI
If objPAM.SEMI.PAM_status <> 0 Then
' Fehler PAM_Status
If objPAM.CommandHex = "031F0101" Or blnSchlossSchliessen Then
' Wiederholen bei fehlgeschlagenem "Schloss schliessen" ist nicht angebracht!
' danach sollte ein GET DEBUG zur Überprüfung des Status durchgeführt werden
PrintStatus "PAM Status " & objPAM.SEMI.PAM_status & " beim Schloss Schliessen!"
' den nächsten PAM Befehl (Get Debug) verschlüsselt senden
Einbauplatz.eRegister.m_bUseKey = True
Else
' alle anderen Befehle mit PAM_status <> 0
strMeldung = "Mit der SEMI wurde ein Fehler angezeigt an Ebp " & Einbauplatz.getNr & vbCrLf & "PAM-Status = " & objPAM.SEMI.PAM_status & "=" & objPAM.SEMI.GetPamErrorMessage() & vbCrLf
strMeldung = strMeldung & "Möchten Sie das Senden der PAM wiederholen? Mit 'Nein' fahren sie ohne diesen Zähler fort. 'Abbruch' bricht die Prüfung ab."
ret = MsgBox(strMeldung, vbYesNoCancel, "SEMI ergab einen Fehler")
Select Case ret
Case vbYes
blnWdh = True
GoTo NaechsterPAMBefehl_nicht_loeschen
Case vbNo
Einbauplatz.setAktiv False
Einbauplatz.eRegister.m_strAbbruch_Fehler = Einbauplatz.eRegister.m_strAbbruch_Fehler & "Abbruch der Programmierung bei " & strBeschreibung & ". SEMI Fehler: " & objPAM.SEMI.GetPamErrorMessage() & vbCrLf
Set Einbauplatz.eRegister_inactive = Einbauplatz.eRegister
Set Einbauplatz.eRegister = Nothing
Case vbCancel
Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi = False
Exit Function
End Select
End If 'objPAM.CommandHex = "031F0101" Or blnSchlossSchliessen Then
Else 'objPAM.SEMI.PAM_status <> 0
'SEMI PAM_status=0, alles OK
End If
End If ' objPAM.SEMI Is Nothing
If Not objPAM.DEBUG Is Nothing And blnSchlossSchliessen = False Then
' DEBUG ist vorhanden
Set Einbauplatz.eRegister.m_lastDEBUG = objPAM.DEBUG
If Einbauplatz.eRegister.m_sPCBid <> "" Then
If Right(Currency2Hex(objPAM.DEBUG.PCB_ID), 8) <> Right(Currency2Hex(Einbauplatz.eRegister.m_sPCBid), 8) Then
strMeldung = "Die PCB-ID 0x" & Right(Currency2Hex(objPAM.DEBUG.PCB_ID), 8) & " (" & objPAM.DEBUG.PCB_ID & ") im Debug-Telegramm entspricht nicht " & vbCrLf & "der PCB-ID 0x" & Currency2Hex(Einbauplatz.eRegister.m_sPCBid) & " (" & Einbauplatz.eRegister.m_sPCBid & ") im Opto-Telegramm / Datenbank. Das ist ein Hinweis auf eine mehrfach vergebene Funkadresse " & Einbauplatz.eRegister.m_sRadioAdress & " (Einbauplatz " & Einbauplatz.getNr & ")."
PrintStatus strMeldung
If MsgBox(strMeldung, vbCritical Or vbOKCancel Or vbDefaultButton2, "Das Werk wurde gewechselt!") = vbCancel Then
Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi = False
Exit Function
End If
End If
End If
If blnSchlossSchliessen Then
' Sonderfall Schloss schliessen
If objPAM.DEBUG.Factory_State = 2 And Einbauplatz.eRegister.m_StateClosed = False Then
' Hier wurde das Werk erfolgreich geschlossen, weil DEBUG.Factory_State = 2 ist
Einbauplatz.eRegister.m_bUseKey = True
Einbauplatz.eRegister.m_StateClosed = True
Einbauplatz.eRegister.m_dGeschlossenDatum = Now
Einbauplatz.eRegister.save Einbauplatz.getPruefzaehler.getSerienNr
PrintStatus "DEBUG.Factory_State = 2 ==> Werk an Ebp " & Einbauplatz.getNr & " wurde erfolgreich verschlossen!"
MSFlexGrid1.TextMatrix(fgZeile.Zeile_Pz_State, Einbauplatz.getNr) = "geschlossen"
End If
' Sonderfall Schloss schliessen
End If
Else
' Timeout
' DEBUG ist NICHT gekommen
If blnDEBUGRequired = True Then
Log_To_eRegister_Radio_Log CCur(Einbauplatz.eRegister.m_sRadioAdress), "kein DEBUG", "", "BUPs=" & objPAM.CountBup & ", Time=" & objPAM.GetTime & ", Wdh!", Einbauplatz.getNr
'DEBUG wurde aber verlangt
objPAM.CountSemi = 0
objPAM.CountDebug = 0
objPAM.CountBup = 0
objPAM.State = 1
objPAM.StartTime
Set mSIRTStatemashine.GetPAM(Einbauplatz.getNr).SEMI = Nothing
Set mSIRTStatemashine.GetPAM(Einbauplatz.getNr).BUP = Nothing
Set mSIRTStatemashine.GetPAM(Einbauplatz.getNr).DEBUG = Nothing
PrintStatus "DEBUG Telegramm wurde nicht am Ebp " & Einbauplatz.getNr & " empfangen. Also wdh."
blnWdh = True
GoTo NaechsterPAMBefehl_nicht_loeschen
End If
End If
If Not Einbauplatz.eRegister Is Nothing Then
If Not objPAM.BUP Is Nothing Then
Set Einbauplatz.eRegister.m_lastBUP = objPAM.BUP
End If
' OK, Befehl wurde erfolgreich ausgeführt.
' Kann also entfernt werden, weil dieser Befehl nicht wiederholt werden muss
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
End If
NaechsterPAMBefehl_nicht_loeschen:
Debug.Print
Else
' etwas ist schief gegangen, z.B. Timeout
Select Case objPAM.State
Case PAMStates_Timeout, PAMStates_InPamRegister
strMeldung = "Werk an Ebp " & Einbauplatz.getNr & " hat nicht geantwortet. Timeout oder Abbruch!"
Log_To_eRegister_Radio_Log CCur(Einbauplatz.eRegister.m_sRadioAdress), "TIMEOUT", "BUPS=" & objPAM.CountBup & ",Time=" & objPAM.GetTime, "", Einbauplatz.getNr
If blnFunkAdressAendern Then
' Timeout bei Funkadresse-Ändern:
' Funkadresse sollte geändert werden, aber es wurde keine SEMI emfangen:
' überprüfen, ob die zuletzt empfangene BUP von der neuen Adresse gekommen ist
' erneut die selbe PAM mit der neuen Adresse senden
If objPAM.CountBup > 0 Then
' Es wurden BUPs empfangen
If objPAM.BUP.RadioAdr = objPAM.Zieladresse Then
' von der Zieladresse
strMeldung = strMeldung & vbCrLf & "wird mit der neuen Adresse " & Einbauplatz.eRegister.m_sRadioAdressFinal & " wiederholt."
Einbauplatz.eRegister.m_sRadioAdress = Einbauplatz.eRegister.m_sRadioAdressFinal
If intWdh < 3 Then
' PAM zum Adresse-ändern mit der neuen Adresse senden um eine SEMI zu bekommen
blnWdh = True
End If
End If
End If
End If
Case PAMStates_Error
strMeldung = "Werk an Ebp " & Einbauplatz.getNr & ": Error. "
If Not objPAM.SEMI Is Nothing Then
If objPAM.SEMI.PAM_status <> 0 Then
Log_To_eRegister_Radio_Log CCur(Einbauplatz.eRegister.m_sRadioAdress), "PAM_status", objPAM.SEMI.PAM_status, objPAM.SEMI.GetPamErrorMessage, Einbauplatz.getNr
strMeldung = "PAM-State=" & objPAM.SEMI.PAM_status & " (" & objPAM.SEMI.GetPamErrorMessage & ") "
End If
End If
If objPAM.P12 <> 0 Then
strMeldung = "P12=" & objPAM.P12 & ". "
Log_To_eRegister_Radio_Log CCur(Einbauplatz.eRegister.m_sRadioAdress), "P12 Error", objPAM.P12, "", Einbauplatz.getNr
If intWdh < 3 Then
' PAM wiederholen
blnWdh = True
End If
End If
Case Else
End Select
If blnWdh = False And blnSchlossSchliessen = False Then
' Wiederholen wurde für einen vorherigen Einbauplatz noch nicht ausgewählt
If MsgBox(strMeldung & vbCrLf & "Möchten Sie das Senden der PAM wiederholen?" & vbCrLf & "Mit 'Nein' fahren sie ohne weitere Behandlung dieses Zählwerkes fort.", vbYesNo, "Befehl fehlgeschlagen an Einbauplatz " & Einbauplatz.getNr) = vbYes Then
blnWdh = True
Log_To_eRegister_Radio_Log CCur(Einbauplatz.eRegister.m_sRadioAdress), "User Wdh", "", "", Einbauplatz.getNr
' Diese PAM soll wiederholt gesendet werden
Else
' bei fehlgeschlagener PAM
Einbauplatz.eRegister.m_strAbbruch_Fehler = Einbauplatz.eRegister.m_strAbbruch_Fehler & "eRegister Programmierung fehlgeschlagen bei " & strBeschreibung & vbCrLf & strMeldung & vbCrLf
Einbauplatz.setAktiv False
Set Einbauplatz.eRegister_inactive = Einbauplatz.eRegister
Log_To_eRegister_Radio_Log CCur(Einbauplatz.eRegister.m_sRadioAdress), "User Deaktivate", "", "", Einbauplatz.getNr
Set Einbauplatz.eRegister = Nothing
End If
End If
End If ''Gehört zu: PAM State
End If ''Gehört zu: Not objPAM Is Nothing Then
End If ''Gehört zu: Not Einbauplatz.eRegister Is Nothing Then
End If ''Gehört zu: If Not Einbauplatz.eRegister Is Nothing Then
Next
If blnWdh And blnSchlossSchliessen = False Then
' m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, " (wdh)"
intWdh = intWdh + 1
If blnDEBUGRequired Then
SleepWithEvents 1000, True
GoTo PAM_Senden_Wiederholen_mit_allen_Pams
Else
SleepWithEvents 1000, True
GoTo PAM_Senden_Wiederholen
End If
End If
PrintStatus strBeschreibung & " fertig"
'mSIRTStatemashine.Stop
If m_blnAbbruch Then
Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi = False
Else
Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi = True
End If
Exit Function
Errorhandler:
Dim errnum As Long
Dim errdesc As String
errnum = Err.Number
errdesc = Err.Description
WriteToLog "Laufzeitfehler " & errnum & " in Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi(): " & errdesc
LogIntoDB "Laufzeitfehler " & errnum & " in Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi(): " & errdesc, "Softwarefehler"
'MsgBox "Laufzeitfehler " & errnum & " in Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi(): " & errdesc
Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi = False
Exit Function
Resume
End Function
Private Function Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi_SchlossSchliessen(strBeschreibung As String) As Boolean
Dim Einbauplatz As CEinbauplatz
Dim strCMDHex As String
Dim strKeyHex As String
Dim strMeldung As String
Dim objPAM As SIRTCOM.PAM
Dim ret As Long
Dim strZielAdresse As String
Dim byteP81_1 As Byte
On Error GoTo Errorhandler
m_blnAbbruch = False
' neu RH 30.3.2016 Delete all Entrys from PAM Register er Send_Transparent
Call ClearPamregister
mSIRTStatemashine.ClearPam
DoEvents
SetFlexgridRow m_PAMZeile, MSFlexGrid1, strBeschreibung
mSIRTStatemashine.Timeout_s = 180
' Senden an alle
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.getPruefzaehler Is Nothing Then
' Prüfzähler
If Not Einbauplatz.eRegister Is Nothing Then
' eRegister
If Einbauplatz.eRegister.m_sRadioAdress <> "" Then
' Funkadresse ist vorhanden
MSFlexGrid1.col = Einbauplatz.getNr
If Einbauplatz.eRegister.m_sNaechsterPAMBefehl <> "" Then
' PAM Befehl ist vorhanden
strCMDHex = Einbauplatz.eRegister.m_sNaechsterPAMBefehl
SetFlexgridRow m_PAMZeile, MSFlexGrid1, strBeschreibung
' Ohne Key und PIN ansprechen
' Zähler ist wach ==> byteP81_1 = 16
ret = mSIRTStatemashine.SendPAM(Einbauplatz.eRegister.m_sRadioAdress, strCMDHex, "", 16, Einbauplatz.getNr, 0, "", "0", False)
Log_To_eRegister_Radio_Log CCur(Einbauplatz.eRegister.m_sRadioAdress), "PAM", strCMDHex, strBeschreibung & "," & strZielAdresse & ", P81_1=" & byteP81_1 & ", Keyhex=" & Left(strKeyHex, 10) & ", ret = " & ret, Einbauplatz.getNr
mSIRTStatemashine.LogToFile strBeschreibung & ": * an Adr " & Einbauplatz.eRegister.m_sRadioAdress
PrintStatus "Sende PAM '" & strCMDHex & "',(mit AuthLevel=" & Einbauplatz.eRegister.m_bytAuthLevel & ") FAdr=" & Einbauplatz.eRegister.m_sRadioAdress & ", Ebp=" & Einbauplatz.getNr & ", Zieladr=" & strZielAdresse & ", " & strBeschreibung & ", Status=" & ret
' nach dem "Schloss schliessen" muessen SEMI und DEBUG entschluesselt werden
Set objPAM = mSIRTStatemashine.GetPAM(Einbauplatz.getNr)
objPAM.KeyHex = Einbauplatz.eRegister.m_sKeyHex
objPAM.IsEncrypted = True
Else
' kein PAM Befehl für diesen Einbauplatz
End If
Else
PrintStatus "Keine Funkadresse für Ebp " & Einbauplatz.getNr & "."
End If
Else
End If
End If
Next
mSIRTStatemashine.start
Aktualisiere_PAM_Status
AutoSpaltenBreite MSFlexGrid1, lblAutosize
'''''''''''''''''''''''''''''''''''''
' Warte auf SEMI oder Abbruch
Do
SleepWithEvents 500, True
Aktualisiere_PAM_Status
DoEvents
Sleep 100
If mSIRTStatemashine Is Nothing Then
' Notausgang
Exit Do
End If
Loop While Not mSIRTStatemashine.AllPAMsAreFinished And m_blnAbbruch = False
Sleep 2000, True
' Anzeige noch einmal aktualisieren
Aktualisiere_PAM_Status
mSIRTStatemashine.Stop
AutoSpaltenBreite MSFlexGrid1, lblAutosize
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.getPruefzaehler Is Nothing Then
' Prüfzähler vorhanden
If Not Einbauplatz.eRegister Is Nothing Then
' Ist eRegister
Set objPAM = mSIRTStatemashine.GetPAM(Einbauplatz.getNr)
If Not objPAM Is Nothing Then
' Bekam einen PAM Befehl
If Not objPAM.DEBUG Is Nothing Then
' DEBUG Antwort ist vorhanden
Log_To_eRegister_Radio_Log CCur(Einbauplatz.eRegister.m_sRadioAdress), "DEBUG (close)", objPAM.DEBUG.HexData, "Factory_State=" & objPAM.DEBUG.Factory_State, Einbauplatz.getNr
If objPAM.DEBUG.Factory_State = 2 Then
' wurde geschlossen
Einbauplatz.eRegister.m_dGeschlossenDatum = Now()
Einbauplatz.eRegister.save (Einbauplatz.getPruefzaehler.getSerienNr)
End If
' DEBUG Antwort ist vorhanden
Else
' DEBUG keine Antwort vorhanden
Log_To_eRegister_Radio_Log CCur(Einbauplatz.eRegister.m_sRadioAdress), "kein DEBUG (close)", "", "BUPs=" & objPAM.CountBup & ", Time=" & objPAM.GetTime & ", Wdh!", Einbauplatz.getNr
End If
' Bekam einen PAM Befehl
End If
' Ist eRegister
End If
' Prüfzähler vorhanden
End If
Next
If m_blnAbbruch Then
Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi_SchlossSchliessen = False
Else
Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi_SchlossSchliessen = True
End If
Exit Function
Errorhandler:
Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi_SchlossSchliessen = False
End Function
Private Sub Log_To_eRegister_Radio_Log(curRadioID As Currency, strType As String, strData As String, strBemerkung As String, EinbauplatzNr As Integer)
Dim rs As CRecordset
Dim strSQL As String
On Error GoTo Errorhandler
Set rs = New CRecordset
strSQL = "SELECT * FROM eRegister_Radio_Log where 1=0"
rs.openRS strSQL, False
rs.addNew
rs.setValue "Timestamp", Now()
rs.setValue "RadioID", curRadioID
rs.setValue "Type", strType
rs.setValue "Data", strData
rs.setValue "Bemerkung", strBemerkung
rs.setValue "Pruefstation", g_App.PruefstationNr
rs.setValue "Einbauplatz", EinbauplatzNr
rs.update
Exit Sub
Errorhandler:
WriteToLog "Fehler " & Err.Number & " in Log_To_eRegister_Radio_Log(): " & Err.Description
End Sub
'Private Function Sende_LED_an() As Boolean
' Dim Einbauplatz As CEinbauplatz
'
' mSIRTStatemashine.ClearPam
'
' For Each Einbauplatz In m_colEinbauplatz
' If Not Einbauplatz.getPruefzaehler Is Nothing Then
' ret = mSIRTStatemashine.SendPAM(Einbauplatz.eRegister.m_sRadioAdress, "031F3C08", "", 16, Einbauplatz.getNr, 0, "", "0")
' PrintStatus "Sende an " & Einbauplatz.getNr & " 'LED an'"
' SetFlexgridRow fgZeile.Zeile_PZ_Ende, MSFlexGrid1, "LED an"
' MSFlexGrid1.col = Einbauplatz.getNr
' MSFlexGrid1.text = "LED an..."
' End If
' Next
'
' Do
' SleepWithEvents 10, True
' Aktualisiere_PAM_Status "LED an"
' Loop While Not mSIRTStatemashine.AllPAMsAreFinished And m_blnAbbruch = False
'
' If m_blnAbbruch Then
' Sende_LED_an = False
' Else
' Sende_LED_an = True
' End If
'
'End Function
Public Function InitSirt(Optional Frequenz As Integer = 0) As Boolean
On Error GoTo Errorhandler
Dim ret As Long
Dim strDetails As String
Dim errnum As Long
Dim errdesc As String
Dim wdh As Byte
Dim dblSIRTCOMVersion As Double
''''''''''''''''' Schritt 1 ActiveX Komponente
wdh_init_SIRT_ActiveX:
Set mSIRTStatemashine = g_App.get_SIRT_Statemashine(errnum, errdesc)
If mSIRTStatemashine Is Nothing Then
strDetails = ""
Select Case errnum
Case 0
strDetails = ""
Case 429
strDetails = "Die ActiveX DLL SIRTCOM ist möglicherweise nicht mit RegAsm.exe registriert."
Case -2147024894
strDetails = "Die ActiveX DLL SIRTCOM ist zwar registriert aber nicht mehr am registrierten Speicherort vorhanden."
Case Else
End Select
ret = MsgBox("Fehler " & errnum & " in InitSirt(): " & errdesc & vbCrLf & strDetails, vbOKCancel)
If ret = vbOK Then
GoTo wdh_init_SIRT_ActiveX
End If
InitSirt = False
Exit Function
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
dblSIRTCOMVersion = getSIRTCOMVersion()
If Val(Replace(dblSIRTCOMVersion, ",", ".")) < MINIMALE_SIRTCOM_VERSION Then
MsgBox "Die SIRTCOM (Version " & dblSIRTCOMVersion & ") ist veraltet. Die erforderliche Version ist " & MINIMALE_SIRTCOM_VERSION
End
End If
PrintStatus "SIRTCOM Version " & mSIRTStatemashine.GetCOMVersion
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Debug.Print mSIRTStatemashine.StartLoggin("\\sla12file\Auftrag\00_eRegister C&I\Logs\" & Format(Now, "yyyy-mm-dd-hhmm") & "-sirt.log")
Set mSIRTWrapper = New SIRTCOM.Wrapper
PrintStatus "SIRT DLL Version: " & mSIRTWrapper.GetDLLVersion()
mSIRTStatemashine.LogToFile g_App.Mitarbeiter.getVorname & " " & g_App.Mitarbeiter.getName & " Host: " & g_strHostname
''''''''''''''''' Schritt 2 COM Port in Ini Datei
Dim comport As Integer
Dim strIniKey As String
Dim strFrequenz As String
If Frequenz = 0 Then
strIniKey = "COMPort"
strFrequenz = "(Frequenz unabhängig)"
Else
strIniKey = "COMPort_" & Trim(CStr(Frequenz))
strFrequenz = "(Frequenz " & Frequenz & " Mhz)"
End If
comport = Val(g_App.Settings.readStringValue("SIRT", strIniKey, ""))
If comport = 0 Then
' Eingabe des COM Ports
comport = Val(InputBox("Bitte geben Sie den COM Port für den SIRT " & strFrequenz & " an.", "Es ist kein COM Port für den SIRT in der INI eingetragen", comport))
If comport > 0 Then
' Speichern in ini Datei
g_App.Settings.saveStringValue "SIRT", strIniKey, CStr(comport)
Else
InitSirt = False
Exit Function
End If
End If
PrintStatus "SIRT " & strFrequenz & " an COMPort " & comport & " wird geöffnet..."
''''''''''''''''' Schritt 3 COM Port und Funkreceiver einschalten
wdh = 0
wdh_initialise:
ret = mSIRTStatemashine.initialise(comport)
strDetails = ""
Select Case ret
Case 32773
strDetails = "Möglicherweise hat ein anderer Prozess bereits vorher den selben COMPort " & comport & " geöffnet."
Case 32770
strDetails = "Am COM Port " & comport & " ist möglicherweise kein SIRT angeschlossen. Bitte prüfen Sie die USB Verbindung zum SIRT und schalten Sie den " & strFrequenz & " Mhz SIRT ein."
Case Else
End Select
If ret = 2 Then
GoTo wdh_initialise
End If
If ret = 9 Then
If wdh < 3 Then
PrintStatus "SIRT initialisierung Timeout. Wdh!"
wdh = wdh + 1
GoTo wdh_initialise
End If
End If
If ret <> 0 Then
ret = MsgBox("Fehler " & ret & " beim Initialisieren der SIRTCOM ActiveX: " & mSIRTStatemashine.GetLastErrorMessage & vbCrLf & strDetails, vbRetryCancel)
Select Case ret
Case vbRetry
comport = Val(InputBox("COM Port Nr:", "Verbindung mit dem SIRT", comport))
If comport > 0 Then
Call g_App.Settings.saveStringValue("SIRT", "COMPort", CStr(comport))
GoTo wdh_initialise
Else
InitSirt = False
Exit Function
End If
Case vbAbort, vbCancel
InitSirt = False
Exit Function
End Select
End If
SetSIRTActivateTimeout 0
' neu 27.7.2016
SetSIRTWakeuplength6
InitSirt = True
Exit Function
Errorhandler:
InitSirt = False
End Function
Private Sub SetSIRTWakeuplength6()
Dim strOutputhex As String
Dim strCmd As String
'WREG,0,5,1,6;
'Send <L=00013>;55h;84h;00h;01h;20h;00h;00h;05h;01h;06h;0Eh;41h;16h
'Receive <L=00012>;FFh;12h;00h;84h;20h;00h;00h;05h;00h;A6h;ECh;16h
' 55 = direction PC -> SIRT
' 84 = Write to Register address
' 00 = Param 84
' 01 = Write length
' 20 = 00 00 05 = Adress
' 01 = length of data
' 06 = data
' 0E 41 = CRC
' 16 = Stop
strCmd = "55 84 00 01 20 00 00 05 01 06 0E 41 16"
Call SIRTSendTransparent(strCmd, strOutputhex)
PrintStatus "SIRT WUP length=6"
WriteToLog "SIRT WUP length=6 SendTransparent(" & strCmd & ") " & ", Antwort: " & strOutputhex
End Sub
Private Sub cmdActFlow_Click()
Call SetActivationByFlowThreshold
End Sub
Private Sub cmdClearPamReg_Click()
ClearPamregister
End Sub
Private Sub ShowErgebnis()
Unload frmeRegisterErgebnis
Set frmeRegisterErgebnis.m_colEinbauplatz = Me.m_colEinbauplatz
frmeRegisterErgebnis.Show vbNormal, Me
frmeRegisterErgebnis.ShowErgebnis
End Sub
Private Sub cmdErgebnis_Click()
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim eRegister As CeRegister
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
' Daten neu laden
Pruefzaehler.getAuftragPositionSerienNr.load Pruefzaehler.getSerienNr
Set eRegister = New CeRegister
Set Einbauplatz.eRegister = eRegister
Einbauplatz.eRegister.m_strAbbruch_Fehler = "jdkjkdjkdjkd dkj dkjkd kdj kd kjd kjd kjd kjd dkjkdjkjdkjdk d" & vbCrLf & "kdlkdlkld dkdlkldkl dlk dl dlk dkldkl kdl ld lkdlk dlkd kl lkd dlk ldk ld ld ldl dl " & vbCrLf
' Select Case Einbauplatz.getNr
' Case 5
'
' ' Hydraulische Prüfung fehlerhaft
' Pruefzaehler.getAuftragPositionSerienNr.setStatusFertigung 25
' ' Prüfungsabschluss fehlerhaft
' Set Einbauplatz.eRegister_inactive = Einbauplatz.eRegister
' Set Einbauplatz.eRegister = Nothing
' eRegister.m_StateClosed = False
' eRegister.m_strAbbruch_Fehler = "Fehler bei Bla Bla"
' Case 4
' Pruefzaehler.getAuftragPositionSerienNr.setStatusFertigung 30
'
' ' Prüfungsabschluss
' eRegister.loadForSerienNr Pruefzaehler.getSerienNr
' eRegister.m_dGeschlossenDatum = Now
' eRegister.m_dFunkadresseDatum = Now
' eRegister.m_StateClosed = True
' End Select
End If
Next
ShowErgebnis
End Sub
Public Function ErmittelQOeffnen() As Boolean
frmOeffnenSchliessen.Visible = True
frmOeffnenSchliessen.Top = MSFlexGrid1.Top + MSFlexGrid1.Height - frmOeffnenSchliessen.Height
frmOeffnenSchliessen.Left = MSFlexGrid1.Left + MSFlexGrid1.Width - frmOeffnenSchliessen.Width
lblAufZu(1).caption = ""
lblAufZu(2).caption = ""
lblAufZu(3).caption = ""
lblAufZu(4).caption = ""
m_Verbundzaehler_Pruefmodus = OEFFNEN
StartOptoEmpfang
WarteAufWeiterButton "Weiter"
StopOptoEmpfang
frmOeffnenSchliessen.Visible = False
ErmittelQOeffnen = Not m_blnAbbruch
End Function
Public Function ErmittelQSchliessen() As Boolean
frmOeffnenSchliessen.Visible = True
frmOeffnenSchliessen.Top = MSFlexGrid1.Top + MSFlexGrid1.Height - frmOeffnenSchliessen.Height
frmOeffnenSchliessen.Left = MSFlexGrid1.Left + MSFlexGrid1.Width - frmOeffnenSchliessen.Width
lblAufZu(1).caption = ""
lblAufZu(2).caption = ""
lblAufZu(3).caption = ""
lblAufZu(4).caption = ""
m_Verbundzaehler_Pruefmodus = SCHLIESSEN
StartOptoEmpfang
WarteAufWeiterButton "Weiter"
StopOptoEmpfang
frmOeffnenSchliessen.Visible = False
ErmittelQSchliessen = Not m_blnAbbruch
End Function
Private Sub cmdOeffnen_Click()
ErmittelQOeffnen
End Sub
Private Sub cmdSchliessen_Click()
ErmittelQSchliessen
End Sub
Private Sub cmdPowerlevel_Click()
ChangePowerLevel
End Sub
''Private Function SendTransparent(cmdHex As String, ByRef ResponseHex As String) As Long
'' Dim lngLengthAck As Byte
'' Dim arbytes() As Byte
'' Dim objWrapper As SIRTCOM.Wrapper
'' Dim ret As Long
'' Dim i As Integer
''
''
'' Set objWrapper = New SIRTCOM.Wrapper
'' SendTransparent = objWrapper.SendTransparent(Replace(cmdHex, " ", ""), arbytes, lngLengthAck)
''
'' ResponseHex = ""
'' For i = 0 To lngLengthAck - 1
'' ResponseHex = ResponseHex & Right("0" & Hex(arbytes(i)), 2) & " "
'' Next
''
''' Rückgabewert SendTransparent
'''#define SIRT_DLL_ACK 0
'''#define SIRT_ERROR_USB_BLUETOOTH_FAILURE 1
'''#define SIRT_ERROR_DEVNAME_ACCCODE_NOMATCH 2
'''#define SIRT_ERROR_BUP_OR_SEMI_STACKEMPTY 3
'''#define SIRT_ERROR_BUP_OR_SEMI_STACKOVERFLOW 4 /* no way to report that to application */
'''#define SIRT_ERROR_NOMORE_SEMI_INSTACK 5
'''#define SIRT_ERROR_PAM_STACK_FULL 6
'''#define SIRT_ERROR_PAM_STACK_EMPTY 7 /* no way/need to report that to application */
'''#define SIRT_ERROR_CRC_FAILURE 8
'''#define SIRT_ERROR_TIMEOUT 9
'''#define SIRT_ERROR_NOT_OPEN 10
'''#define SIRT_ERROR_ALREADY_OPEN 11
'''#define SIRT_ERROR_WRITE_FAILED 12
'''#define SIRT_ERROR_READ_ERROR 13
'''#define SIRT_ERROR_OUTOFMEMORY 14
''
''End Function
'Private Sub cmdHinzu_Click()
' Dim strAdresse As String
' Dim Einbauplatz As CEinbauplatz
'
' Dim objPAM As SIRTCOM.PAM
' Dim strCMDHex As String
'
' m_PAMZeile = 1
' strAdresse = "319995022" 'Right(InputBox("Funkadresse"), 10)
'
' Set Einbauplatz = m_colEinbauplatz(4)
'
' Dim Pruefzaehler As CPruefzaehler
'
' Set Pruefzaehler = New CPruefzaehler
' Einbauplatz.setPruefzaehler Pruefzaehler
'
' Set Einbauplatz.eRegister = New CeRegister
' Einbauplatz.eRegister.m_StateClosed = True
' Einbauplatz.eRegister.m_sRadioAdress = strAdresse
'
' strCMDHex = "0000" & ProvideAuthLevelHexCommand(3)
'
' strCMDHex = Hex2(Len(strCMDHex) / 2) & strCMDHex
' Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
' Einbauplatz.eRegister.m_bUseKey = True
' Einbauplatz.eRegister.m_sKeyHex = FUNKSCHLUESSEL_SENSUS_STANDARD
' Call Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("Wakeup", 20)
'
' Sende_LED True, False
' StartOptoEmpfang
' Sleep 5000, True
' StopOptoEmpfang
' Sende_LED False, False
' GoSleepWUPIV
'
'End Sub
Private Sub cmdRelease_Click()
ReleaseSIRT
End Sub
Private Sub cmdSetDateTime_Click()
SetDateTime
End Sub
Private Function Convert_eRegisterTime_To_vbdate(curSecondsSince2000 As Currency) As Date
Dim dblValue As Double
' Eingabe: eRegister 4 Byte (stelliger Hex Wert) Datumsformat: curSecondsSince2000 in Sekunden seit 1.1.2000
' Umwandlung in Minuten seit 1.1.2000:
dblValue = curSecondsSince2000 / 60
' Umwandlung in Stunden seit 1.1.2000:
dblValue = dblValue / 60
' Umwandlung in Tagen seit 1.1.2000:
dblValue = dblValue / 24
' Umwandlung in Tagen seit 1.1.0100 = vb Date Format
Convert_eRegisterTime_To_vbdate = dblValue + DateSerial(2000, 1, 1)
End Function
Private Function Convert_vbDate_To_eRegisterSeconndsSince2000(vbDaysSince18991230 As Date) As Currency
' Eingabe: vb6 Double Wert Datumsformat: vbDaysSince18991230 in Tagen seit 1.1.0100 (36526 Tage mehr)
' Umwandlung in Tagen seit 1.1.2000:
Convert_vbDate_To_eRegisterSeconndsSince2000 = vbDaysSince18991230 - DateSerial(2000, 1, 1)
' Umwandlung in Stunden seit seit 1.1.2000:
Convert_vbDate_To_eRegisterSeconndsSince2000 = Convert_vbDate_To_eRegisterSeconndsSince2000 * 24
' Umwandlung in Minuten seit 1.1.2000:
Convert_vbDate_To_eRegisterSeconndsSince2000 = Convert_vbDate_To_eRegisterSeconndsSince2000 * 60
' Umwandlung in Sekunden seit 1.1.2000:
Convert_vbDate_To_eRegisterSeconndsSince2000 = Convert_vbDate_To_eRegisterSeconndsSince2000 * 60
End Function
Private Function SetDateTime() As Boolean
Dim Einbauplatz As CEinbauplatz
Dim eRegister As CeRegister
Dim eRegister_Auftragposition As CeRegister_Auftragposition
Dim dblValue As Double
Dim strCMDHex As String
Dim objPAM As PAM
Dim Diff_Utc As Double
Dim datZeit As Date
Dim datZeitKontrolle As Date
Dim curValue As Currency
Dim curAbweichung As Currency
Dim ret As Long
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "DateTime"
Wiederholung:
datZeit = 0
For Each Einbauplatz In m_colEinbauplatz
strCMDHex = ""
If Not Einbauplatz.eRegister Is Nothing Then
Set eRegister = Einbauplatz.eRegister
Set eRegister_Auftragposition = eRegister.mobj_eRegister_Auftragposition
If eRegister.m_StateClosed = False Then
If Not eRegister_Auftragposition Is Nothing Then
' Abweichung von UTC in Stunden laut Auftragspositiob (Für Deutschland = +2)
Diff_Utc = eRegister_Auftragposition.getUtcOffset()
WriteToLog "Ebp " & Einbauplatz.getNr & ": Abweichung von UTC=" & Diff_Utc & " Stunden"
' aktuelle Orts-Zeit nur einmal ermitteln damit für alle EInbaplätze gleich
If datZeit = 0 Or curValue = 0 Then
' aktuelle Zeit an diesem Ort ist UTC + DiffUtc (in Tagen)
datZeit = UTCTime() + Diff_Utc / 24
' Umwandlung des vb-Datums in eRegister Sekunden seit 1.1.2000
curValue = Val(Convert_vbDate_To_eRegisterSeconndsSince2000(datZeit))
WriteToLog " Ortszeit: " & Format(datZeit, "dd.mm.yyyy hh:mm:ss") & " = " & curValue & " Sekunden seit 1.1.2000"
End If
strCMDHex = "32" & Hex8(curValue)
strCMDHex = Hex2(Len(strCMDHex) / 2) & strCMDHex
End If
End If
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
End If
Next
SetDateTime = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("DateTime")
If SetDateTime = False Then Exit Function
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.eRegister Is Nothing Then
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
Set objPAM = mSIRTStatemashine.GetPAM(Einbauplatz.getNr)
If Not objPAM Is Nothing Then
' Zeit in Sekunden seit 1.1.2000:
datZeitKontrolle = Convert_eRegisterTime_To_vbdate(objPAM.SEMI.Actual_date_and_time)
Debug.Print "eingeschrieben : " & Format(datZeit, "dd.mm.yyyy hh:mm:ss")
Debug.Print "Ausgelesen : " & Format(datZeitKontrolle, "dd.mm.yyyy hh:mm:ss")
curAbweichung = Round((datZeitKontrolle - datZeit) * 24 * 60 * 60)
Debug.Print " Differenz: " & curAbweichung & " Sekunden"
' eine paar Minuten Abweichung zulassen
If Abs(curAbweichung) > 120 Then
MsgBox "Einbauplatz: " & Einbauplatz.getNr & " Die Abweichung zw. programmierter und ausgelesener Zeit beträgt " & curAbweichung & " Sekunden!"
MSFlexGrid1.text = "Abw." & Abs(curAbweichung) & " sek"
MSFlexGrid1.CellBackColor = vbRed Or 8421504
' Es ist etwas schiefgelaufen
SetDateTime = False
End If
End If
End If
Next
If SetDateTime = False Then
ret = MsgBox("Möchten Sie den SetTimeDate PAM Befehl für alle eRegister Werke wiederholen?" & vbCrLf & "'Abbruch' bricht die Prüfung ab," & vbCrLf & "mit 'Nein' wird fortgefahren.", vbYesNoCancel Or vbDefaultButton1, "manueller Abbruch des PAM-Befehls SetTimeDate")
Select Case ret
Case vbYes
' Wiederholen
GoTo Wiederholung
Case vbNo
' Weitermachen
SetDateTime = True
Case vbCancel
' Abbrechen
SetDateTime = False
Exit Function
End Select
End If
End Function
Private Function getSIRTCOMVersion() As String
Dim Version As String
On Error GoTo Errorhandler
Version = mSIRTStatemashine.GetCOMVersion
getSIRTCOMVersion = Val(Split(Version, ".")(0)) + Val(Split(Version, ".")(1)) / 10
Exit Function
Errorhandler:
MsgBox "Die installierte SIRTCOM dll unterstützt noch nicht die Funktion 'GetCOMVersion()'. Diese ist erst ab Version 0.2 vorhanden. Installieren sie die neuste Version der SIRTCOM dll!"
End Function
Public Sub Aktualisiere_PAM_Status()
Dim Einbauplatz As CEinbauplatz
Dim PAM As SIRTCOM.PAM
Dim strStatus As String
If mSIRTStatemashine Is Nothing Then Exit Sub
MSFlexGrid1.row = Me.MSFlexGrid1.Rows - 1
'SetFlexgridRow m_PAMZeile, MSFlexGrid1, ""
MSFlexGrid1.row = MSFlexGrid1.Rows - 1
DoEvents
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.eRegister Is Nothing Then
MSFlexGrid1.col = Einbauplatz.getNr
If Einbauplatz.eRegister.m_sNaechsterPAMBefehl = "" Then
' hier ist kein PAM Befehl gesendet worden
Else
Set PAM = mSIRTStatemashine.GetPAM(Einbauplatz.getNr)
If Not PAM Is Nothing Then
PamStateSelect:
Select Case PAM.State
Case 1 'an SIRT gesendet
MSFlexGrid1.CellBackColor = vbRed Or 8421504
MSFlexGrid1.text = "send (" & PAM.CountBup & ")"
If PAM.CountBup > 50 And Not Ist_Eine_PAM_noch_im_PAM_Register() Then
strStatus = "Die PAM am Ebp " & Einbauplatz.getNr & " wurde an das SIRT gesendet aber nicht vom SIRT bearbeitet und das PAM-Register ist leer. Möglicherweise liegt hier eine Störung im SIRT vor."
PrintStatus strStatus
MsgBox (strStatus)
PAM.State = PAMStates_Timeout
End If
If PAM.GetTime > mSIRTStatemashine.Timeout_s Then
PAM.State = PAMStates_Timeout
GoTo PamStateSelect
End If
Case 2 ' ist im PAM Register
If PAM.GetTime > mSIRTStatemashine.Timeout_s Then
PAM.State = PAMStates_Timeout
GoTo PamStateSelect
End If
MSFlexGrid1.text = "PamReg(" & PAM.GetTime & "," & PAM.CountBup & ")"
If PAM.CountBup = 0 Then
MSFlexGrid1.CellBackColor = RGB(255, 240, 128)
Else
MSFlexGrid1.CellBackColor = vbYellow Or 8421504
End If
Case 3 ' SEMI empfangen
If Not PAM.SEMI Is Nothing Then
MSFlexGrid1.CellBackColor = vbGreen Or 8421504
MSFlexGrid1.text = "OK (" & PAM.GetTime & "," & PAM.CountBup & ")"
End If
Case 4 ' BUP von neuer Adresse = Adresse geändert
MSFlexGrid1.CellBackColor = vbGreen Or 8421504
MSFlexGrid1.text = "OK (" & PAM.GetTime & "," & PAM.CountBup & ")"
If Val(PAM.Zieladresse) > 0 And PAM.ChangeAdresse = True Then
' workaround: Wenn eine BUP wiederholt von neuer Adresse empfangen wurde
' braucht diese nicht mehr aus dem PAM Register gelöscht werden
PAM.Zieladresse = "0"
End If
Case 5
MSFlexGrid1.CellBackColor = vbRed Or 8421504
MSFlexGrid1.text = "Timeout(" & PAM.GetTime & "," & PAM.CountBup & ")"
Case 6
MSFlexGrid1.CellBackColor = vbRed Or 8421504
If PAM.P12 <> 0 Then
MSFlexGrid1.text = "ERR P12=" & PAM.P12
Else
MSFlexGrid1.text = "ERR "
End If
End Select
End If ' PAM is nothing
End If ' Einbauplatz.eRegister Is Nothing
End If 'Einbauplatz.eRegister Is Nothing
Next ' EInbauplatz
End Sub
Private Sub PruefzeitAnpassen(Einbauplatz As CEinbauplatz)
On Error GoTo Errorhandler
Dim eRegister_Auftragposition As CeRegister_Auftragposition
Dim dblMindestVolumen As Double
Dim dblMindestZeit As Double
' Die Prüfzeit für den aktuellen Prüfpunkt wird angepasst
Set eRegister_Auftragposition = New CeRegister_Auftragposition
If Einbauplatz.getPruefzaehler Is Nothing Then Exit Sub
If Einbauplatz.getPruefzaehler.getAuftragPosition Is Nothing Then Exit Sub
If eRegister_Auftragposition.LoadForFertigungsAuftragNr(Einbauplatz.getPruefzaehler.getAuftragPosition.GetFertigungsauftragNr) Then
' 32 Pulse * 0.625 Liter/Puls = 20 Liter
dblMindestVolumen = eRegister_Auftragposition.mdblVolume_Per_puls * 32 ' in ml
dblMindestVolumen = dblMindestVolumen / 1000 ' in Liter
dblMindestVolumen = dblMindestVolumen / 1000 ' in m³
dblMindestZeit = dblMindestVolumen / m_dblSolldurchfluss ' in Stunden
dblMindestZeit = dblMindestZeit * 3600 ' in Sekunden
If m_lSollPruefzeit_s < dblMindestZeit Then
' Prüfzeit wird nach oben angepasst
PrintStatus "Die Prüfzeit für diesen Prüfpunkt wird von " & m_lSollPruefzeit_s & " sek nach oben auf " & Round(dblMindestZeit + 1) & " sek angepasst (2 Umdrehungen der Magnetkuplung)."
m_lSollPruefzeit_s = Round(dblMindestZeit + 1)
End If
Else
Exit Sub
End If
Exit Sub
Errorhandler:
ErrorMsg "Fehler " & Err.Number & " in PruefzeitAnpassen() " & Err.Description
Exit Sub
Resume
End Sub
Public Function OptoMessung_durchfuehren() As Boolean
Dim ret As Long
Dim i As Integer
'Me.caption = "Pruef2000 eRegister Prüfung"
Wiederholen:
MSFlexGridRZ.Clear
MSFlexGridRZ.FormatString = "Referenz"
Me.caption = FORMCAPTION & " Prüfpunkt " & Format(m_dblSolldurchfluss, "0.0###") & " m³/h"
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
MSFlexGrid1.TextMatrix(fgZeile.Zeile_Pz_Timestamp, Einbauplatz.getNr) = ""
MSFlexGrid1.TextMatrix(fgZeile.Zeile_Pz_Volume, Einbauplatz.getNr) = ""
If Not Einbauplatz.eRegister Is Nothing Then
' neu RH 02.05.2016
PruefzeitAnpassen Einbauplatz
End If
End If
Next
Call ResetMesswertAnzeige
OptoMessung_durchfuehren = True
If IsInIDE() And g_ohneSPS And g_App.PruefstationNr = 2099 Then
' Simulation einer Messung in der IDE
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "Messung " & m_dblSolldurchfluss
AutoSpaltenBreite MSFlexGrid1, lblAutosize
ScrolleNachUnten
OptoMessung_durchfuehren = True
Exit Function
End If
If OptoMessung_durchfuehren = False Then Exit Function
Sleep 1000, True
' Referenzzähler laden und RZ Daten anzeigen
OptoMessung_durchfuehren = PruefungVorbereiten()
If OptoMessung_durchfuehren = False Then Exit Function
WdhMessung:
' Prüfung starten: FM-Impulszählung starten, eRegister Startwerte festhalten
OptoMessung_durchfuehren = StartPruefung()
If OptoMessung_durchfuehren = False Then Exit Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' verbleibende Referenzzählerimpulse herunterzählen
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Not ZaehleRefZImpulseRueckwaerts() Then
' Fehler
OptoMessung_durchfuehren = False
Exit Function
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' keine verbleibenden Referenzzählerimpulse, Messung beenden
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' alle COM Ports öffnen
'add for genesis
If Calibration Then
GenesisBatch.MetersStopCalibration
Else
GenesisBatch.MetersStopMeasurement
End If
If m_Verbundzaehler_Pruefmodus = EINZELN Then
' stoppe Prüfung
OptoMessung_durchfuehren = StopPruefung()
Else
OptoMessung_durchfuehren = StopPruefungVerbundzaehler()
End If
AutoSpaltenBreite MSFlexGrid1, lblAutosize
ScrolleNachUnten
SleepWithEvents 5000, True
End Function
Private Sub FillCmbRegulierPruefzeit()
Dim i As Integer
cmbRegulierPruefzeit.Clear
For i = 1 To 60
cmbRegulierPruefzeit.AddItem i
If i = 15 Then
cmbRegulierPruefzeit.ListIndex = cmbRegulierPruefzeit.ListCount - 1
End If
Next
End Sub
Public Function Regulierung_durchfuehren(Optional ByRef strPruefzeit = "") As Boolean
Me.Visible = True
FrameRegulierung.Visible = True
frmRegulierungErgebnisse.Visible = True
SetupDisplay
Me.caption = Me.caption = FORMCAPTION & " Regulierung"
FillCmbRegulierPruefzeit
If Val(strPruefzeit) > 0 Then
cmbRegulierPruefzeit.text = strPruefzeit
End If
' Abbruch zulassen
m_blnAbbruch = False
cmdCancel.Enabled = True
PrintStatus "Starte Regulierung"
'''''''''''''''''''''''''''''''''''''''''''
' Event Button-Klick "Messung" zulassen
cmdRegulierungMessung.Enabled = True
' Schleife bis weiter Taste
WarteAufWeiterButton ("Weiter m. Prüfung")
''''''''''''''''''''''''''''''''''''''''''''
FrameRegulierung.Visible = False
Regulierung_durchfuehren = Not m_blnAbbruch
frmRegulierungErgebnisse.Visible = False
End Function
Private Sub StopOptoEmpfang()
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim strError As String
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
CloseComPort (Einbauplatz.getNr)
End If
Next
m_blnCounterChangeDetection = False
End Sub
' öffnet für alle belegten Einbauplätze den zugehörigen COM Port
Private Function StartOptoEmpfang(Optional blnZurPruefung As Boolean = False) As Boolean
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim strError As String
Dim ret As Long
Dim intCOMPort As Integer
PrintStatus "Starte Opto Empfang"
m_blnCounterChangeDetection = blnZurPruefung
wdh:
StartOptoEmpfang = True
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
Set Pruefzaehler = Einbauplatz.getPruefzaehler
MSFlexGrid1.col = Einbauplatz.getNr
m_sErsterZaehlerstand(Einbauplatz.getNr) = "" 'zurücksetzen, wird für ChangeDetection benötigt
If blnZurPruefung Then
' Wenn der Optoempfang zur Prüfung geöffnet wird, werden nur die Einbauplätze geöffnet,
' bei denenen der Einbauplatz nicht deaktiviert wurde
If Einbauplatz.eRegister Is Nothing Then
' Einbauplatz wurde deaktiviert
' Hier dürfte der COM Port NICHT geöffnet werden
GoTo Einsprung_naechster_Ebp
End If
End If
' CRC Feld löschen
mstrBuffer(Einbauplatz.getNr) = ""
MSFlexGrid1.TextMatrix(Zeile_Pz_CRCFehler, Einbauplatz.getNr) = ""
intCOMPort = Val(g_App.Settings.getUSComPort(Einbauplatz.getNr))
If intCOMPort > 0 Then
If OpenComPort(Einbauplatz.getNr, strError) Then
PrintStatus "COM-Port " & intCOMPort & " an Ebp " & Einbauplatz.getNr & " wurde geöffnet."
MSFlexGrid1.TextMatrix(Zeile_Pz_COM, Einbauplatz.getNr) = intCOMPort & " open"
Else
PrintStatus "Fehler beim Öffnen vom Comport " & intCOMPort & ": " & strError
MSFlexGrid1.TextMatrix(Zeile_Pz_COM, Einbauplatz.getNr) = intCOMPort & " error"
ret = MsgBox("Fehler beim Öffnen vom Comport " & intCOMPort & " für Einbauplatz " & Einbauplatz.getNr & " : " & vbCrLf & strError & vbCrLf & " Möchen Sie die Prüfung abbrechen, das Öffnen der COMPorts wiederholen oder den Fehler ignorieren und mit den restlichen Zählern forfahren?", vbAbortRetryIgnore)
Select Case ret
Case vbIgnore
Einbauplatz.setPruefzaehler Nothing
Case vbRetry
GoTo wdh
Case vbCancel
StartOptoEmpfang = False
Exit Function
End Select
End If
SetFlexgridRow Zeile_Pz_SerienNr, MSFlexGrid1, "SerienNr"
If Not Einbauplatz.getPruefzaehler Is Nothing Then
MSFlexGrid1.text = Einbauplatz.getPruefzaehler.getSerienNr
Else
MSFlexGrid1.text = " - "
End If
Else
PrintStatus "COM Port für Einbauplatz " & Einbauplatz.getNr & " ist nicht definiert."
MSFlexGrid1.text = " n.def "
End If
Else
End If
Einsprung_naechster_Ebp:
Next
AutoSpaltenBreite MSFlexGrid1, lblAutosize
End Function
Private Sub SetupDisplay()
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
If Not m_Display Is Nothing Then
m_Display.Adressierung 255
Sleep 100
m_Display.Licht 1
m_Display.EaKitOutput Chr(27) & "YA0" ' ESC + PortMakros deaktivieren
m_Display.ClrScreen
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
m_Display.Adressierung Einbauplatz.getNr
Sleep 100
m_Display.PlaceEinbauplatz CStr(Einbauplatz.getNr)
If Not Pruefzaehler Is Nothing Then
' Diplay mit der SerienNr aktualisieren
m_Display.PlaceSeriennr Einbauplatz.getPruefzaehler.getSerienNr
If Not Einbauplatz.eRegister Is Nothing Then
Sleep 100
m_Display.PlaceAusgabe "Adresse: " & Einbauplatz.eRegister.m_sRadioAdress, 10, 30, 140, 39
End If
Else
m_Display.PlaceAusgabe "KEIN Zaehler!", 10, 20, 140, 29 ' Feld SerienNr
End If
Next
End If
End Sub
Public Sub Service()
Dim strPruefzeit As String
Me.Visible = True
m_dblSolldurchfluss = CDbl(Replace(InputBox("Soll Durchfluss in m³/h"), ".", ","))
FrameRegulierung.Visible = True
frmRegulierungErgebnisse.Visible = True
lblAufZu(1).caption = ""
lblAufZu(2).caption = ""
lblAufZu(3).caption = ""
lblAufZu(4).caption = ""
SetupDisplay
frmOeffnenSchliessen.Visible = True
' unten
frmOeffnenSchliessen.Top = MSFlexGrid1.Top + MSFlexGrid1.Height - frmOeffnenSchliessen.Height
' rechts
frmOeffnenSchliessen.Left = MSFlexGrid1.Left + MSFlexGrid1.Width - frmOeffnenSchliessen.Width
Me.caption = Me.caption = FORMCAPTION & " Regulierung"
FillCmbRegulierPruefzeit
If Val(strPruefzeit) > 0 Then
cmbRegulierPruefzeit.text = strPruefzeit
End If
' Abbruch zulassen
m_blnAbbruch = False
cmdCancel.Enabled = True
m_Verbundzaehler_Pruefmodus = OEFFNEN
StartOptoEmpfang
'''''''''''''''''''''''''''''''''''''''''''
' Event Button-Klick "Messung" zulassen
cmdRegulierungMessung.Enabled = True
' Schleife bis weiter Taste
WarteAufWeiterButton ("Weiter m. Prüfung")
''''''''''''''''''''''''''''''''''''''''''''
StopOptoEmpfang
FrameRegulierung.Visible = False
frmRegulierungErgebnisse.Visible = False
frmOeffnenSchliessen.Visible = False
End Sub
Private Sub SetupForm()
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim strError As String
MSFlexGrid1.Clear
MSFlexGrid1.Cols = 11
MSFlexGrid1.Rows = Zeile_PZ_Ende
MSFlexGrid1.FixedRows = 5
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
MSFlexGrid1.col = Einbauplatz.getNr
SetFlexgridRow Zeile_Pz_Platz, MSFlexGrid1, "Einbauplatz"
MSFlexGrid1.text = Einbauplatz.getNr
SetFlexgridRow Zeile_Pz_COM, MSFlexGrid1, "COM"
MSFlexGrid1.text = Val(g_App.Settings.getUSComPort(Einbauplatz.getNr))
If Not Pruefzaehler Is Nothing Then
If m_iErsterBelegterEinbauplatz = 0 Then
m_iErsterBelegterEinbauplatz = Einbauplatz.getNr
End If
SetFlexgridRow Zeile_Pz_SerienNr, MSFlexGrid1, "SerienNr"
MSFlexGrid1.text = Einbauplatz.getPruefzaehler.getSerienNr
End If
Next
MSFlexGridRZ.Clear
MSFlexGridRZ.Cols = 2
MSFlexGridRZ.FormatString = "Referenz"
MSFlexGridRZ.Rows = 1
AutoSpaltenBreite MSFlexGridRZ, lblAutosize
AutoSpaltenBreite MSFlexGrid1, lblAutosize
End Sub
Private Sub CloseComPort(EinbauplatzNr As Integer)
If MSComm1.Item(EinbauplatzNr).PortOpen = True Then
MSComm1.Item(EinbauplatzNr).PortOpen = False
MSFlexGrid1.TextMatrix(Zeile_Pz_COM, EinbauplatzNr) = MSComm1.Item(EinbauplatzNr).CommPort
End If
End Sub
Private Function OpenComPort(EinbauplatzNr As Integer, ByRef strError As String) As Boolean
Dim intCOMPort As Integer
On Error GoTo Errorhandler
With MSComm1(EinbauplatzNr)
If .PortOpen = True Then
.PortOpen = False
End If
intCOMPort = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
If intCOMPort = 0 Then
OpenComPort = False
Exit Function
End If
.CommPort = intCOMPort
.Handshaking = comNone
.RThreshold = 25 '25 '25 ' bei x Zeichen das receiveEvent feuern
.InBufferSize = 1024
' .RTSEnable = False
' .DTREnable = False
' .EOFEnable = False
.Settings = "9600,n,8,1"
'.SThreshold = 1
.PortOpen = True
End With
OpenComPort = True
Exit Function
Errorhandler:
OpenComPort = False
strError = Err.Description
If Err.Number = 8005 Then
' ist schon offen
PrintStatus "Warnung beim Öffnen des COM Ports an Einbauplatz " & EinbauplatzNr & ": " & strError
Exit Function
End If
PrintStatus "Fehler beim Öffnen des COM Ports an Einbauplatz " & EinbauplatzNr & ": " & strError
End Function
Private Sub ScrolleNachUnten()
Dim Top As Integer
On Error GoTo Errorhandler
' Aktualisierung bis zum Ende dieser Funktion verhindern
MSFlexGrid1.Redraw = False
Do
' TopRow auslesen
Top = MSFlexGrid1.TopRow
If MSFlexGrid1.TopRow + 1 < MSFlexGrid1.Rows Then
' wenn TopRow noch nicht letzte Zeile ist
' Problematisch
MSFlexGrid1.TopRow = MSFlexGrid1.TopRow + 1
End If
If MSFlexGrid1.TopRow = Top Then
' Schleife verlassen, da sich Top Row nicht mehr ändert
Exit Do
End If
Loop While MSFlexGrid1.TopRow < MSFlexGrid1.Rows - 1
MSFlexGrid1.Redraw = True
Exit Sub
Errorhandler:
MSFlexGrid1.Redraw = True
End Sub
Private Sub SetFlexgridRow(row As Integer, Fg As MSFlexGrid, strLabel As String)
' aktuelle Zeile row
If Fg.Rows - 1 < row Then
' ist eine neue Zeile
Fg.Rows = row + 1
End If
Fg.row = row
If strLabel <> "" Then
Fg.TextMatrix(row, 0) = strLabel
End If
'letzte Zeile muss sichtbar sein
' Problematisch
' ScrolleNachUnten
End Sub
Private Sub TestFlexgrid()
' Dim intRow As Integer
' intRow = 0
' Do
' Sleep 100, True
' SetFlexgridRow intRow, MSFlexGrid1, "Zeile " & intRow
' AutoSpaltenBreite MSFlexGrid1, lblAutosize
' intRow = intRow + 1
' Loop While Not m_blnAbbruch
MSFlexGrid1.AddItem "test"
ScrolleNachUnten
End Sub
Private Sub PrintStatus(strText As String)
' Debug.Print strText
DebugMsg strText
txtOut.text = txtOut.text & strText & vbCrLf
txtOut.SelStart = Len(txtOut.text)
txtOut.SelLength = 0
End Sub
Public Function PruefungVorbereiten() As Boolean
Dim dblSollvolumen As Double
Dim lngVerbleibendeImpulse As Long
Dim strAntwort As String
Dim ret As Long
If m_dblSolldurchfluss = 0 Then
AutoSpaltenBreite MSFlexGridRZ, lblAutosize
MsgBox "Fehler: Solldurchfluss ist 0!"
PruefungVorbereiten = False
Exit Function
End If
' Referenzähler laden
Set m_Referenzzaehler = New CRefzaehler
m_Referenzzaehler.loadForDurchfluss m_dblSolldurchfluss, g_App.Settings.getMIDGruppe
' Referenzähler Nennweite anzeigen
SetFlexgridRow fgRZZeile.Zeile_Rz_NW, MSFlexGridRZ, "Nennweite"
MSFlexGridRZ.TextMatrix(MSFlexGridRZ.row, 1) = m_Referenzzaehler.Nennweite
' Referenzähler Impulswertigkeit anzeigen
'SetFlexgridRow fgRZZeile.Zeile_Rz_Impulswertigkeit, MSFlexGridRZ, "Impulswertigkeit [Imp/m³]"
SetFlexgridRow fgRZZeile.Zeile_Rz_Impulswertigkeit, MSFlexGridRZ, "Impulswertigkeit"
MSFlexGridRZ.TextMatrix(MSFlexGridRZ.row, 1) = m_Referenzzaehler.ImpulseQM
PrintStatus "Impulswertigkeit RZ: " & m_Referenzzaehler.ImpulseQM & " Imp/m³"
' Solldurchfluss anzeigen
SetFlexgridRow fgRZZeile.Zeile_Rz_SollDurchfluss, MSFlexGridRZ, "Q soll [m³/h]"
MSFlexGridRZ.TextMatrix(MSFlexGridRZ.row, 1) = m_dblSolldurchfluss
PrintStatus "nächster Durchfluss " & m_dblSolldurchfluss & " m³/h"
' Sollprüfzeit anzeigen
SetFlexgridRow fgRZZeile.Zeile_Rz_SollPruefzeit, MSFlexGridRZ, "T soll [s]"
MSFlexGridRZ.TextMatrix(MSFlexGridRZ.row, 1) = m_lSollPruefzeit_s
PrintStatus "Soll Prüfzeit: " & m_lSollPruefzeit_s & " s"
' Referenzähler Fehler anzeigen
m_dblRefZfehler = m_Referenzzaehler.letzterFehler(m_dblSolldurchfluss)
PrintStatus "Fehler des RefZ: " & Round(m_dblRefZfehler, 4) & " %"
SetFlexgridRow fgRZZeile.Zeile_Rz_FehlerInQ, MSFlexGridRZ, "RZ Fehler [%]"
MSFlexGridRZ.TextMatrix(MSFlexGridRZ.row, 1) = Round(m_dblRefZfehler, 2)
AutoSpaltenBreite MSFlexGridRZ, lblAutosize
PruefungVorbereiten = True
End Function
Public Function TestProgressBar()
Dim i As Integer
ProgressBar1.Visible = True
ProgressBar1.Max = 100
For i = 100 To 1 Step -1
ProgressBar1.value = i
SleepWithEvents 500, True
Next
ProgressBar1.Visible = False
End Function
Public Function ZaehleRefZImpulseRueckwaerts() As Boolean
Dim strAntwort As String
Dim lngVerbleibendeImpulse As Long
Dim dblSekunden As Double
m_blnAbbruch = False
' Warten bis keine verbleibenden Imulse beim RZ
Do
' Anforderung der verbleibenden Impulse
m_FMBus.send "J"
strAntwort = m_FMBus.receive(500)
If strAntwort <> "" Then
lngVerbleibendeImpulse = Hex2Long(strAntwort)
If lngVerbleibendeImpulse < ProgressBar1.Max Then
ProgressBar1.value = lngVerbleibendeImpulse
dblSekunden = lngVerbleibendeImpulse / ProgressBar1.Max * m_lSollPruefzeit_s
StatusBar1.SimpleText = Format(Now, "dd.mm.yyyy hh:mm:ss") & " Verbleibendend: " & Format(dblSekunden / 60 / 60 / 24, "hh:mm:ss") & ". Beendet um " & Format(Now + dblSekunden / 60 / 60 / 24, "hh:mm:ss")
End If
SetFlexgridRow Zeile_Rz_VerbleibendeImpulse, MSFlexGridRZ, "Verbleib. Imp"
MSFlexGridRZ.TextMatrix(Zeile_Rz_VerbleibendeImpulse, 1) = lngVerbleibendeImpulse
Sleep 100, True
Else
' keine Antwort
PrintStatus "Keine Antwort vom FM an Einbauplatz " & m_iErsterBelegterEinbauplatz
End If
Loop While lngVerbleibendeImpulse > 0 And m_blnAbbruch = False
ProgressBar1.Visible = False
ZaehleRefZImpulseRueckwaerts = Not m_blnAbbruch
End Function
Private Sub sendonly(strText As String)
PrintStatus "-> FM: '" & strText & "'"
m_FMBus.send (strText)
m_FMBus.receive (500)
End Sub
Private Function InitFMforRZVolumenmessung(EinbauplatzNr As Integer, AnzahlPeriodenRZ As Long) As Boolean
Dim strAntwort As String
' PrintStatus "FM85 Reset"
' m_FMBus.send "**" & EinbauplatzNr & "@"
' m_FMBus.send "R"
' Sleep 5000, True
PrintStatus "FM Ebp" & EinbauplatzNr & " Impulse=" & AnzahlPeriodenRZ & " => " & Hex(AnzahlPeriodenRZ) & "M"
m_FMBus.send "**" & EinbauplatzNr & "@"
strAntwort = m_FMBus.receive(500)
If strAntwort = "" Then
PrintStatus "FM85 an Einbauplatz " & EinbauplatzNr & ": keine Antwort"
GoTo Errorhandler
End If
m_FMBus.send Hex(AnzahlPeriodenRZ) & "M"
strAntwort = m_FMBus.receive(500)
If strAntwort <> "" Then
PrintStatus "FM85 an Einbauplatz " & EinbauplatzNr & " antwortet " & strAntwort
GoTo Errorhandler
End If
InitFMforRZVolumenmessung = True
Exit Function
Errorhandler:
InitFMforRZVolumenmessung = False
End Function
Public Function Get_eRegister_Opto_Data_After_Change(Optional blnAuchGeschlosseneWerke As Boolean = False) As Boolean
'Holt sich von jedem belegten Einbauplatz das erste Opto Datenpaket und merkt sich den Zählerstand
'Holt sich von jedem Einbauplatz weitere Opto Datenpakete und vergleicht den aktuellen Zählerstand mit dem gemerkten Zählerstand
'Wenn der Zählerstand sich erhöht hat, wird der Zählerstand noch einmal aktualisiert und der Port geschlossen
' wenn das für alle eingebauten Zhler passiert ist, wird die Fubktion verlassen
' wartet also solange, bis sich alle Zählerstände einmal erhöht haben
End Function
Public Function Get_New_eRegister_Opto_Data(Optional blnAuchGeschlosseneWerke As Boolean = False) As Boolean
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim strError As String
Dim blnReceived As Boolean
' Abbruch zuulassen
m_blnAbbruch = False
PrintStatus "Warte auf neue Opto Telegramme von allen eRegistern"
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "Opto Telegramm"
ScrolleNachUnten
Do
blnReceived = True
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
If Not Einbauplatz.eRegister Is Nothing Then
'' Select Case m_Verbundzaehler_Pruefmodus
'' Case PRUEFMODUS.NUR_HZ
'' Select Case Einbauplatz
'' Case 1, 3
''
'' Case 2, 4
'' GoTo NextEinbauplatz
'' End Select
'' Case PRUEFMODUS.NUR_NZ
'' Select Case Einbauplatz
'' Case 1, 3
'' GoTo NextEinbauplatz
'' Case 2, 4
'' End Select
'' Case Else
'' End Select
' nur auf offene Zähler warten. geschlossene Zähler senden noch keine Opto Impulse
If Einbauplatz.eRegister.m_StateClosed = False Or blnAuchGeschlosseneWerke = True Then
' nur offene Werke
If MSFlexGrid1.TextMatrix(fgZeile.Zeile_Pz_Volume, Einbauplatz.getNr) <> "" Then
' Timestamp und Volume wurden empfangen
MSFlexGrid1.text = "OK"
MSFlexGrid1.CellBackColor = RGB(128, 255, 128) ' Grün
Else
' Timestamp und Volume wurden nicht empfangen
blnReceived = False
MSFlexGrid1.CellBackColor = RGB(255, 255, 128) ' Gelb
End If
Else
' geschlossene Zähler
MSFlexGrid1.text = " - "
End If
Else
MSFlexGrid1.text = " -- "
'Einbauplatz.eRegister Is Nothing
'Werk ggf deaktiviert
End If 'Not Einbauplatz.eRegister Is Nothing
End If
NextEinbauplatz:
Next
' Events zulassen um weitere Opto Telegramme zu empfangen
SleepWithEvents 500, True
Loop While blnReceived = False And m_blnAbbruch = False
' zur Sicherheit
StopOptoEmpfang
Get_New_eRegister_Opto_Data = Not m_blnAbbruch
End Function
'' Warte, bis alle eRegister Daten gesendet haben oder Abbruch
'Public Function Wait_For_eRegister_Data() As Boolean
' Dim Einbauplatz As CEinbauplatz
' Dim Pruefzaehler As CPruefzaehler
' Dim strError As String
'
' m_blnAbbruch = False
'
' PrintStatus "Warte auf Opto Telegramme von allen eRegistern"
' Do
' Wait_For_eRegister_Data = True
' For Each Einbauplatz In m_colEinbauplatz
' Set Pruefzaehler = Einbauplatz.getPruefzaehler
' If Not Pruefzaehler Is Nothing Then
'' Debug.Print "Zähler an Einbauplatz " & Einbauplatz.getNr
' If Einbauplatz.eRegister Is Nothing Then
' ' Wenn einer noch keine Daten gesendet hat, dann ist die Bedingung nicht erfüllt
' If Wait_For_eRegister_Data = True Then
' Wait_For_eRegister_Data = False
' End If
' End If
' End If
' Next
' ' Events zulassen um weitere Opto Telegramme zu empfangen
' DoEvents
' Loop While Wait_For_eRegister_Data = False And m_blnAbbruch = False
'
' ' alle Prüfplätze haben Info gesendet oder Abbruch
'End Function
'''Public Function Get_New_OptoData_For_Every_eRegister()
''' Dim Einbauplatz As CEinbauplatz
''' Dim Pruefzaehler As CPruefzaehler
'''
''' PrintStatus "Opto Telegramme empfangen..."
'''
''' For Each Einbauplatz In m_colEinbauplatz
''' Set Pruefzaehler = Einbauplatz.getPruefzaehler
''' If Not Pruefzaehler Is Nothing Then
''' OpenComPort (Einbauplatz.getNr)
''' Sleep 1000, True
''' CloseComPort (Einbauplatz.getNr)
''' End If
''' Next
'''End Function
' Warte, bis alle eRegister Daten gesendet haben oder Abbruch
Public Function Check_For_Valid_eRegister_Data() As Boolean
Dim Einbauplatz As CEinbauplatz
Dim EinbauplatzCheck As CEinbauplatz
Dim Pruefzaehler1 As CPruefzaehler
Dim Pruefzaehler2 As CPruefzaehler
Dim strSendeneFunkadressen As String
Dim strMsg As String
Check_For_Valid_eRegister_Data = True
strSendeneFunkadressen = mSIRTStatemashine.GetBUPRadioAdresses
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler1 = Einbauplatz.getPruefzaehler
If Not Pruefzaehler1 Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
If Einbauplatz.eRegister.m_StateClosed = False Then
If Not IsNumeric(Einbauplatz.eRegister.m_sTime) Then
' Es gab da mal einen BUG bzw defekte Werke
MsgBox ("Das Werk an Einbauplatz " & Einbauplatz.getNr & " sendet über die LED keine numerischen Timestamps. Bitte tauschen Sie das Werk. Das Werk muss resettet werden, da ein Timestamp-Überlauf stattgefunden hat. Bitte verständigen Sie die Qualitätssicherung!")
Check_For_Valid_eRegister_Data = False
End If
If InStr(1, strSendeneFunkadressen, Val(Einbauplatz.eRegister.m_sRadioAdressFinal)) > 1 Then
If Val(Einbauplatz.eRegister.m_sRadioAdressFinal) <> Val(Einbauplatz.eRegister.m_sRadioAdress) Then
strMsg = "Ein anderes Werk mit der Funkadresse " & Einbauplatz.eRegister.m_sRadioAdressFinal & " sendet bereits BUPs!" & vbCrLf
strMsg = strMsg & "Um das Werk an Einbauplatz " & Einbauplatz.getNr & " verwenden zu können, stellen Sie sicher, dass kein anderes Werk diese Funkadresse benutzt."
MsgBox strMsg
Check_For_Valid_eRegister_Data = False
Else
' Die über die LED gesendete Funkadresse stimmt mit der FinalenFunkadresse des eRegisters überein, OK
End If
End If
Debug.Print Einbauplatz.getPruefzaehler.getAuftragPosition.getIdentNrObj.getTyp
' todo Überprüfen in eRegister Tabelle, ob diese Funkadresse nicht schon als Funkadresse eines ANDEREN eRegisters (PCBId, SerienNr) vermerkt worden ist
' todo Überprüfen in eRegister Tabelle, ob diese PCBID nicht schon als PCBID eines ANDEREN eRegisters (PCBId, SerienNr) vermerkt worden ist
For Each EinbauplatzCheck In m_colEinbauplatz
Set Pruefzaehler2 = Einbauplatz.getPruefzaehler
If Not Pruefzaehler2 Is Nothing Then
If Not EinbauplatzCheck.eRegister Is Nothing Then
If EinbauplatzCheck.getNr <> Einbauplatz.getNr Then
' Einbauplätze sind belegt und unterschiedlich und können verglichen werden
' - keine doppelten PCBIds
Debug.Print "PCB ID: " & EinbauplatzCheck.eRegister.m_sPCBid & "<>" & Einbauplatz.eRegister.m_sPCBid & " ? "
If EinbauplatzCheck.eRegister.m_sPCBid = Einbauplatz.eRegister.m_sPCBid Then
Check_For_Valid_eRegister_Data = False
MsgBox "Die PCB ID '" & EinbauplatzCheck.eRegister.m_sPCBid & "' vom eRegister am Einbauplatz " & Einbauplatz.getNr & " ist identisch wie die von Einbauplatz " & EinbauplatzCheck.getNr
End If
' - keine doppelten FunkAdr
Debug.Print "Radio " & EinbauplatzCheck.eRegister.m_sRadioAdress & "<>" & Einbauplatz.eRegister.m_sRadioAdress & " ? "
If EinbauplatzCheck.eRegister.m_sRadioAdress = Einbauplatz.eRegister.m_sRadioAdress Then
Check_For_Valid_eRegister_Data = False
MsgBox "Die Funkadresse '" & EinbauplatzCheck.eRegister.m_sRadioAdress & "' vom eRegister am Einbauplatz " & Einbauplatz.getNr & " ist identisch wie die von Einbauplatz " & EinbauplatzCheck.getNr
Check_For_Valid_eRegister_Data = False
End If
End If
End If
End If
Next
End If ' nur offene
End If
End If
Next
End Function
Public Sub ResetMesswertAnzeige()
Dim Einbauplatz As CEinbauplatz
For Each Einbauplatz In m_colEinbauplatz
MSFlexGrid1.col = Einbauplatz.getNr
MSFlexGrid1.row = fgZeile.Zeile_Pz_Pruefzeit
MSFlexGrid1.text = ""
MSFlexGrid1.row = fgZeile.Zeile_Pz_Pruefvolumen
MSFlexGrid1.text = ""
MSFlexGrid1.row = fgZeile.Zeile_Pz_Startvolumen
MSFlexGrid1.text = ""
MSFlexGrid1.row = fgZeile.Zeile_Pz_StartZeit
MSFlexGrid1.text = ""
MSFlexGrid1.row = fgZeile.Zeile_Pz_Endvolumen
MSFlexGrid1.text = ""
MSFlexGrid1.row = fgZeile.Zeile_Pz_EndZeit
MSFlexGrid1.text = ""
MSFlexGrid1.row = fgZeile.Zeile_Pz_Fehler
MSFlexGrid1.text = ""
Next
End Sub
Public Function StartPruefung() As Boolean
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim ret As Long
Dim lngImpulse As Long
Dim dblSollvolumen As Double
' Volumen aus der Prüfzeit berechnen, für das die Impuls-Anzahl berechnet werden soll
dblSollvolumen = m_dblSolldurchfluss * m_lSollPruefzeit_s / 3600
' Impuls-Anzahl berechnen und anzeigen, nur ganze Impulse
lngImpulse = Int(dblSollvolumen * m_Referenzzaehler.ImpulseQM)
ProgressBar1.Visible = True
ProgressBar1.Max = lngImpulse
PrintStatus "Anzahl Perioden für RZ: " & lngImpulse
SetFlexgridRow fgRZZeile.Zeile_Rz_SollImpulse, MSFlexGridRZ, "Impulse"
MSFlexGridRZ.TextMatrix(MSFlexGridRZ.row, 1) = lngImpulse
' Referenzvolumen berechnen und anzeigen
m_dblReferenzvolumen = lngImpulse / m_Referenzzaehler.ImpulseQM
PrintStatus "RZ Volumen: " & m_dblReferenzvolumen & " m³"
SetFlexgridRow fgRZZeile.Zeile_Rz_Sollvolumen, MSFlexGridRZ, "Volumen m³"
MSFlexGridRZ.TextMatrix(MSFlexGridRZ.row, 1) = m_dblReferenzvolumen
' Programmiere den FM zum Rückwärts Zählen der Impuls-Anzahl
wdh:
If Not GenesisBatch Is Nothing Then
If Calibration Then
GenesisBatch.MetersStartCalibration
Else
GenesisBatch.MetersStartMeasurement
End If
End If
Sleep 1000, True
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
MSFlexGrid1.col = Einbauplatz.getNr
MSFlexGrid1.row = fgZeile.Zeile_Pz_Fehler
MSFlexGrid1.CellBackColor = RGB(0, 0, 0)
MSFlexGrid1.TextMatrix(fgZeile.Zeile_Pz_Timestamp, Einbauplatz.getNr) = ""
MSFlexGrid1.TextMatrix(fgZeile.Zeile_Pz_Volume, Einbauplatz.getNr) = ""
Dim meterState As New GenesisMeter
Set meterState = GenesisBatch.GetMeter(Einbauplatz.getNr)
Dim hasDataText As String
hasDataText = "keine Daten empfangen"
Dim currentState As ActionStates
If Not meterState Is Nothing Then
If Calibration Then
currentState = meterState.GetCalibrationProgress
Else
currentState = meterState.GetMeasurementProgress
End If
End If
If currentState = ActionStates_IsRunning Then
hasDataText = "Daten empfangen"
End If
' Startvolumen anzeigen
SetFlexgridRow Zeile_Pz_Startvolumen, MSFlexGrid1, "Vol start"
MSFlexGrid1.TextMatrix(MSFlexGrid1.row, Einbauplatz.getNr) = hasDataText
' Startzeit anzeigen
SetFlexgridRow Zeile_Pz_StartZeit, MSFlexGrid1, "Time start"
MSFlexGrid1.TextMatrix(MSFlexGrid1.row, Einbauplatz.getNr) = hasDataText
' Endwerte löschen
MSFlexGrid1.col = Einbauplatz.getNr
SetFlexgridRow Zeile_Pz_Endvolumen, MSFlexGrid1, ""
MSFlexGrid1.text = ""
SetFlexgridRow Zeile_Pz_EndZeit, MSFlexGrid1, ""
MSFlexGrid1.text = ""
SetFlexgridRow Zeile_Pz_Pruefvolumen, MSFlexGrid1, ""
MSFlexGrid1.text = ""
SetFlexgridRow Zeile_Pz_Pruefzeit, MSFlexGrid1, ""
MSFlexGrid1.text = ""
SetFlexgridRow Zeile_Pz_PruefDurchfluss, MSFlexGrid1, ""
MSFlexGrid1.text = ""
' Fehler stehenlassen statt löschen
' SetFlexgridRow Zeile_Pz_Fehler, MSFlexGrid1, ""
' MSFlexGrid1.text = ""
SetFlexgridRow Zeile_PZ_Ende, MSFlexGrid1, ""
MSFlexGrid1.text = ""
End If
Next
If Not InitFMforRZVolumenmessung(m_iErsterBelegterEinbauplatz, lngImpulse) Then
ret = MsgBox("Der FM am Einbauplatz " & m_iErsterBelegterEinbauplatz & " für den RefZ konnte nicht initialisiert werden. Möchten Sie die Prüfung abbrechen oder das Initialisieren des FM85 wiederholen?", vbDefaultButton2 Or vbRetryCancel)
If ret = vbRetry Then
GoTo wdh
End If
If ret = vbCancel Then
StartPruefung = False
Exit Function
End If
End If
AutoSpaltenBreite MSFlexGridRZ, lblAutosize
AutoSpaltenBreite MSFlexGrid1, lblAutosize
StartPruefung = True
End Function
Public Function StopPruefung() As Boolean
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim ret As Long
Dim dblFehler As Double
Dim lngPeriodendauer As Long
Dim strAntwort As String
On Error GoTo Errorhandler
retryLesePeriodendauer:
' Lese die Periodendauer des Referenzzählers
m_FMBus.send "**" & m_iErsterBelegterEinbauplatz & "@"
m_FMBus.receive (500)
m_FMBus.send "Y"
strAntwort = m_FMBus.receive(500)
lngPeriodendauer = Hex2Long(strAntwort)
If lngPeriodendauer = 0 Then
ret = MsgBox("Die Periodendauer des RZ konnte nicht gelesen werden. Möchten Sie die Prüfung abbrechen oder das Auslesen des FM wiederholen?", vbAbortRetryIgnore Or vbDefaultButton2)
Select Case ret
Case vbRetry
GoTo retryLesePeriodendauer
Case vbAbort, vbCancel
StopPruefung = False
Exit Function
Case vbIgnore
StopPruefung = False
Exit Function
End Select
Else
mdblPruefzeitReferenz = lngPeriodendauer * (1 / 2994)
End If
PrintStatus "Prüfzeit RZ an Ebp " & m_iErsterBelegterEinbauplatz & " = " & lngPeriodendauer & " / 2994 = " & mdblPruefzeitReferenz
' Periodendauer anzeigen
SetFlexgridRow fgRZZeile.Zeile_Rz_Periodendauer, MSFlexGridRZ, "Periodendauer"
MSFlexGridRZ.TextMatrix(MSFlexGridRZ.row, 1) = Round(mdblPruefzeitReferenz, 4) & " s"
If mdblPruefzeitReferenz <> 0 Then
' RefZ Durchlfluss errechnen und anzeigen
m_dblRefzDurchfluss = m_dblReferenzvolumen / mdblPruefzeitReferenz * 3600
SetFlexgridRow Zeile_Rz_RefDurchfluss, MSFlexGridRZ, "Ref Q"
MSFlexGridRZ.text = Round(m_dblRefzDurchfluss, 3)
PrintStatus "gemessener Durchfluss am RZ = * " & m_dblReferenzvolumen & " / " & mdblPruefzeitReferenz & " = " & m_dblRefzDurchfluss
' korrigierten RefZ Durchlfluss errechnen und anzeigen
m_dblRefzDurchfluss = (m_dblReferenzvolumen / mdblPruefzeitReferenz * 3600) * (1 - m_Referenzzaehler.letzterFehler(m_dblSolldurchfluss) / 100)
PrintStatus "mit Fehler (" & m_Referenzzaehler.letzterFehler(m_dblSolldurchfluss) & "%) korrigierter Durchfluss am RZ = * " & m_dblRefzDurchfluss
SetFlexgridRow Zeile_Rz_RefDurchfluss_korr, MSFlexGridRZ, "Ref Q korrigiert"
MSFlexGridRZ.text = Round(m_dblRefzDurchfluss, 3)
End If
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
If False Then
Dim simVol As Double
simVol = m_lSollPruefzeit_s / 3600 * m_dblSolldurchfluss
Einbauplatz.eRegister.m_sVolume = Int(CStr(CDbl(Einbauplatz.eRegister.m_dblVolumeStart) + simVol * 1000 * 1000))
Einbauplatz.eRegister.m_sTime = CStr(CDbl(Einbauplatz.eRegister.m_dblTimestampStart + m_lSollPruefzeit_s * 1000))
MsgBox "Simuliertes Vol am RZ " & simVol
End If
'add for genesis
Dim refVol As Double
'add for genesis
Dim meterResult As New GenesisMeter
Set meterResult = GenesisBatch.GetMeter(Einbauplatz.getNr)
Dim Result As MeasurementResults
If Not meterResult Is Nothing Then
If Calibration = True Then
Dim ResultPerChannel() As MeasurementResults
ResultPerChannel = meterResult.GetCalibrationResult
Dim tmpVol As Double
tmpVol = 0
Dim tmpTime As Double
tmpTime = 0
Dim i As Long
For i = 0 To 2
Result = ResultPerChannel(i)
tmpVol = tmpVol + Result.TotalVolumeQm
tmpTime = tmpTime + Result.TotalTimeS
Next i
Result.TotalTimeS = tmpTime / 3
Result.TotalVolumeQm = tmpVol / 3
Else
Result = meterResult.GetMeasurementResult
End If
End If
Dim m_dblMessVolumen As Double
Dim m_dblMessZeit As Double
Dim m_dblMessDurchfluss As Double
m_dblMessVolumen = Result.TotalVolumeQm
m_dblMessZeit = Result.TotalTimeS
If m_dblMessVolumen = 0 Or m_dblMessZeit = 0 Then
m_dblMessDurchfluss = 0
Else
m_dblMessDurchfluss = m_dblMessVolumen / (m_dblMessZeit / 3600)
End If
' gemessenen Volumen anzeigen
If m_dblMessVolumen < 0 Then
MsgBox "Es wurde ein negatives Volumen = " & m_dblMessVolumen & " am Ebp " & Einbauplatz.getNr & " gemessen." & vbCrLf & "Zähler zählte von " & Result.StartData.volumeQm & " bis " & Result.EndData.volumeQm & vbCrLf & "Bitte überprüfen Sie das Werk!"
End If
SetFlexgridRow Zeile_Pz_Pruefvolumen, MSFlexGrid1, "Mess Vol [m³]"
MSFlexGrid1.text = m_dblMessVolumen
PrintStatus "Ebp " & Einbauplatz.getNr & " gemessenes Volumen: " & m_dblMessVolumen & " m³"
SetFlexgridRow Zeile_Pz_Pruefzeit, MSFlexGrid1, "Mess Zeit [s]"
MSFlexGrid1.text = m_dblMessZeit
PrintStatus "Ebp " & Einbauplatz.getNr & " gemessene Zeit: " & m_dblMessZeit & " s"
' daraus errechneter Durchfluss anzeigen
SetFlexgridRow Zeile_Pz_PruefDurchfluss, MSFlexGrid1, "Mess Q [m³/h]"
MSFlexGrid1.text = Round(m_dblMessDurchfluss, 3)
PrintStatus "Ebp " & Einbauplatz.getNr & " => gemessener Durchfluss: " & m_dblMessDurchfluss & " m³/h"
' daraus errechneter Fehler anzeigen
SetFlexgridRow Zeile_Pz_Fehler, MSFlexGrid1, "Fehler [%]"
Dim Fehler As Double
If m_dblMessDurchfluss = 0 Then
Fehler = 100
Else
If g_objExternePruefformel Is Nothing Then
PrintStatus "Interne Pruefformel"
PrintStatus " m_dblMessDurchfluss = " & m_dblMessDurchfluss & " m³/h"
PrintStatus " m_dblRefzDurchfluss = " & m_dblRefzDurchfluss & " m³/h"
Fehler = (m_dblMessDurchfluss - m_dblRefzDurchfluss) / m_dblRefzDurchfluss * 100
PrintStatus " Fehler = " & Fehler
Else
' Fehlerberechnung in Externer DLL, neu RH 30.5.2017
Fehler = modPruefformel.Errechne_Relative_Messabweichung_in_Prozent(m_dblMessDurchfluss, m_dblRefzDurchfluss, 0)
PrintStatus g_objExternePruefformel.GetLogText
End If
End If
MSFlexGrid1.text = Round(Fehler, 2)
If Not meterResult Is Nothing Then
If Calibration = True Then
meterResult.CalculateCalibrationWithVol m_dblMessDurchfluss
If CalibrationStore = True Then
meterResult.SaveCalculatedCalibration
End If
End If
meterResult.WriteLog " results for " & m_dblSolldurchfluss & " m³/h"
meterResult.WriteLog " Ref Flow = " & m_dblRefzDurchfluss & " m³/h"
meterResult.WriteLog " Ref Vol = " & m_dblReferenzvolumen & " m³"
meterResult.WriteLog " Ref Time = " & mdblPruefzeitReferenz & " s"
meterResult.WriteLog " Meter Flow = " & m_dblMessDurchfluss & " m³/h"
meterResult.WriteLog " Meter Time = " & m_dblMessZeit & " s"
meterResult.WriteLog " Meter Vol = " & m_dblMessVolumen & " m³"
meterResult.WriteLog " MeterError = " & Fehler & " %"
End If
If m_PPNr > 0 Then
If GrenzwertUeberschritten(Einbauplatz.getPruefzaehler.getPruefpunkte.getPruefpunkte.Item(m_PPNr).getFGo, Fehler, Einbauplatz.getPruefzaehler.getPruefpunkte.getPruefpunkte.Item(m_PPNr).getFGu) Then
MSFlexGrid1.CellBackColor = RGB(255, 128, 128)
Else
MSFlexGrid1.CellBackColor = RGB(128, 255, 128)
End If
End If
PrintStatus "Ebp " & Einbauplatz.getNr & " => gemessener Fehler: " & Round(Fehler, 3) & " %"
Call SchreibeZulassungspruefdaten(Pruefzaehler.getSerienNr, 0, m_dblSolldurchfluss, m_dblRefzDurchfluss, m_dblMessVolumen, , m_dblReferenzvolumen, 0, Now())
End If
Next
StopPruefung = True
AutoSpaltenBreite MSFlexGridRZ, lblAutosize
' todo hier. weg woanders hin
''WarteAufWeiterButton "Weiter", 10
Exit Function
Errorhandler:
ret = MsgBox("Fehler " & Err.Number & " in StopPruefung(): " & Err.Description, vbAbortRetryIgnore)
LogIntoDB "Fehler " & Err.Number & " in StopPruefung(): " & Err.Description
Select Case ret
Case vbRetry
Resume
Case vbCancel, vbAbort
StopPruefung = False
Case vbIgnore
Resume Next
End Select
End Function
Public Function StopPruefungVerbundzaehler() As Boolean
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim ret As Long
Dim dblFehler As Double
Dim lngPeriodendauer As Long
Dim strAntwort As String
Dim dblMessdurchfluss As Double
On Error GoTo Errorhandler
retryLesePeriodendauer:
' Lese die Periodendauer des Referenzzählers
m_FMBus.send "**" & m_iErsterBelegterEinbauplatz & "@"
m_FMBus.receive (500)
m_FMBus.send "Y"
strAntwort = m_FMBus.receive(500)
lngPeriodendauer = Hex2Long(strAntwort)
If lngPeriodendauer = 0 Then
ret = MsgBox("Die Periodendauer des RZ konnte nicht gelesen werden. Möchten Sie die Prüfung abbrechen oder das Auslesen des FM wiederholen?", vbAbortRetryIgnore Or vbDefaultButton2)
Select Case ret
Case vbRetry
GoTo retryLesePeriodendauer
Case vbAbort, vbCancel
StopPruefungVerbundzaehler = False
Exit Function
Case vbIgnore
StopPruefungVerbundzaehler = False
Exit Function
End Select
Else
mdblPruefzeitReferenz = lngPeriodendauer * (1 / 2994)
End If
PrintStatus "Prüfzeit RZ an Ebp " & m_iErsterBelegterEinbauplatz & " = " & lngPeriodendauer & " / 2994 = " & mdblPruefzeitReferenz
' Periodendauer anzeigen
SetFlexgridRow fgRZZeile.Zeile_Rz_Periodendauer, MSFlexGridRZ, "Periodendauer"
MSFlexGridRZ.TextMatrix(MSFlexGridRZ.row, 1) = Round(mdblPruefzeitReferenz, 4) & " s"
If mdblPruefzeitReferenz <> 0 Then
' RefZ Durchlfluss errechnen und anzeigen
m_dblRefzDurchfluss = m_dblReferenzvolumen / mdblPruefzeitReferenz * 3600
SetFlexgridRow Zeile_Rz_RefDurchfluss, MSFlexGridRZ, "Ref Q"
MSFlexGridRZ.text = Round(m_dblRefzDurchfluss, 3)
PrintStatus "gemessener Durchfluss am RZ = * " & m_dblReferenzvolumen & " / " & mdblPruefzeitReferenz & " = " & m_dblRefzDurchfluss
' korrigierten RefZ Durchlfluss errechnen und anzeigen
m_dblRefzDurchfluss = (m_dblReferenzvolumen / mdblPruefzeitReferenz * 3600) * (1 - m_Referenzzaehler.letzterFehler(m_dblSolldurchfluss) / 100)
PrintStatus "mit Fehler (" & m_Referenzzaehler.letzterFehler(m_dblSolldurchfluss) & "%) korrigierter Durchfluss am RZ = * " & m_dblRefzDurchfluss
SetFlexgridRow Zeile_Rz_RefDurchfluss_korr, MSFlexGridRZ, "Ref Q korrigiert"
MSFlexGridRZ.text = Round(m_dblRefzDurchfluss, 3)
End If
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing And Not Einbauplatz.eRegister Is Nothing Then
' End Werte merken für alle HZ und NZ
Einbauplatz.eRegister.StopPruefung
End If
Next
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing And Not Einbauplatz.eRegister Is Nothing Then
' End Volumen anzeigen
MSFlexGrid1.col = Einbauplatz.getNr
SetFlexgridRow Zeile_Pz_Endvolumen, MSFlexGrid1, "Vol end"
MSFlexGrid1.text = Einbauplatz.eRegister.m_dblVolumeEnde
PrintStatus "Ebp " & Einbauplatz.getNr & " End-Vol=" & Einbauplatz.eRegister.m_dblVolumeEnde
' End zeit anzeigen
SetFlexgridRow Zeile_Pz_EndZeit, MSFlexGrid1, "Time end [ms]"
MSFlexGrid1.text = Einbauplatz.eRegister.m_dblTimestampEnde
PrintStatus "Ebp " & Einbauplatz.getNr & " End-Time=" & Einbauplatz.eRegister.m_dblTimestampEnde
' gemessenen Volumen anzeigen
If Einbauplatz.eRegister.m_dblMessVolumen < 0 Then
MsgBox "Es wurde ein negatives Volumen = " & Einbauplatz.eRegister.m_dblMessVolumen & " am Ebp " & Einbauplatz.getNr & " gemessen." & vbCrLf & "Zähler zählte von " & Einbauplatz.eRegister.m_dblVolumeStart & " bis " & Einbauplatz.eRegister.m_dblVolumeEnde & vbCrLf & "Bitte überprüfen Sie das Werk!"
End If
SetFlexgridRow Zeile_Pz_Pruefvolumen, MSFlexGrid1, "Mess Vol [m³]"
MSFlexGrid1.text = Einbauplatz.eRegister.m_dblMessVolumen
PrintStatus "Ebp " & Einbauplatz.getNr & " gemessenes Volumen: " & Einbauplatz.eRegister.m_dblMessVolumen & " m³"
' gemessene Zeit anzeigen
If Einbauplatz.eRegister.m_dblMessZeit < 0 Then
MsgBox "Es gab einen Timestamp-Überlauf am Ebp " & Einbauplatz.getNr & ": " & Einbauplatz.eRegister.m_dblTimestampStart & " bis " & Einbauplatz.eRegister.m_dblTimestampEnde
End If
SetFlexgridRow Zeile_Pz_Pruefzeit, MSFlexGrid1, "Mess Zeit [s]"
MSFlexGrid1.text = Einbauplatz.eRegister.m_dblMessZeit
PrintStatus "Ebp " & Einbauplatz.getNr & " gemessene Zeit: " & Einbauplatz.eRegister.m_dblMessZeit & " s"
' daraus errechneter Durchfluss anzeigen
SetFlexgridRow Zeile_Pz_PruefDurchfluss, MSFlexGrid1, "Mess Q [m³/h]"
MSFlexGrid1.text = Round(Einbauplatz.eRegister.m_dblMessDurchfluss, 3)
PrintStatus "Ebp " & Einbauplatz.getNr & " => gemessener Durchfluss: " & Einbauplatz.eRegister.m_dblMessDurchfluss & " m³/h"
' daraus errechneter Fehler anzeigen
SetFlexgridRow Zeile_Pz_Fehler, MSFlexGrid1, "Fehler [%]"
dblMessdurchfluss = -1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If m_Verbundzaehler_Pruefmodus = HZ_NZ And (Einbauplatz.getNr = 1 Or Einbauplatz.getNr = 3) Then
' beide Durchflüsse vom HZ und dazugehörigem NZ zusammenzählen
dblMessdurchfluss = Einbauplatz.eRegister.m_dblMessDurchfluss + m_colEinbauplatz(Einbauplatz.getNr + 1).eRegister.m_dblMessDurchfluss
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If m_Verbundzaehler_Pruefmodus = NUR_HZ And (Einbauplatz.getNr = 1 Or Einbauplatz.getNr = 3) Then
' nur HZ Durchflüsse betrachten
dblMessdurchfluss = Einbauplatz.eRegister.m_dblMessDurchfluss
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If m_Verbundzaehler_Pruefmodus = NUR_NZ And (Einbauplatz.getNr = 2 Or Einbauplatz.getNr = 4) Then
' nur NZ Durchflüsse betrachten
dblMessdurchfluss = Einbauplatz.eRegister.m_dblMessDurchfluss
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If dblMessdurchfluss > 0 Then
If g_objExternePruefformel Is Nothing Then
PrintStatus "Interne Pruefformel"
PrintStatus " MessDurchfluss = " & dblMessdurchfluss
PrintStatus " RefzDurchfluss = " & m_dblRefzDurchfluss & " m³/h"
Einbauplatz.eRegister.m_dblFehler = (dblMessdurchfluss - m_dblRefzDurchfluss) / m_dblRefzDurchfluss * 100
PrintStatus " Fehler = " & Einbauplatz.eRegister.m_dblFehler
Else
' Fehlerberechnung in Externer DLL, neu RH 30.5.2017
Einbauplatz.eRegister.m_dblFehler = modPruefformel.Errechne_Relative_Messabweichung_in_Prozent(dblMessdurchfluss, m_dblRefzDurchfluss, 0)
PrintStatus g_objExternePruefformel.GetLogText
End If
MSFlexGrid1.text = Round(Einbauplatz.eRegister.m_dblFehler, 2)
If m_PPNr > 0 Then
If GrenzwertUeberschritten(Einbauplatz.getPruefzaehler.getPruefpunkte.getPruefpunkte.Item(m_PPNr).getFGo, Einbauplatz.eRegister.m_dblFehler, Einbauplatz.getPruefzaehler.getPruefpunkte.getPruefpunkte.Item(m_PPNr).getFGu) Then
MSFlexGrid1.CellBackColor = RGB(255, 128, 128)
Else
MSFlexGrid1.CellBackColor = RGB(128, 255, 128)
End If
End If
PrintStatus "Ebp " & Einbauplatz.getNr & " => gemessener Fehler: " & Round(Einbauplatz.eRegister.m_dblFehler, 3) & " %"
Else
' messruchfluss wurde nicht gesetzt weil Zhler nicht betrachtet wird
MSFlexGrid1.text = " - "
End If 'dblMessdurchfluss > 0
End If 'Not Pruefzaehler Is Nothing
Next ' Einbauplatz
StopPruefungVerbundzaehler = True
AutoSpaltenBreite MSFlexGridRZ, lblAutosize
Exit Function
Errorhandler:
ret = MsgBox("Fehler " & Err.Number & " in StopPruefung(): " & Err.Description, vbAbortRetryIgnore)
LogIntoDB "Fehler " & Err.Number & " in StopPruefung(): " & Err.Description
Select Case ret
Case vbRetry
Resume
Case vbCancel, vbAbort
StopPruefungVerbundzaehler = False
Case vbIgnore
Resume Next
End Select
End Function
Private Sub cmd1Messung_Click()
eRegister_PP_Messung_durchfuehren (True)
End Sub
Private Sub cmdCancel_Click()
On Error Resume Next
PrintStatus "Der Abbruch-Button wurde geklickt"
StopOptoEmpfang
If Not mSIRTStatemashine Is Nothing Then
mSIRTStatemashine.Stop
End If
m_blnAbbruch = True
End Sub
Private Sub ReleaseSIRT()
Dim Wraper As SIRTCOM.Wrapper
Dim bytP12 As Byte
If Not mSIRTStatemashine Is Nothing Then
mSIRTStatemashine.Stop
Set mSIRTStatemashine = Nothing
End If
Set Wraper = New SIRTCOM.Wrapper
Wraper.ClosePort (bytP12)
PrintStatus "SIRT Comport released"
End Sub
Private Function InitialiseSIRT() As Boolean
Dim comport As Byte
Dim ret As Long
If mSIRTStatemashine Is Nothing Then
Set mSIRTStatemashine = New SIRTCOM.Statemashine
End If
comport = Val(g_App.Settings.readStringValue("SIRT", "COMPort", ""))
If comport = 0 Then
askSIRTCOMPort:
comport = Val(InputBox("Bitte geben Sie den COM Port für den SIRT an.", , comport))
End If
ret = mSIRTStatemashine.initialise(comport)
If ret <> 0 Then
MsgBox ret & ": " & mSIRTStatemashine.GetLastErrorMessage
GoTo askSIRTCOMPort
End If
SetSIRTActivateTimeout 0
InitialiseSIRT = True
g_App.Settings.saveStringValue "SIRT", "COMPort", CStr(comport)
End Function
Private Sub SetSIRTActivateTimeout(byteTimeout As Byte)
Dim Wrapper As SIRTCOM.Wrapper
Dim ret As Long
Dim P12_01 As Byte
Dim P12_02 As Byte
If mSIRTWrapper Is Nothing Then
Set mSIRTWrapper = New SIRTCOM.Wrapper
End If
ret = mSIRTWrapper.ActivateSirt(1, 1, byteTimeout, P12_01, P12_02)
WriteToLog "ActivateSirt (byteTimeout=" & byteTimeout & ") ret=" & ret
End Sub
Private Sub cmdCheckFunk_Click()
Dim strFunkadressen As String
Dim arFA() As String
Dim FA As Variant
Dim strSQL As String
If Not InitialiseSIRT() Then
Exit Sub
End If
mSIRTStatemashine.start
mSIRTStatemashine.ClearBUPRadioAdresses
SleepWithEvents 60000, True
strFunkadressen = mSIRTStatemashine.GetBUPRadioAdresses
Clipboard.setText strFunkadressen
arFA = Split(strFunkadressen, " ")
For Each FA In arFA
strSQL = "SELECT * from eRegister where Adresse like '%" & FA & "%' or TempAdresse like '%" & FA & "%'"
Debug.Print strSQL
Next
End Sub
Private Sub cmdFunkadresse_Click()
Dim EinbauplatzNr As Integer
Dim eRegister As CeRegister
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim objPAM As PAM
Dim strCMDHex As String
Dim curFunkAdresse As Currency
Dim Frequenz As Integer
cmdCancel.Enabled = True
' neue Zeile
m_PAMZeile = MSFlexGrid1.Rows
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "Funkadr manuell"
' alle Befehle zurücksetzen
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.eRegister Is Nothing Then
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
End If
Next
EinbauplatzNr = Val(InputBox("EinbauplatzNr", "Einbauplatz für Werk-Auswahl (oder 0 eingeben)"))
If EinbauplatzNr >= 1 And EinbauplatzNr <= 10 Then
Set Einbauplatz = m_colEinbauplatz(EinbauplatzNr)
Set eRegister = Einbauplatz.eRegister
Else
Set Einbauplatz = m_colEinbauplatz(1)
End If
If eRegister Is Nothing Then
' eRegister wurde nicht eingelesen
Set eRegister = New CeRegister
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If eRegister.loadForSerienNr(Einbauplatz.getPruefzaehler.getSerienNr) Then
'
End If
End If
Set Einbauplatz.eRegister = eRegister
End If
Frequenz = Einbauplatz.eRegister.m_iFrequenz
Frequenz = Val(InputBox("Bitte geben Sie die Frequenz (433 oder 868) ein.", "", Frequenz))
Select Case Frequenz
Case 433, 868
If Not InitSirt(Frequenz) Then
Exit Sub
End If
Case Else
MsgBox "ungültige Frequenz"
Exit Sub
End Select
curFunkAdresse = Val(InputBox("aktuelle Funkadresse dec", "Funkadresse ändern", Einbauplatz.eRegister.m_sRadioAdress))
If curFunkAdresse = 0 Then Exit Sub
If curFunkAdresse > 10000000000# Then
curFunkAdresse = curFunkAdresse - 10000000000#
End If
Einbauplatz.eRegister.m_sRadioAdress = curFunkAdresse
If Not eRegister Is Nothing Then
curFunkAdresse = Val(InputBox("Zieladresse dec", "Funkadresse ändern", Einbauplatz.eRegister.m_sTempRadioaddress))
' Todo Besser in 10 stellige Zahl unter 4294967295 umwandeln
If curFunkAdresse > 10000000000# Then
curFunkAdresse = curFunkAdresse - 10000000000#
End If
If curFunkAdresse = 0 Then Exit Sub
Einbauplatz.eRegister.m_sRadioAdressFinal = curFunkAdresse
MSFlexGrid1.col = Einbauplatz.getNr
MSFlexGrid1.row = fgZeile.Zeile_Pz_RadioAdr
MSFlexGrid1.text = "wird geändert"
MSFlexGrid1.CellBackColor = RGB(255, 255, 128)
strCMDHex = "35" & Hex8(curFunkAdresse)
If MsgBox("Ist das Werk bereits geschlossen?", vbYesNo) = vbYes Then
strCMDHex = strCMDHex & ProvideAuthLevelHexCommand(3)
Einbauplatz.eRegister.m_bUseKey = True
Einbauplatz.eRegister.m_bytAuthLevel = 3
Einbauplatz.eRegister.m_sKeyHex = FUNKSCHLUESSEL_SENSUS_STANDARD
End If
strCMDHex = Hex2(Len(strCMDHex) / 2) & strCMDHex
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
' Funkadresse ändern
Call Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("Funkadresse", IIf(Einbauplatz.eRegister.m_bUseKey, 20, 16), True)
If Not mSIRTStatemashine Is Nothing Then
Set objPAM = mSIRTStatemashine.GetPAM(Einbauplatz.getNr)
If Not objPAM Is Nothing Then
If Not objPAM.SEMI Is Nothing Then
MSFlexGrid1.TextMatrix(fgZeile.Zeile_Pz_RadioAdr, Einbauplatz.getNr) = objPAM.SEMI.RadioAdr
MsgBox "Funkadresse (aus der SEMI) ist nun " & objPAM.SEMI.RadioAdr
Else ' SEMI is nothing
If Not objPAM.BUP Is Nothing Then
MSFlexGrid1.TextMatrix(fgZeile.Zeile_Pz_RadioAdr, Einbauplatz.getNr) = objPAM.BUP.RadioAdr
MsgBox "Funkadresse (aus der letzen BUP) ist nun " & objPAM.BUP.RadioAdr
End If
End If
End If
mSIRTStatemashine.Stop
End If
End If
' StartOptoEmpfang
' Sleep 1000, True
' StopOptoEmpfang
End Sub
Private Sub cmdInit_Click()
If PruefungInitialisierung_NeuerVako() Then
MsgBox "Fertig"
Else
MsgBox "Abgebrochen"
End If
End Sub
Private Sub cmdInitSirt_Click()
m_PAMZeile = 20
cmdInitSirt.Enabled = False
If Not InitSirt() Then
' SIRT kann nicht initialisiert werden, also abbrechen
MsgBox "SIRT konnte nicht initialisiert werden !"
cmdInitSirt.Enabled = True
Exit Sub
End If
mSIRTStatemashine.Stop
cmdInitSirt.Enabled = True
End Sub
Private Sub cmdLEDAn_Click()
m_PAMZeile = m_PAMZeile + 1
Call LED_Einschalten
End Sub
Private Sub cmdOptoAus_Click()
StopOptoEmpfang
End Sub
Private Sub cmdOptoStart_Click()
StartOptoEmpfang
End Sub
Private Sub cmdRegulierungMessung_Click()
Dim Einbauplatz As CEinbauplatz
Dim Fehler As Double
Dim blnWeiterWasVisible As Boolean
frmRegulierungErgebnisse.Visible = False
''''''''''''''''''''''''''''''''''''''
blnWeiterWasVisible = cmdWeiter.Visible
cmdWeiter.Visible = False
''''''''''''''''''''''''''''''''''''''
lblFehler(1).caption = ""
lblFehler(2).caption = ""
cmdRegulierungMessung.Enabled = False
cmdCancel.Enabled = True
m_blnAbbruch = False
If Not m_Display Is Nothing Then
m_Display.Adressierung 255
Sleep 100
End If
Do
m_lSollPruefzeit_s = Val(cmbRegulierPruefzeit.text)
Call OptoMessung_durchfuehren
'''''''''''''''''''''''''''''''''''''''''''''''''''''
' Fehler auf Bildschirm Anzeigen
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim eRegister As CeRegister
If frmGenesisPruefung.m_Verbundzaehler_Pruefmodus = HZ_NZ Then
Set eRegister = m_colEinbauplatz(1).eRegister
If Not eRegister Is Nothing Then
lblFehler(1).caption = Round(eRegister.m_dblFehler, 2)
End If
Set eRegister = m_colEinbauplatz(3).eRegister
If Not eRegister Is Nothing Then
lblFehler(2).caption = Round(eRegister.m_dblFehler, 2)
End If
End If
frmRegulierungErgebnisse.Visible = True
'''''''''''''''''''''''''''''''''''''''''''''''''''''
' Fehler auif Display Anzeigen
'''''''''''''''''''''''''''''''''''''''''''''''''''''
If Not m_Display Is Nothing Then
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.getPruefzaehler Is Nothing Then
m_Display.Adressierung Einbauplatz.getNr
Sleep 100
' Font 3, 4*x 4*y Zoom
m_Display.EaKitOutput Chr(27) & "F" & Chr(3) & Chr(3) & Chr(3)
Sleep 100
m_Display.PlaceText MSFlexGrid1.TextMatrix(Zeile_Pz_Fehler, Einbauplatz.getNr), 30, 80
Sleep 100
' Font 3, 4*x 1*y Zoom
m_Display.EaKitOutput Chr(27) & "F" & Chr(3) & Chr(1) & Chr(1)
End If
Next
End If
Loop While chkKontinuierlich.value = vbChecked And m_blnAbbruch = False
cmdWeiter.Visible = blnWeiterWasVisible
cmdRegulierungMessung.Enabled = True
End Sub
Private Sub cmdWeiter_Click()
m_blnWeiter = True
cmdWeiter.Enabled = False
End Sub
Private Sub UpdateDisplay(ByRef Einbauplatz As CEinbauplatz)
If Not m_Display Is Nothing Then
' Diplay mit der PCB ID aktualisieren
m_Display.Adressierung Einbauplatz.getNr
Sleep 100
m_Display.PlaceAusgabe "ID: " & Einbauplatz.eRegister.m_sPCBid, 10, 30, 140, 39
End If
End Sub
Public Function eRegister_PP_Messung_durchfuehren(Optional bln_LED_aus As Boolean = False) As Boolean
' Abbruch zulassen
m_blnAbbruch = False
cmdCancel.Enabled = True
Me.Visible = True
eRegister_PP_Messung_durchfuehren = OptoMessung_durchfuehren()
End Function
Private Function WaitForNoMoreBups() As Boolean
Dim Einbauplatz As CEinbauplatz
Dim objPAM As SIRTCOM.PAM
Dim lngTime As Long
Dim blnAllesOK As Boolean
If mSIRTStatemashine Is Nothing Then Exit Function
blnAllesOK = True
WaitForNoMoreBups = False 'Fehler falls abgebrochen, als Default Wert
' Nach einem "GoSleep" sollten die ersten 20 Sekunden noch 5 BUPs kommen
' danach mind. 20 Sekunden keine mehr,
' bis man sagen kann, das keiner der eRegister mehr sendet
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' reset BUPS count
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
mSIRTStatemashine.start
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.eRegister Is Nothing Then
Set objPAM = mSIRTStatemashine.GetPAM(Einbauplatz.getNr)
If Not objPAM Is Nothing Then
objPAM.CountBup = 0
End If
End If
Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' count BUPS for 20 seconds: should be about 5 BUPs
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "5 BUPs in 20s"
lngTime = GetTickCount()
Do
Sleep 500, True
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
Set objPAM = mSIRTStatemashine.GetPAM(Einbauplatz.getNr)
If Not objPAM Is Nothing Then
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
MSFlexGrid1.CellAlignment = MSFlexGridLib.flexAlignLeftCenter
MSFlexGrid1.text = objPAM.CountBup & " BUPs " & " (" & Int((GetTickCount() - lngTime) / 1000) & "s)"
MSFlexGrid1.CellBackColor = RGB(128, 255, 128)
End If
End If
End If
Next
If m_blnAbbruch Then
Exit Function
End If
Loop While GetTickCount() - lngTime <= 20000 And m_blnAbbruch = False
If m_blnAbbruch Then Exit Function
AutoSpaltenBreite MSFlexGrid1, lblAutosize
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' reset BUPs-Count again
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.eRegister Is Nothing Then
Set objPAM = mSIRTStatemashine.GetPAM(Einbauplatz.getNr)
If Not objPAM Is Nothing Then
objPAM.CountBup = 0
End If
End If
Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' count BUPs for 20 seconds: should be 0 BUPs
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "keine BUPs in 20s"
lngTime = GetTickCount()
Do
Sleep 500, True
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
Set objPAM = mSIRTStatemashine.GetPAM(Einbauplatz.getNr)
If Not objPAM Is Nothing Then
If objPAM.CountBup > 0 Then
MSFlexGrid1.CellBackColor = RGB(255, 128, 128)
Else
MSFlexGrid1.CellBackColor = RGB(255, 255, 128)
End If
MSFlexGrid1.CellAlignment = MSFlexGridLib.flexAlignLeftCenter
MSFlexGrid1.text = objPAM.CountBup & " BUPs (" & Int((GetTickCount() - lngTime) / 1000) & "s)"
End If
End If
End If
Next
If m_blnAbbruch Then Exit Function
Loop While GetTickCount() - lngTime < 20000 And m_blnAbbruch = False
If m_blnAbbruch Then Exit Function
AutoSpaltenBreite MSFlexGrid1, lblAutosize
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
Set objPAM = mSIRTStatemashine.GetPAM(Einbauplatz.getNr)
If Not objPAM Is Nothing Then
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
If objPAM.CountBup = 0 Then
' keine BUPs
MSFlexGrid1.CellBackColor = RGB(128, 255, 128)
Else
blnAllesOK = False
MSFlexGrid1.CellBackColor = RGB(255, 128, 128)
MsgBox ("eRegister " & Einbauplatz.getNr & " mit der Adresse " & objPAM.BUP.RadioAdr & " sendete noch BUPs!" & vbCrLf & "Die BUPs könnten von einem weiterem Werk mit derselben Funkadresse stammen. Bitte melden Sie das an den Prüfstellenleiter!")
WriteToLog "eRegister " & Einbauplatz.getNr & " mit der Adresse " & objPAM.BUP.RadioAdr & " sendete noch BUPs. Die BUPs könnten von einem weiterem Werk mit derselben Funkadresse stammen. Bitte melden Sie das an den Prüfstellenleiter!"
End If
End If
End If
End If
Next
WaitForNoMoreBups = blnAllesOK
mSIRTStatemashine.Stop
End Function
Private Sub cmdAbschluss_Click()
cmdAbschluss.Enabled = False
PruefungsAbschlussNeuerVako
cmdAbschluss.Enabled = True
End Sub
Private Sub Form_Load()
m_blnAbbruch = False
m_blnWeiter = False
Set m_SPS = g_App.getSPS
Set m_FMBus = g_App.getFMBus
Set m_Display = g_App.GetDisplay
SetupForm
Load_All_COM
Set mcol_BUPS = New Collection
cmdWeiter.Visible = False
FrameRegulierung.Visible = False
SetFlexgridRow Zeile_PZ_Ende, MSFlexGrid1, ""
PrintStatus "Setup Displays..."
SetupDisplay
PrintStatus "fertig."
Me.WindowState = 2 ' Maximiert
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode = 0 Then
' Button [X] wurde geklickt
If MsgBox("Möchten Sie den Vorgang bzw. Prüfung wirklich sofort beenden?", vbYesNo) = vbYes Then
m_blnAbbruch = True
Else
' Unload abbrechen
Cancel = True
End If
Else
Debug.Print UnloadMode
' unload Funktion wurde ausgeführt
m_blnAbbruch = True
End If
End Sub
Private Sub Form_Resize()
On Error Resume Next
'Flexgrid oben und links an die Kante
MSFlexGrid1.Left = 0
MSFlexGrid1.Top = 0
' Textausgabe auf gleicer Höhe
txtOut.Top = MSFlexGrid1.Top
If Me.ScaleWidth - MSFlexGrid1.Left - txtOut.Width > 0 Then
' MSFlexGrid1 in der Breite anpassen
MSFlexGrid1.Width = Me.ScaleWidth - MSFlexGrid1.Left - txtOut.Width
End If
If Me.ScaleHeight - StatusBar1.Height - frameVerwechselungskontrolle.Height - frameTest.Height > 0 Then
' MSFlexGrid1 in der Höhe anpassen
'MSFlexGrid1.Height = Me.ScaleHeight - 2 * cmdWeiter.Height - frameVerwechselungskontrolle.Height
MSFlexGrid1.Height = Me.ScaleHeight - StatusBar1.Height - frameVerwechselungskontrolle.Height - frameTest.Height
End If
If MSFlexGrid1.Height - MSFlexGridRZ.Height > 0 Then
'Textausgabe in der Höge anpassen,
txtOut.Height = MSFlexGrid1.Height - MSFlexGridRZ.Height
End If
' RZ Grid unter die Textausgabe, Höhe zusammen gleich der Flexgrid Höhe
MSFlexGridRZ.Top = txtOut.Top + txtOut.Height
' Textausgabe rechts neben dem FlexGrid
txtOut.Left = MSFlexGrid1.Left + MSFlexGrid1.Width
' RZ Grid rechts neben dem FlexGrid
MSFlexGridRZ.Left = txtOut.Left
' Test Frame unter das Grid
frameTest.Top = MSFlexGrid1.Top + MSFlexGrid1.Height
' Regulierungframe auf gleiche Höhe
FrameRegulierung.Top = frameTest.Top
' Verwechselungskontrolle unter die Regulierung
frameVerwechselungskontrolle.Top = frameTest.Top + frameTest.Height
frameButtons.Left = frameVerwechselungskontrolle.Left + frameVerwechselungskontrolle.Width
' auf gleicher Höhe
frameButtons.Top = frameVerwechselungskontrolle.Top
frameButtons.Height = frameVerwechselungskontrolle.Height
StatusBar1.Top = Me.ScaleHeight - StatusBar1.Height
' ProgressBar1 in die StatusBar
ProgressBar1.Top = MSFlexGrid1.Top + MSFlexGrid1.Height
ProgressBar1.Left = MSFlexGrid1.Left
ProgressBar1.Width = MSFlexGrid1.Width
' oben rechts
frmRegulierungErgebnisse.Top = MSFlexGrid1.Top
frmRegulierungErgebnisse.Left = MSFlexGrid1.Left + MSFlexGrid1.Width - frmRegulierungErgebnisse.Width
' unten rechts
frmOeffnenSchliessen.Top = MSFlexGrid1.Top + MSFlexGrid1.Height - frmOeffnenSchliessen.Height
frmOeffnenSchliessen.Left = MSFlexGrid1.Left + MSFlexGrid1.Width - frmOeffnenSchliessen.Width
ScrolleNachUnten
End Sub
Public Sub Load_All_COM()
Dim Einbauplatz As CEinbauplatz
For Each Einbauplatz In m_colEinbauplatz
' If Not Einbauplatz.getPruefzaehler Is Nothing Then
load MSComm1.Item(Einbauplatz.getNr)
' End If
Next
End Sub
Private Sub Unload_All_COM()
On Error Resume Next
Dim Einbauplatz As CEinbauplatz
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If MSComm1.Item(Einbauplatz.getNr).PortOpen = True Then
MSComm1.Item(Einbauplatz.getNr).PortOpen = False
End If
Unload MSComm1.Item(Einbauplatz.getNr)
End If
Next
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
StopOptoEmpfang
ReleaseSIRT
Unload_All_COM
m_blnAbbruch = True
End Sub
Private Sub HandleComPort(Index As Integer)
Dim intEinbauplatzNr As Integer
Dim intComEvent As Integer
Dim strComEvent As String
Dim intCrLfPosition As Integer
Dim strData As String
Dim arTelegramme() As String
Dim iAnzahlTeilZeilenendzeichen As Integer
Const ZEILENENDZEICHEN = vbCrLf
intEinbauplatzNr = Index
intComEvent = MSComm1(Index).CommEvent
If MSComm1(Index).PortOpen = False Then Exit Sub
Select Case intComEvent
' Errors
Case comEventBreak ' A Break was received.
strComEvent = "comEventBreak"
Case comEventCDTO ' CD (RLSD) Timeout.
strComEvent = "comEventCDTO"
Case comEventCTSTO ' CTS Timeout.
strComEvent = "comEventCTSTO"
Case comEventDSRTO ' DSR Timeout.
strComEvent = "comEventDSRTO"
Case comEventFrame ' Framing Error.
strComEvent = "comEventFrame"
Case comEventOverrun ' Data Lost.
strComEvent = "comEventOverrun"
Case comEventRxOver ' Receive buffer overflow.
strComEvent = "comEventRxOver"
Case comEventRxParity ' Parity Error.
strComEvent = "comEventRxParity"
Case comEventTxFull ' Transmit buffer full.
strComEvent = "comEventTxFull"
Case comEventDCB ' Unexpected error retrieving DCB]
strComEvent = "comEventDCB"
' Events
Case comEvCD ' Change in the CD line.
strComEvent = "comEvCD"
Case comEvCTS ' Change in the CTS line.
strComEvent = "comEvCTS"
Case comEvDSR ' Change in the DSR line.
strComEvent = "comEvDSR"
Case comEvRing ' Change in the Ring Indicator.
strComEvent = "comEvDSR"
Case comEvReceive ' Received RThreshold # of chars.
' Lese ale emfangene Daten in Einbauplatz eigenen Buffer
strData = MSComm1(Index).Input
strComEvent = "comEvReceive " & Len(strData) & " Zeichen: '" & strData & "'"
' an Buffer anhängen
mstrBuffer(Index) = mstrBuffer(Index) & strData
' Telegramme beim ZEILENENDZEICHEN aufsplitten
arTelegramme = Split(mstrBuffer(Index), ZEILENENDZEICHEN)
' letztes Telegramm vor dem letzten ZEILENENDZEICHEN
iAnzahlTeilZeilenendzeichen = UBound(arTelegramme)
If iAnzahlTeilZeilenendzeichen > 0 Then
' Es gibt ein Zeilenendzeichen, also
' letztes Telegramm bis zum Zeilenendzeichen lesen
strData = arTelegramme(UBound(arTelegramme) - 1)
' Prüfen auf notwendige Länge
If Len(strData) >= 45 Then
' ist mind 1 vollständiges Telegramm, dann verarbeiten
HandleOptotelegramm intEinbauplatzNr, strData
' nächstes Fragment ggF merken für nächstes Telegramm
mstrBuffer(Index) = arTelegramme(UBound(arTelegramme))
Else
' letztes Telegramm ist nicht vollständiges, also weitere Daten empfangen
Debug.Print "nicht vollständig " & strData
End If
Else
Debug.Print "Müll im Buffer: " & Len(mstrBuffer(Index)) & ": " & mstrBuffer(Index)
If Len(strData) >= 47 Then
mstrBuffer(Index) = ""
End If
End If
Case comEvSend ' There are SThreshold number of
' characters in the transmit buffer.
strComEvent = "comEvSend"
Case comEvEOF ' An EOF character was found in the
strComEvent = "comEvEOF"
Case Else
strComEvent = "unbekanntes MSComm Event"
End Select
If intComEvent <> 2 Then
' Debug.Print "COM " & MSComm1(Index).CommPort & " Event " & intComEvent & ": " & strComEvent
End If
End Sub
Private Sub MSComm1_OnComm(Index As Integer)
If mblnCOMBusy = True Then Exit Sub
mblnCOMBusy = True
HandleComPort (Index)
mblnCOMBusy = False
End Sub
Public Sub HandleOeffnenSchliessen(intEinbauplatz As Integer, strData As String)
lblHZNZ(intEinbauplatz).FontItalic = Not (lblHZNZ(intEinbauplatz).FontItalic = True)
If Val(strData) <> Val(m_sErsterZaehlerstand(intEinbauplatz)) Then
' Zählerstand hat sich gegenüber gemerkten Zählerstand geändert:
' anzeigen
lblAufZu(intEinbauplatz).caption = strData
' Schriftart dieses Einbauplatzes Fett machen
lblAufZu(intEinbauplatz).FontBold = True
' Schriftart des anderen Einbauplatzes NICHT fett machen
Select Case intEinbauplatz
Case 1
lblAufZu(2).FontBold = False
Case 2
lblAufZu(1).FontBold = False
Case 3
lblAufZu(4).FontBold = False
Case 4
lblAufZu(3).FontBold = False
End Select
' letzten Stand dieses Werkes merken
m_sErsterZaehlerstand(intEinbauplatz) = strData
End If
End Sub
Private Function HandleOptotelegramm(intEinbauplatzNr As Integer, strData As String) As Boolean
Dim Einbauplatz As CEinbauplatz
Dim eRegister As CeRegister
Dim arData() As String
Dim strCS As String
Dim strOriginalData As String
Dim blnWarteAufZaehlerfortschritt As Boolean
strOriginalData = strData
' Datenpaket am Tab in einzelne Datenblöcke aufsplitten
arData = Split(strData, vbTab)
'Checksumme prüfen
SetFlexgridRow Zeile_Pz_CRCFehler, MSFlexGrid1, "CRCFehler"
' Checksumme ist an Stelle 44,45 bzw am Ende
strCS = Right(strData, 2)
If Not CalculateCheckSum(strData) = strCS Then
' nicht korekt
MSFlexGrid1.TextMatrix(Zeile_Pz_CRCFehler, intEinbauplatzNr) = Val(MSFlexGrid1.TextMatrix(Zeile_Pz_CRCFehler, intEinbauplatzNr)) + 1
PrintStatus "CRC Fehler Ebp " & intEinbauplatzNr & " Länge=" & Len(strOriginalData) & ", Daten: " & strOriginalData
Exit Function
End If
' ab hier gibt es gültige Daten
Set Einbauplatz = m_colEinbauplatz.Item(intEinbauplatzNr)
If Einbauplatz.getPruefzaehler Is Nothing Then
' Sollte nicht vorkommen!
MsgBox "Fehler in HandleOptoTelegramm(): Einbauplatz(" & intEinbauplatzNr & ").getPruefzaehler Is Nothing!"
MSComm1(intEinbauplatzNr).PortOpen = False
Exit Function
End If
If m_Verbundzaehler_Pruefmodus = OEFFNEN Then
HandleOeffnenSchliessen intEinbauplatzNr, arData(2)
Exit Function
End If
If m_Verbundzaehler_Pruefmodus = SCHLIESSEN Then
HandleOeffnenSchliessen intEinbauplatzNr, arData(2)
Exit Function
End If
If m_blnCounterChangeDetection Then
blnWarteAufZaehlerfortschritt = True
Select Case m_Verbundzaehler_Pruefmodus
Case PRUEFMODUS.NUR_NZ
Select Case intEinbauplatzNr
Case 1, 3
' Ausnahme für WarteAufZählerfortschritt bei Verbundzählern: Bei kleinen Durchflüssen wenn nur Wasser durch den NZ fliest
' Hier ist KEIN Warten auf den Zählerfortschritt des HZ nötig, da kein Wasser durch den HZ fließt
blnWarteAufZaehlerfortschritt = False
PrintStatus "kein Warten auf Zählerfortschritt beim HZ an Ebp " & Einbauplatz.getNr & " da nur der NZ laufen dürfte."
End Select
Case PRUEFMODUS.NUR_HZ, PRUEFMODUS.HZ_NZ
Select Case intEinbauplatzNr
Case 2, 4
' Ausnahme für WarteAufZählerfortschritt bei Verbundzählern: Bei kleinen Durchflüssenoberhalb des Schiessendurchluss,
' wenn Wasser durch den HZ fliest, kann der Nebenzhler auch stehen
' Hier ist KEIN Warten auf den Zählerfortschritt des NZ angebracht
blnWarteAufZaehlerfortschritt = False
PrintStatus "kein Warten auf Zählerfortschritt beim NZ an Ebp " & Einbauplatz.getNr & " da nur der HZ laufen muss."
End Select
End Select
Else
blnWarteAufZaehlerfortschritt = False
End If
If blnWarteAufZaehlerfortschritt Then
' Wenn CounterChangeDetection
' nutze Formular-weites string Variablenfeld (für alle Einbauplätze 1-10) zum zwischenspeichern
' weitere Volumen erst nach erster Änderung verarbeiten
' und Port Schliessen
If m_sErsterZaehlerstand(Einbauplatz.getNr) = "" Then
' initialen Zaehlerstand diese Werkes zwischenspeichern
m_sErsterZaehlerstand(Einbauplatz.getNr) = arData(2)
PrintStatus "Ebp " & Einbauplatz.getNr & " Warte auf Zählerstand Wechsel von " & arData(2)
MSFlexGrid1.row = intEinbauplatzNr
MSFlexGrid1.col = Zeile_Pz_Volume
MSFlexGrid1.CellBackColor = RGB(128, 100, 255) 'Blau
Exit Function
Else
If Val(arData(2)) > Val(m_sErsterZaehlerstand(Einbauplatz.getNr)) Then
' Zählerstand hat sich erhöht
' weiter machen
PrintStatus "Ebp " & Einbauplatz.getNr & " Zählerstand-Wechsel von " & Val(m_sErsterZaehlerstand(Einbauplatz.getNr)) & " nach " & arData(2)
MSFlexGrid1.row = intEinbauplatzNr
MSFlexGrid1.col = Zeile_Pz_Volume
MSFlexGrid1.CellBackColor = vbWhite
Else
' Zählerstand hat sich noch nicht erhöht
' Verabeitung des Optotelegramm abbrechen
Exit Function
End If
End If
End If
' Port schliessen
MSComm1(intEinbauplatzNr).PortOpen = False
MSFlexGrid1.TextMatrix(fgZeile.Zeile_Pz_COM, intEinbauplatzNr) = MSComm1(intEinbauplatzNr).CommPort
PrintStatus "COM-Port " & MSComm1(intEinbauplatzNr).CommPort & " an " & intEinbauplatzNr & " wurde geschlossen"
If Einbauplatz.eRegister Is Nothing And Not Einbauplatz.getPruefzaehler Is Nothing Then
' Es wurde noch kein eRegister an diesem Einbauplatz festgelegt
' Dieser Teil wird nicht mehr ausgeführt, wenn vorher das eRegister aus der DB geladen wurde
Set Einbauplatz.eRegister = New CeRegister
If Einbauplatz.eRegister.loadForSerienNr(Einbauplatz.getPruefzaehler.getSerienNr) Then
SetFlexgridRow Zeile_Pz_FinalRadioAdr, MSFlexGrid1, "Finale Funkadr"
MSFlexGrid1.TextMatrix(fgZeile.Zeile_Pz_FinalRadioAdr, Einbauplatz.getNr) = Einbauplatz.eRegister.m_sRadioAdressFinal
Else
MsgBox ("Für die SerienNr " & Einbauplatz.getPruefzaehler.getSerienNr & " an Einbauplatz " & Einbauplatz.getNr & " gibt es keine eRegister-Daten in der Datenbank")
Set Einbauplatz.eRegister = New CeRegister
End If
Einbauplatz.eRegister.m_iEinbauplatzNr = intEinbauplatzNr
Einbauplatz.eRegister.m_sPCBid = arData(0)
Einbauplatz.eRegister.m_sRadioAdress = arData(1)
PrintStatus "Einbauplatz " & Einbauplatz.getNr & " sendete Opto Telegramm."
Else
' eRegister schon vorhanden, z.B. schon aus der Datenbank geladen oder bereits per Opto eingelesen.
' falls Einbauplatz noch nicht gesetzt
If Einbauplatz.eRegister.m_iEinbauplatzNr = 0 Then
Einbauplatz.eRegister.m_iEinbauplatzNr = intEinbauplatzNr
End If
' falls PCB ID noch nicht gesetzt
If Einbauplatz.eRegister.m_sPCBid = "" Then
' falls noch nicht aus DB geladen
Einbauplatz.eRegister.m_sPCBid = arData(0)
End If
Einbauplatz.eRegister.m_sRadioAdress = arData(1)
' falls Finale Funkadresse noch nicht gesetzt
If Einbauplatz.eRegister.m_sRadioAdressFinal <> "" Then
' aus DB
'SetFlexgridRow Zeile_Pz_FinalRadioAdr, MSFlexGrid1, "Finale Funkadr"
MSFlexGrid1.TextMatrix(fgZeile.Zeile_Pz_FinalRadioAdr, Einbauplatz.getNr) = Einbauplatz.eRegister.m_sRadioAdressFinal
Else
'SetFlexgridRow Zeile_Pz_FinalRadioAdr, MSFlexGrid1, "Finale Funkadr"
MSFlexGrid1.TextMatrix(fgZeile.Zeile_Pz_FinalRadioAdr, Einbauplatz.getNr) = " Fehlt !"
End If
End If
'''''''''''''''''''''''''''''
MSFlexGrid1.col = Einbauplatz.getNr
MSFlexGrid1.row = Zeile_Pz_PCBid
MSFlexGrid1.text = arData(0)
If Einbauplatz.eRegister.m_sPCBid <> "" And Einbauplatz.eRegister.m_sPCBid <> arData(0) Then
' PCB ID wurde geändert
MSFlexGrid1.CellBackColor = RGB(255, 255, 128) ' gelb
PrintStatus "PCB Id geändert am " & Einbauplatz.getNr & " von " & Einbauplatz.eRegister.m_sPCBid & " nach " & arData(0)
End If
Einbauplatz.eRegister.m_sPCBid = arData(0)
'''''''''''''''''''''''''''''
MSFlexGrid1.col = Einbauplatz.getNr
MSFlexGrid1.row = Zeile_Pz_RadioAdr
MSFlexGrid1.text = arData(1)
If Einbauplatz.eRegister.m_sRadioAdress <> "" And Einbauplatz.eRegister.m_sRadioAdress <> arData(1) Then
' aktuelle Radio Adresse wurde geändert
MSFlexGrid1.CellBackColor = RGB(255, 255, 128) ' gelb
PrintStatus "Funkadresse geändert am " & Einbauplatz.getNr & " von " & Einbauplatz.eRegister.m_sRadioAdress & " nach " & arData(1)
MSFlexGrid1.text = arData(1) & vbCrLf & "(" & Einbauplatz.eRegister.m_sRadioAdress & ")"
End If
Einbauplatz.eRegister.m_sRadioAdress = arData(1)
Einbauplatz.eRegister.m_sVolume = arData(2)
Einbauplatz.eRegister.m_sTime = arData(3)
'PrintStatus "Ebp " & Einbauplatz.getNr & " & Optotelegramm: " & strData
MSFlexGrid1.col = 0
SetFlexgridRow Zeile_Pz_PCBid, MSFlexGrid1, "PCB Id"
MSFlexGrid1.TextMatrix(MSFlexGrid1.row, Einbauplatz.getNr) = Right(Einbauplatz.eRegister.m_sPCBid, 9)
SetFlexgridRow Zeile_Pz_RadioAdr, MSFlexGrid1, "Radio Adr"
MSFlexGrid1.TextMatrix(MSFlexGrid1.row, Einbauplatz.getNr) = Einbauplatz.eRegister.m_sRadioAdress
SetFlexgridRow Zeile_Pz_Volume, MSFlexGrid1, "Volume"
MSFlexGrid1.TextMatrix(MSFlexGrid1.row, Einbauplatz.getNr) = Einbauplatz.eRegister.m_sVolume
SetFlexgridRow Zeile_Pz_Timestamp, MSFlexGrid1, "Timestamp"
MSFlexGrid1.TextMatrix(MSFlexGrid1.row, Einbauplatz.getNr) = Einbauplatz.eRegister.m_sTime
MSFlexGrid1.row = Zeile_Pz_Timestamp
MSFlexGrid1.col = Einbauplatz.getNr
If Not IsNumeric(Einbauplatz.eRegister.m_sTime) Then
' rot
MSFlexGrid1.CellBackColor = RGB(255, 128, 128)
Else
If MSFlexGrid1.CellBackColor = RGB(255, 255, 255) Then 'weiss
MSFlexGrid1.CellBackColor = RGB(228, 228, 228) ' grau
Else
MSFlexGrid1.CellBackColor = RGB(255, 255, 255) 'weiss
End If
End If
'Call UpdateDisplay(Einbauplatz)
AutoSpaltenBreite MSFlexGrid1, lblAutosize
End Function
' Berechnung der Checksumme vom eRegister Optotelegramm
' Input "Val 1] \t [Val 2] \t [Val 3] \t [Val 4] \t" ohne "CS" und CrLf !!
' Output 2-Byte Hex Wert:
Private Function CalculateCheckSum(strBytes) As String
Dim i As Integer
Dim iChecksum As Long
iChecksum = 0
' Bytesum([ Val 1 ] \t [ Val 2] \t [ Val 3] \t [ Val 4] \t) & 0xFF
For i = 1 To Len(strBytes) - 2
''Debug.Print i & ": " & Mid(strBytes, i, 1) & " = " & Asc(Mid(strBytes, i, 1)) & " sum=" & iChecksum
iChecksum = iChecksum + Asc(Mid(strBytes, i, 1))
Next
' (only one byte, higher bits will be cut off).
iChecksum = iChecksum And 255
' This binary 1-byte value is then converted into two ASCII bytes
CalculateCheckSum = Right("0" & Hex(iChecksum), 2)
End Function
Private Sub mSIRTStatemashine_OnStateChanged(ByVal sender As Variant, ByVal e As SIRTCOM.MyEventArgs)
Dim objPAM As SIRTCOM.PAM
Dim RadioAdd
Dim ret As Long
Dim EinbauplatzNr As Integer
Dim Einbauplatz As CEinbauplatz
Set objPAM = mSIRTStatemashine.GetPAM(e.EinbauplatzNr)
EinbauplatzNr = e.EinbauplatzNr
If EinbauplatzNr > 0 Then
Set Einbauplatz = m_colEinbauplatz(EinbauplatzNr)
Debug.Print "Einbauplatz " & EinbauplatzNr & " Event=" & e.Eventtype
Select Case e.Eventtype
Case 0, 1
' BUPs
Debug.Print "BUP"
Case 2
Debug.Print "2"
Case 8
' SEMI
Debug.Print "SEMI"
Log_To_eRegister_Radio_Log CCur(Einbauplatz.eRegister.m_sRadioAdress), "SEMI", objPAM.SEMI.HexData, "PAM_status=" & objPAM.SEMI.PAM_status & ", Time=" & objPAM.GetTime, EinbauplatzNr
Case 11
' DEBUG
Debug.Print "DEBUG"
Log_To_eRegister_Radio_Log CCur(Einbauplatz.eRegister.m_sRadioAdress), "DEBUG", objPAM.DEBUG.HexData, "Time=" & objPAM.GetTime, EinbauplatzNr
End Select
Else
Debug.Print "Einbaulatz = 0"
End If
End Sub
Public Function PrintDebugDezimal(strHexCode)
Dim i As Integer
Dim strHex As String
Dim strDez As String
For i = 1 To Len(strHexCode) Step 2
strHex = Mid(strHexCode, i, 2)
If strDez <> "" Then strDez = strDez & ","
strDez = strDez & Val("&h" & strHex)
Next
Debug.Print strDez
End Function
'' convert a 32 bit number 0 - 4294967295 to a 8 char Hex string
Public Function Hex8(curWert As Currency) As String
Dim curHigh As Currency
Dim curLow As Currency
curHigh = Int(curWert / 65536)
curLow = curWert - curHigh * 65536
Hex8 = Right("000" & Hex(curHigh), 4) & Right("000" & Hex(curLow), 4)
End Function
Private Sub cmdVerwKonrolle_Click()
m_PAMZeile = MSFlexGrid1.Rows
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim eRegister As CeRegister
Dim eRegister_Auftragposition As CeRegister_Auftragposition
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
Set eRegister_Auftragposition = New CeRegister_Auftragposition
If eRegister_Auftragposition.LoadForFertigungsAuftragNr(Pruefzaehler.getAuftragPosition.GetFertigungsauftragNr) Then
Pruefzaehler.getAuftragPositionSerienNr.setStatusFertigung 30
Set eRegister = New CeRegister
eRegister.loadForSerienNr Pruefzaehler.getSerienNr
Set Einbauplatz.eRegister = eRegister
Einbauplatz.eRegister.m_StateClosed = False
Set Einbauplatz.eRegister.mobj_eRegister_Auftragposition = eRegister_Auftragposition
MSFlexGrid1.row = fgZeile.Zeile_Pz_FinalRadioAdr
MSFlexGrid1.col = 0
MSFlexGrid1.text = "Finale Funkadr."
MSFlexGrid1.col = Einbauplatz.getNr
MSFlexGrid1.text = eRegister.m_sRadioAdressFinal
MSFlexGrid1.row = fgZeile.Zeile_Pz_State
MSFlexGrid1.col = 0
MSFlexGrid1.text = "Status"
MSFlexGrid1.col = Einbauplatz.getNr
MSFlexGrid1.text = IIf(eRegister.m_StateClosed, "geschlossen", "offen")
Else
MsgBox "Keine eReg_AP für " & Einbauplatz.getNr
End If
End If
Next
AutoSpaltenBreite MSFlexGrid1, lblAutosize
If Verwechselungskontrolle() Then
MsgBox " Verwechselungskontrolle fertig"
Else
MsgBox "Err"
End If
End Sub
Public Function Verwechselungskontrolle() As Boolean
Dim Einbauplatz As CEinbauplatz
' gibt false zurück, falls Abbruch Button gedrückt wurde
cmdCancel.Enabled = True
m_blnAbbruch = False
frameVerwechselungskontrolle.Visible = True
txtBarcodeScanner.Enabled = True
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "Verw.Kontrolle"
Verwechselungskontrolle_Reset
txtBarcodeScanner.SetFocus
Do
SleepWithEvents 200, True
Loop While Not m_blnAbbruch And Not Verwechselungskontrolle_Erfolgreich()
If Not m_blnAbbruch Then
PrintStatus "Verwechselungskontrolle erfolgreich durchlaufen"
End If
frameVerwechselungskontrolle.Visible = False
txtBarcodeScanner.Enabled = False
Verwechselungskontrolle = Not m_blnAbbruch
End Function
Private Function Verwechselungskontrolle_Erfolgreich() As Boolean
' gibt true zurück, wenn Verwechselungskontrolle für alle Einbauplätze erfolgreich verlaufen ist, sonst false
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim eRegister As CeRegister
Dim eRegister_Augftragposition As CeRegister_Auftragposition
Dim strCSD As String
Verwechselungskontrolle_Erfolgreich = True
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
Set eRegister = Einbauplatz.eRegister
If Not eRegister Is Nothing Then
strCSD = eRegister.mstr_CSD
' nur für offene Werke mit erfolgreicher Prüfung findet eine Verwechselungskontrolle statt
If Pruefzaehler.getAuftragPositionSerienNr.getStatusFertigung >= 30 And Einbauplatz.eRegister.m_StateClosed = False Then
If eRegister.m_VerwechslungkontrollStatus <> SCAN_FADR2 Then
' noch nicht fertig
Select Case strCSD
Case "CSD 769400"
' End-Status für einen Einbauplatz ist noch nicht erreicht für Arquiva Thames Water
Verwechselungskontrolle_Erfolgreich = False
Case Else
' andere CSDs keine Vervechselungskontrolle nötig
Einbauplatz.eRegister.m_StateClosingAllowed = True
End Select
End If 'Scan Status
End If 'Schloss/Prüf-Status
Else
' kein eRegister mehr eingebaut
End If
End If
Next
End Function
Private Sub Verwechselungskontrolle_Reset()
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim eRegister As CeRegister
MSFlexGrid1.row = MSFlexGrid1.Rows - 1
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
MSFlexGrid1.col = Einbauplatz.getNr
Set eRegister = Einbauplatz.eRegister
If Not eRegister Is Nothing Then
' eRegister
If Not Einbauplatz.eRegister.mobj_eRegister_Auftragposition Is Nothing Then
' eRegister Auftragposition
Select Case Einbauplatz.eRegister.mstr_CSD
Case "CSD 769400"
' CSD Thames Water
' nur für offene erfolgreich geprüfte Zähler findet eine Verwechselungskontrolle statt
If Not eRegister.m_StateClosed And Pruefzaehler.getAuftragPositionSerienNr.getStatusFertigung >= 30 Then
SetScanState Einbauplatz.getNr, SCAN_START
Else
MSFlexGrid1.text = " - "
setStatusOnDisplay Einbauplatz.getNr, "kein Scan notw."
End If
Case Else
End Select
End If
Else
setStatusOnDisplay Einbauplatz.getNr, "kein eRegister"
End If
Else
setStatusOnDisplay Einbauplatz.getNr, "kein Zähler"
End If
Next
End Sub
Private Sub txtBarcodeScanner_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
ProcessScannerInput
txtBarcodeScanner.text = ""
End If
End Sub
Private Sub ProcessScannerInput()
Dim curEingabe As Currency
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim eRegister As CeRegister
Dim strEingabe As String
' Statemashine
lblBarcodeScan.caption = ""
WriteToLog "Gescannt: '" & txtBarcodeScanner.text & "'"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If txtBarcodeScanner.text = "reinhard" Then
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.eRegister Is Nothing Then
Einbauplatz.eRegister.m_StateClosingAllowed = True
Einbauplatz.eRegister.m_VerwechslungkontrollStatus = SCAN_FADR2
End If
Next
Exit Sub
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
strEingabe = Trim(txtBarcodeScanner.text)
curEingabe = Val(txtBarcodeScanner.text)
If UBound(Split(txtBarcodeScanner.text, " ")) > 0 Then
' hier gibt es mehr als ein Wort, also letztes verwenden, z.B. bei SerienNr mit "MSE ..."
curEingabe = Val(Split(txtBarcodeScanner.text, " ")(UBound(Split(txtBarcodeScanner.text, " "))))
End If
If curEingabe >= 1 And curEingabe <= 10 Then
' Es wurde ein Einbauplatz gescannt
If m_iGescannterEinbauplatz > 0 Then
' es wurde in einem der vorherigen Scans bereits ein Einbauplatz gescannt
MSFlexGrid1.col = m_iGescannterEinbauplatz
If MSFlexGrid1.CellBackColor <> vbGreen And MSFlexGrid1.CellBackColor <> RGB(128, 255, 128) Then
' unfertige zurücksetzen
MSFlexGrid1.text = ""
MSFlexGrid1.CellBackColor = vbWhite
SetScanState m_iGescannterEinbauplatz, SCAN_START
End If
End If
m_iGescannterEinbauplatz = CInt(curEingabe)
Set Einbauplatz = m_colEinbauplatz(m_iGescannterEinbauplatz)
If Einbauplatz.eRegister Is Nothing Or Einbauplatz.getPruefzaehler Is Nothing Then
lblBarcodeScan.caption = "Am Einbauplatz " & m_iGescannterEinbauplatz & " ist kein eRegister-Werk eingebaut oder es wurde für den weiteren Prozess deaktiviert."
m_iGescannterEinbauplatz = 0
lblEinbauplatzNr.caption = ""
Else
lblEinbauplatzNr.caption = m_iGescannterEinbauplatz
SetScanState m_iGescannterEinbauplatz, SCAN_EBP
End If
ElseIf curEingabe > 10 And m_iGescannterEinbauplatz > 0 Then
' es wurde entweder eine SerienNr oder Funkadresse gescannt, nachdem der Einbauplatz festgelegt wurde
Set Einbauplatz = m_colEinbauplatz(m_iGescannterEinbauplatz)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
Set eRegister = Einbauplatz.eRegister
If Not eRegister Is Nothing Then
MSFlexGrid1.col = Einbauplatz.getNr
Select Case eRegister.m_VerwechslungkontrollStatus
Case CONTROL_STATES.SCAN_EBP
' Einbauplatz war bereits gescannt
If strEingabe = "10" & Val(eRegister.m_sRadioAdressFinal) Then
' Funkadresse wurde gescannt
SetScanState m_iGescannterEinbauplatz, SCAN_FADR1
Else
lblBarcodeScan.caption = "Funkadresse stimmt nicht überein!" & vbCrLf & "Bitte Funkadresse scannen!"
End If
Case CONTROL_STATES.SCAN_FADR1
If strEingabe = "MSE " & Right(eRegister.m_sRadioAdressFinal, 9) Then
' MSE 319000xxx = MSE + letzten 9 Stellen der Funkadresse
SetScanState m_iGescannterEinbauplatz, SCAN_SNR
ElseIf strEingabe = Right(eRegister.m_sRadioAdressFinal, 9) Then
' Normalfall Thames
' 319000xxx = letzten 9 Stellen der Funkadresse
SetScanState m_iGescannterEinbauplatz, SCAN_SNR
ElseIf strEingabe = "MSE " & CStr(Pruefzaehler.getSerienNr) Then
' MSE 15712344
SetScanState m_iGescannterEinbauplatz, SCAN_SNR
ElseIf strEingabe = CStr(Pruefzaehler.getSerienNr) Then
' SerienNr
SetScanState m_iGescannterEinbauplatz, SCAN_SNR
Else
lblBarcodeScan.caption = "Seriennr stimmt nicht überein!" & vbCrLf & "Bitte Seriennr scannen!"
End If
Case CONTROL_STATES.SCAN_SNR
' Einbauplatz, Fadr, SerienNr waren gescannt
If strEingabe = "10" & Val(eRegister.m_sRadioAdressFinal) Then
' Funkadresse 2 erkannt
SetScanState m_iGescannterEinbauplatz, SCAN_FADR2
' Hiermit erhält das eRegister die Erlaubnis "darf abgeschlossen werden" aber nur bei erfolgreicher Prüfung
If Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getStatusFertigung >= 30 Then
eRegister.m_StateClosingAllowed = True
End If
Else
lblBarcodeScan.caption = "Funkadresse stimmt nicht überein. Bitte Funkadresse scannen."
End If
Case CONTROL_STATES.SCAN_FADR2
lblBarcodeScan.caption = "Die Verwechselungskontrolle für diesen Einbauplatz ist OK. Bitte neuen Einbauplatz scannen!"
setStatusOnDisplay m_iGescannterEinbauplatz, "nächst. Ebp!"
End Select
End If
End If
Else
If m_iGescannterEinbauplatz = 0 Then
lblBarcodeScan.caption = "Bitte Einbauplatz scannen!"
End If
End If
End Sub
Private Function setStatusOnDisplay(EinbauplatzNr As Integer, strMeldung As String)
WriteToLog "sende an Display " & EinbauplatzNr & ": '" & strMeldung & "'"
Debug.Print "An Display " & EinbauplatzNr & ": " & strMeldung
If Not m_Display Is Nothing Then
m_Display.Adressierung EinbauplatzNr
Sleep 100
m_Display.PlaceAusgabe strMeldung, 10, 30, 140, 39
End If
End Function
Private Sub SetScanState(EinbauplatzNr As Integer, Status As CONTROL_STATES)
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim eRegister As CeRegister
MSFlexGrid1.row = MSFlexGrid1.Rows - 1
MSFlexGrid1.col = EinbauplatzNr
MSFlexGrid1.text = ""
MSFlexGrid1.CellBackColor = vbWhite
Set Einbauplatz = m_colEinbauplatz(EinbauplatzNr)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
Set eRegister = Einbauplatz.eRegister
If Not eRegister Is Nothing Then
eRegister.m_VerwechslungkontrollStatus = Status
Select Case Status
Case CONTROL_STATES.SCAN_START
MSFlexGrid1.CellBackColor = vbWhite
MSFlexGrid1.text = "0/4"
setStatusOnDisplay EinbauplatzNr, "Bitte Ebp scannen!"
lblBarcodeScan.caption = "Bitte Einbauplatz scannen!"
Case CONTROL_STATES.SCAN_EBP
MSFlexGrid1.text = "1/4"
MSFlexGrid1.CellBackColor = RGB(255, 255, 128)
setStatusOnDisplay m_iGescannterEinbauplatz, "FAdr (Etikett) scannen"
lblBarcodeScan.caption = "Bitte Funkadresse auf Etikett scannen!"
Case CONTROL_STATES.SCAN_FADR1
MSFlexGrid1.text = "2/4"
MSFlexGrid1.CellBackColor = RGB(255, 255, 128)
setStatusOnDisplay m_iGescannterEinbauplatz, "SerienNr scannen"
lblBarcodeScan.caption = "Bitte Seriennummer scannen!"
Case CONTROL_STATES.SCAN_SNR
MSFlexGrid1.text = "3/4"
MSFlexGrid1.CellBackColor = RGB(255, 255, 128)
setStatusOnDisplay m_iGescannterEinbauplatz, "FAdr (gelasert) scannen"
lblBarcodeScan.caption = "Bitte gelaserte Funkadresse scannen!"
Case CONTROL_STATES.SCAN_FADR2
MSFlexGrid1.text = "OK"
MSFlexGrid1.CellBackColor = RGB(128, 255, 128)
setStatusOnDisplay m_iGescannterEinbauplatz, "Scannen OK"
lblBarcodeScan.caption = "Scannen fertig f. Einbauplatz " & Einbauplatz.getNr
Case Else
MSFlexGrid1.text = "??"
MSFlexGrid1.CellBackColor = vbRed
End Select
End If
End If
End Sub
Private Sub txtBarcodeScanner_LostFocus()
If frameVerwechselungskontrolle.Visible Then
Timer1.Interval = 1000
Timer1.Enabled = True
End If
End Sub
Private Sub Timer1_Timer()
Timer1.Enabled = False
If txtBarcodeScanner.Enabled Then
txtBarcodeScanner.SetFocus
End If
End Sub
Private Function ProvideAuthLevelHexCommand(bLevel As Byte) As String
Select Case bLevel
Case 1
ProvideAuthLevelHexCommand = "4301143068D0"
Case 2
ProvideAuthLevelHexCommand = "4302140E8040"
Case 3
ProvideAuthLevelHexCommand = "430363937322"
End Select
End Function
Private Function GetDEBUG() As Boolean
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim eRegister As CeRegister
Dim Laenge As Byte
Dim strCMDHex As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Get debug: PAM 31 + 2 Data Bytes, Single Cmd, Auth Level 3
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
MSFlexGrid1.col = Einbauplatz.getNr
If Not Pruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
strCMDHex = "1F0000"
If Einbauplatz.eRegister.m_StateClosed Then
' PIN festlegen
strCMDHex = strCMDHex & ProvideAuthLevelHexCommand(3)
Einbauplatz.eRegister.m_bUseKey = True
Else
Einbauplatz.eRegister.m_bUseKey = False
End If
Laenge = Len(strCMDHex) / 2
strCMDHex = Hex2(Laenge) & strCMDHex
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
End If
End If
Next
GetDEBUG = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("GetDEBUG", 16, False, True)
End Function
Public Sub LED_Aus_Sleep()
' LED aus
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "LED aus"
Sende_LED False
' somit wieder mit Magneten weckbar
GoSleepWUPIV 3
End Sub
Public Function LED_Einschalten(Optional byteTimeMinuten As Byte = 255) As Boolean
' LED wird für byteTimeMinuten Minuten eingeschaltet
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "LED (aus)"
LED_Einschalten = Sende_LED(False, False, True, 0)
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "LED ein " & byteTimeMinuten
LED_Einschalten = Sende_LED(True, False, True, byteTimeMinuten)
End Function
Public Function Sende_LED(blnEinschalten As Boolean, Optional blnMitStatus As Boolean = False, Optional blnDEBUGRequired As Boolean = False, Optional byteZeitInMin As Byte = 60) As Boolean
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim eRegister As CeRegister
Dim Laenge As Byte
Dim strCMDHex As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Get debug: PAM 31 + 2 Data Bytes, Single Cmd, Auth Level 3
' Data Bytes:
' 3C 08 : LED ein 3C = 60 minuten
' 00 08 : LED aus
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
strCMDHex = ""
MSFlexGrid1.col = Einbauplatz.getNr
If Not Pruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
strCMDHex = ""
If blnEinschalten Then
If blnMitStatus Then
' LED Status berücksichtigen
If Einbauplatz.eRegister.m_StateLEDan = False Then
'nur einschalten wenn aus
strCMDHex = "1F" & Hex2(byteZeitInMin) & "08" 'LED einschalten f. byteZeitInMin Minuten
Else
' nicht nötig
End If
Else
' immer einschalten
strCMDHex = "1F" & Hex2(byteZeitInMin) & "08" 'LED einschalten f. byteZeitInMin Minuten
End If
Else
If blnMitStatus Then
'nur ausschalten wenn ein
If Einbauplatz.eRegister.m_StateLEDan = True Then
strCMDHex = "1F0008" 'LED ausschalten
Else
MSFlexGrid1.text = "(ist aus)"
MSFlexGrid1.CellBackColor = RGB(128, 255, 128)
' nicht nötig
End If
Else
' immer ausschalten
strCMDHex = "1F0008" 'LED ausschalten
End If
End If
If strCMDHex <> "" Then
If Einbauplatz.eRegister.m_StateClosed Then
' PIN festlegen
strCMDHex = strCMDHex & ProvideAuthLevelHexCommand(3)
Einbauplatz.eRegister.m_bUseKey = True
Else
Einbauplatz.eRegister.m_bUseKey = False
End If
Laenge = Len(strCMDHex) / 2
strCMDHex = Hex2(Laenge) & strCMDHex
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
End If
End If
End If
Next
Sende_LED = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi(IIf(blnEinschalten, "LED ein " & byteZeitInMin, "LED aus"), , , blnDEBUGRequired)
' LED Status merken
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.eRegister Is Nothing Then
If Not Einbauplatz.eRegister.m_lastSEMI Is Nothing Then
If Einbauplatz.eRegister.m_lastSEMI.PAM_status = 0 Then
PrintStatus "Opto LED an Ebp " & Einbauplatz.getNr & " ist " & IIf(blnEinschalten, "an", "aus")
Einbauplatz.eRegister.m_StateLEDan = blnEinschalten
End If
End If
End If
Next
End Function
Function BatteryRemainingMinutes(Rel_Time As Long) As Long
If Rel_Time >= 32768 Then
BatteryRemainingMinutes = (Rel_Time - 32768) * 360
Else
BatteryRemainingMinutes = Rel_Time
End If
End Function
Private Function Battery_Remaining_UberpruefenOK() As Boolean
On Error GoTo Errorhandler
Dim Einbauplatz As CEinbauplatz
Dim lngRelativeTime As Long
Dim lngGrenzwert As Long
Dim dblGrenzwert As Double
Dim strGrenzwert As String
Dim strText As String
Dim blnGrenzwertUeberschritten As Boolean
Const Section = "Pruefstation_eRegister"
Const KEY = "Required_Battery_Remaining_Years"
dblGrenzwert = 0
' erst mal annehmen, dass alle Batterielebensdauern OK sind
Battery_Remaining_UberpruefenOK = True
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "Batt Remain."
For Each Einbauplatz In m_colEinbauplatz
MSFlexGrid1.col = Einbauplatz.getNr
If Not Einbauplatz.eRegister Is Nothing Then
MSFlexGrid1.col = Einbauplatz.getNr
If Not Einbauplatz.eRegister.m_lastSEMI Is Nothing Then
' 4 Byte Wert in 6 Stunden-Einheiten
lngRelativeTime = Einbauplatz.eRegister.m_lastSEMI.Battery_Remaining
' unterer Grenzwert in 6 Stunden-Einheiten
lngGrenzwert = Get_Battery_Remaining_Minimum_Lifetime(Einbauplatz.eRegister)
' bestehende Batterielebensdauer umrechnen in Jahren
MSFlexGrid1.text = Format(BatteryRemainingMinutes(lngRelativeTime - 32768) / 4 / 365, "0.00") & " Jahre"
Debug.Print MSFlexGrid1.text
If lngRelativeTime <= lngGrenzwert Then
Battery_Remaining_UberpruefenOK = False
MSFlexGrid1.CellBackColor = vbRed Or 8421504
AutoSpaltenBreite MSFlexGrid1, lblAutosize
MsgBox "Die verbleibende Zeit der Batterie = " & Round(BatteryRemainingMinutes(lngRelativeTime) / 60 / 24 / 365, 3) & " Jahre" & vbCrLf & " ist kleiner als " & Round(BatteryRemainingMinutes(lngGrenzwert) / 60 / 24 / 365, 3) & " Jahre." & vbCrLf & "Tauschen Sie das Werk an Einbauplatz " & Einbauplatz.getNr & " aus und informieren Sie die Qualitätssicherung!", vbCritical, "eRegister Werk an Einbauplatz " & Einbauplatz.getNr
Else
PrintStatus "Einbauplatz " & Einbauplatz.getNr & ": Die verbleibende Zeit der Batterie = " & Round(BatteryRemainingMinutes(lngRelativeTime) / 60 / 24 / 365, 3) & " Jahre ist größer als " & Round(BatteryRemainingMinutes(lngGrenzwert) / 60 / 24 / 365, 3) & " Jahre."
AutoSpaltenBreite MSFlexGrid1, lblAutosize
If BatteryRemainingMinutes(lngRelativeTime - 32768) / 4 / 365 >= 15 Then
MSFlexGrid1.CellBackColor = vbGreen Or 8421504
Else
MSFlexGrid1.CellBackColor = vbYellow Or 8421504
End If
End If
End If
End If
Next
If Battery_Remaining_UberpruefenOK = False Then
' wenn Batterielebensdauer unterschiritten ist, dem Versuchprüfer noch ein eChance geben
If g_blnVersuch Then
' Versuchprüfer darf weitermachen
If MsgBox("Als Versuchs-Prüfer dürfen sie weiter prüfen. Möchten Sie fortfahren?" & vbCrLf & "Mit 'Nein' brechen Sie den aktuellen Vorgang ab.", vbYesNo Or vbDefaultButton1, "Battery Remaining war zu klein.") = vbNo Then
Battery_Remaining_UberpruefenOK = False
Exit Function
Else
Battery_Remaining_UberpruefenOK = True
Exit Function
End If
End If
strText = ""
strText = strText & "Mind. eine Batterielebensdauer ist kleiner als " & Format(BatteryRemainingMinutes(lngGrenzwert - 32768) / 4 / 365, "0.00") & " Jahre!" & vbCrLf
strText = strText & "Beachten Sie, dass für Arquiva Aufträge mind. 15,00 Jahre gelten." & vbCrLf
strText = strText & "Mit 'nein' brechen Sie den aktuellen Vorgang ab um die betroffenen Werke auszutauschen." & vbCrLf
strText = strText & vbCrLf
strText = strText & "Sind Sie absolut sicher, dass sie weiter prüfen dürfen?" & vbCrLf
If MsgBox(strText, vbYesNo Or vbDefaultButton2, "Battery Remaining war zu klein.") = vbNo Then
Battery_Remaining_UberpruefenOK = False
Exit Function
End If
End If
Battery_Remaining_UberpruefenOK = True
Exit Function
Errorhandler:
MsgBox "Fehler " & Err.Number & " in Battery_Remaining_UberpruefenOK(): " & Err.Description & vbCrLf & "GlobaleEinstellungen " & Section & "|" & KEY & "= '" & strGrenzwert & "'." & vbCrLf & Err.Description
Battery_Remaining_UberpruefenOK = False
End Function
' Gibt die verbleibende Lebensdauer der Batterie in 6 Stunden an
Private Function Get_Battery_Remaining_Minimum_Lifetime(eRegister As CeRegister) As Double
Dim dblGrenzwert As Double
Dim strCSD As String
Dim strGrenzwert As String
Const Section = "Pruefstation_eRegister"
Const KEY = "Required_Battery_Remaining_Years"
strCSD = Replace(eRegister.mobj_eRegister_Auftragposition.mstrCSD_Herkunft, "CSD ", "")
If Now() < CDate(#7/1/2018#) And eRegister.mobj_eRegister_Auftragposition.mint_RadioFrequency = 868 And strCSD <> "769400" Then
'=== Ausnahme ===
' Für den Zeitraum bis zum 30.6.2018 23:59
' sollen eine Menge eRegister Werke mit der Frequenz 868 Mhz
' auch mit der minimalen Batterielebensdauer 14,5 Jahren produziert werden dürfen
' gilt aber nicht für Thames Water, CSD 769400
dblGrenzwert = 14.5
PrintStatus "Ausnahme Batterielebensdauer 868 Mhz, CSD '" & strCSD & "' bis zum 30.6.2018: " & dblGrenzwert & " Jahre"
Else
' Default
' gilt für Thames Water
' gilt auch für jeden Auftrag für die Zeit nach dem 30.6.2018
' gilt für alle 433 Mhz
strGrenzwert = Trim(GetGlobaleEinstellung("Pruefstation_eRegister", "Required_Battery_Remaining_Years"))
If IsNumeric(strGrenzwert) Then
dblGrenzwert = CDbl(strGrenzwert)
Else
MsgBox "GlobaleEinstellung: Pruefstation_eRegister/Required_Battery_Remaining_Years=" & strGrenzwert & " ist nicht numerisch!"
dblGrenzwert = 99999
Exit Function
End If
End If
' Generelle Lebensdauer in 6 Stunden Einheiten
dblGrenzwert = dblGrenzwert * 365 ' in Tagen
dblGrenzwert = dblGrenzwert * 24 ' in Stunden
dblGrenzwert = dblGrenzwert / 6 ' in 6 Stunden Einheiten
dblGrenzwert = dblGrenzwert + 32768 ' Grenzwert
Get_Battery_Remaining_Minimum_Lifetime = dblGrenzwert
End Function
' Überprüft die (Radio-/Metrology-) FW Versionen
' gibt true zurück, wenn weiter geprüft werden darf
' Produktion: es muss ein zum eRegister passenden Eintrag in der Tabelle [eRegister_FW_Versionen] vorhanden sein
' Versuch: ein Versuchprüfer darf weiter prüfen
' gibt false zurück, wenn die Prüfung nicht forgefahren werden darf
Private Function FW_Versionen_Ueberpruefen() As Boolean
Dim Einbauplatz As CEinbauplatz
Dim strRadioVersion As String
Dim strMetrologyFWVersion As String
Dim strDebugHexdata As String
Dim objDEBUG As SIRTCOM.DEBUG
Dim objPAM As SIRTCOM.PAM
Dim strSQL As String
Dim rs As CRecordset
On Error GoTo Errorhandler
FW_Versionen_Ueberpruefen = True ' Default ist True. Wird false, wenn die Version eines Einbauplatzes nicht passt
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "FW Version"
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
MSFlexGrid1.col = Einbauplatz.getNr
Set objPAM = mSIRTStatemashine.GetPAM(Einbauplatz.getNr)
If Not objPAM Is Nothing Then
' DEBUG aus der letzen PAM betrachten
Set objDEBUG = objPAM.DEBUG
If Not objDEBUG Is Nothing Then
' Debug-Data fängt offiziell mit dem AppCode an Stelle 17 an.
strDebugHexdata = Mid(Replace(objDEBUG.HexData, " ", ""), 8 * 2 + 1)
' Extrahierem der FW Versionen im richtigen Format
strRadioVersion = Format(Mid(strDebugHexdata, 9 * 2 - 1, 4), "#\.#\.##")
Einbauplatz.eRegister.m_strRadio_FW_Version = strRadioVersion
strMetrologyFWVersion = Format(Mid(strDebugHexdata, 11 * 2 - 1, 4), "#\.#\.##")
Einbauplatz.eRegister.m_strMetrology_FW_Version = strMetrologyFWVersion
' Anzeigen
MSFlexGrid1.text = strRadioVersion & " " & strMetrologyFWVersion
Select Case Einbauplatz.getPruefzaehler.getAuftrag.getKundenNr
Case 764890 ' Carei Rumänien
If Val(Replace(strMetrologyFWVersion, ".", "")) < 1108 Then
MsgBox "Die am Einbauplatz " & Einbauplatz.getNr & " detektierte Firmware Version RadioFW:" & strRadioVersion & "," & vbCrLf & "MetrologFW:" & strMetrologyFWVersion & " ist für die KundenNr " & Einbauplatz.getPruefzaehler.getAuftrag.getKundenNr & " nicht zugelassen! " & vbCrLf & _
"1.1.08 oder höher erforderlich! Bitte informieren Sie die Qualitätssicherung!"
' Produktion darf nicht weiterprüfen.
FW_Versionen_Ueberpruefen = False
End If
' andere KundenNr
Case Else
End Select
' Siehe Mail Mo 14.08.2017 11:20 von Thomas Eske
' Diese Kunden dürfen nur neuste FW Versionen bekommen:
' Arqiva CSD 769400 / CSD 770951
' Veolia Frankreich CSD 766489
' Veolia UK CSD 38502
' Veolia Bukarest (Hagen Rumänien) Kunde Carei CSD 764890 (neuer CSD)
' Mainline (Sensus England) Erhält nur 433 MHz (ist bereits neue FW)
Select Case Einbauplatz.eRegister.mstr_CSD
Case "CSD 769400", "CSD 770951", "CSD 766489", "CSD 38502", "CSD 764890"
If Val(Replace(strMetrologyFWVersion, ".", "")) < 1108 Then
' diese Kunden müssen mind. FW 1.1.08 bekommen
MsgBox "Die am Einbauplatz " & Einbauplatz.getNr & " detektierte Firmware Version RadioFW:" & strRadioVersion & "," & vbCrLf & "MetrologFW:" & strMetrologyFWVersion & " ist für das gültige CSD (" & Einbauplatz.eRegister.mstr_CSD & ") nicht zugelassen! " & vbCrLf & _
"Bitte informieren Sie die Qualitätssicherung!"
' Produktion darf nicht weiterprüfen.
FW_Versionen_Ueberpruefen = False
Exit Function
End If
Case Else
' für diese Kunden gilt keine keine Sonderregel
End Select
'''''''''''''''''''''''''''
' Suchen der FW Kombination in der Datenbank für Versuch oder Produktion
strSQL = "SELECT * from [eRegister_FW_Versionen] "
strSQL = strSQL & " where ([Radio_FW_Version] = '" & strRadioVersion & "' or [Radio_FW_Version] is null) "
strSQL = strSQL & " and ([Metrology_FW_Version] = '" & strMetrologyFWVersion & "' or [Metrology_FW_Version] is null)"
If Not g_blnVersuch Then
' Firmware Versionen die für die Produktion zugelassen ist
strSQL = strSQL & " and [Produktion] = 1 "
Else
' Firmware Versionen die für den Versuch zugelassen ist
strSQL = strSQL & " and [Versuch] = 1 "
End If
'''''''''''''''''''''''''''
Debug.Print strSQL
Set rs = New CRecordset
rs.openRS strSQL, True
If rs.EOF Then
' FW nicht in der Liste unter den erlaubten FW gefunden
MSFlexGrid1.CellBackColor = RGB(255, 128, 128) ' hellrot
MsgBox "Die am Einbauplatz " & Einbauplatz.getNr & " detektierte Firmware Version Radio:" & strRadioVersion & " / Metrol.:" & strMetrologyFWVersion & " ist für die Produktion nicht zugelassen! " & vbCrLf & _
"Bitte informieren Sie die Qualitätssicherung!"
' Produktion darf nicht weiterprüfen.
FW_Versionen_Ueberpruefen = False
Else
' FW wurde in der Liste der erlaubten gefunden
MSFlexGrid1.CellBackColor = RGB(128, 255, 128) ' hell grün
End If
'''''''''''''''''''''''''''
End If 'objDEBUG Is Nothing
End If 'objPAM Is Nothing
End If 'Einbauplatz.eRegister Is Nothing
End If 'Einbauplatz.getPruefzaehler Is Nothing
Next 'Each Einbauplatz
' If g_blnVersuch And FW_Versionen_Ueberpruefen = False Then
' ' Versuchprüfer darf weitermachen, auch wenn FW Version fehlerhaft ist
' If MsgBox("Als Versuchs-Prüfer dürfen sie weiter prüfen. Möchten Sie fortfahren?" & vbCrLf & "Mit 'Nein' brechen Sie den aktuellen Vorgang ab.", vbYesNo Or vbDefaultButton1, "FW Revision war zu klein.") = vbYes Then
' FW_Versionen_Ueberpruefen = True
' End If
' End If
Exit Function
Errorhandler:
LogIntoDB "Fehler " & Err.Number & " in FW_Versionen_Ueberpruefen(): " & Err.Description & vbCrLf, ""
MsgBox "Fehler " & Err.Number & " in FW_Versionen_Ueberpruefen(): " & Err.Description & vbCrLf
End Function
''Private Function FW_Revision_Ueberpruefen() As Boolean
'' Dim Einbauplatz As CEinbauplatz
'' Dim objDEBUG As SIRTCOM.DEBUG
'' Dim objPAM As SIRTCOM.PAM
'' Dim strGrenzwert As String
'' Dim lngGrenzwert As Long
'' Dim strMessage As String
''
'' Const Section = "Pruefstation_eRegister"
'' Const KEY = "Required_Firmware_Revision"
''
'' On Error GoTo Errorhandler
''
'' FW_Revision_Ueberpruefen = True
''
'' m_PAMZeile = m_PAMZeile + 1
'' SetFlexgridRow m_PAMZeile, MSFlexGrid1, "FW Rev."
''
'' strGrenzwert = GetGlobaleEinstellung(Section, KEY)
''
'' lngGrenzwert = Val(strGrenzwert)
''
'' For Each Einbauplatz In m_colEinbauplatz
'' If Not Einbauplatz.getPruefzaehler Is Nothing Then
'' If Not Einbauplatz.eRegister Is Nothing Then
'' MSFlexGrid1.col = Einbauplatz.getNr
'' Set objPAM = mSIRTStatemashine.GetPAM(Einbauplatz.getNr)
'' If Not objPAM Is Nothing Then
'' Set objDEBUG = objPAM.DEBUG
'' If Not objDEBUG Is Nothing Then
''
'' Dim strDebugHexdata As String
'' ' Debug-Data fängt offiziell mit dem AppCode an Stelle 17 an.
'' strDebugHexdata = Mid(Replace(objDEBUG.HexData, " ", ""), 8 * 2 + 1)
''
'' ' alt
'' Einbauplatz.eRegister.m_FW_Version = objDEBUG.Fw_Version
'' Einbauplatz.eRegister.m_FW_Revision = objDEBUG.Fw_Revision
''
'' If objDEBUG.Fw_Version = 16 Then
'' ' FW Version ist aktuell
'' MSFlexGrid1.text = Hex(Einbauplatz.eRegister.m_FW_Revision) & " (hex)"
''
'' ' Version 18 + Aufwärts (zur Zeit 19) erlauben
'' If Einbauplatz.eRegister.m_FW_Revision < lngGrenzwert Then
'' MSFlexGrid1.CellBackColor = RGB(255, 128, 128)
'' strMessage = "Einbauplatz " & Einbauplatz.getNr & ": Die Firmware Revision = " & Hex(Einbauplatz.eRegister.m_FW_Revision) & " (hex) ist zu alt. " & vbCrLf & "Erforderlich ist " & Hex(lngGrenzwert) & " (hex)." & vbCrLf & "Tauschen Sie das Werk an Einbauplatz " & Einbauplatz.getNr & " aus und informieren Sie die Qualitätssicherung!"
'' PrintStatus strMessage
'' MsgBox strMessage
'' FW_Revision_Ueberpruefen = False
'' Else
'' PrintStatus "Einbauplatz " & Einbauplatz.getNr & " FW Rev = " & Hex(Einbauplatz.eRegister.m_FW_Revision) & " (hex)"
'' MSFlexGrid1.CellBackColor = RGB(128, 255, 128)
'' End If
'' Else
'' ' Neu 14.12.2016 Unterscheidung zw.Radio_FW_Version und Metrology_FW_Version
''
'' Einbauplatz.eRegister.m_Radio_FW_Version = Val("&H" & Mid(strDebugHexdata, 9 * 2 - 1, 4))
'' Einbauplatz.eRegister.m_Metrology_FW_Version = Val("&H" & Mid(strDebugHexdata, 11 * 2 - 1, 4))
''
'' MSFlexGrid1.text = Formatversion(Einbauplatz.eRegister.m_Radio_FW_Version) & " " & Formatversion(Einbauplatz.eRegister.m_Metrology_FW_Version)
''
'' Dim intRadioFWVersionMin As Integer
'' Dim intRadioFWVersionMax As Integer
'' Dim intMetrologyFWVersionMin As Integer
'' Dim intMetrologyFWVersionMax As Integer
''
'' ' Es kann von Uwe Gross zur Zeit noch nicht ausgeschlossen werden
'' ' dass zukünftig Hex-Ziffern in der Versionierung vorkommen, z.B. 1.1.0F
'' ' also Hex in Integer umwandeln
'' intRadioFWVersionMin = Val(GetGlobaleEinstellung("Pruefstation_eRegister", "RadioFWVersionMin"))
'' intRadioFWVersionMax = Val(GetGlobaleEinstellung("Pruefstation_eRegister", "RadioFWVersionMax"))
''
'' intMetrologyFWVersionMin = Val(GetGlobaleEinstellung("Pruefstation_eRegister", "MetrologyFWVersionMin"))
'' intMetrologyFWVersionMax = Val(GetGlobaleEinstellung("Pruefstation_eRegister", "MetrologyFWVersionMax"))
''
'' If intRadioFWVersionMin > 0 Then
'' If Einbauplatz.eRegister.m_Radio_FW_Version < intRadioFWVersionMin Then
'' ' Fehler
'' MsgBox ("Die Radio FW Version " & Formatversion(Einbauplatz.eRegister.m_Radio_FW_Version) & " ist kleiner als die minimal erlaubte Version " & Formatversion(intRadioFWVersionMin) & "." & vbCrLf & "In der Produktion dürfen Werke mit dieser Version nicht verwendet werden.")
'' If g_blnVersuch = False Then
'' FW_Revision_Ueberpruefen = False
'' End If
'' Else
'' ' OK
'' End If
'' Else
'' ' Min Wert ignoriert
'' End If
''
'' If intRadioFWVersionMax > 0 Then
'' If Einbauplatz.eRegister.m_Radio_FW_Version > intRadioFWVersionMax Then
'' ' Fehler
'' MsgBox ("Die Radio FW Version " & Formatversion(Einbauplatz.eRegister.m_Radio_FW_Version) & " ist grösser als die maximal erlaubte Version " & Formatversion(intRadioFWVersionMax) & "." & vbCrLf & "In der Produktion dürfen Werke mit dieser Version nicht verwendet werden.")
'' FW_Revision_Ueberpruefen = False
'' Else
'' ' OK
'' End If
'' Else
'' ' Max Wert ignoriert
'' End If
''
''
'' If intMetrologyFWVersionMin > 0 Then
'' If Einbauplatz.eRegister.m_Metrology_FW_Version < intMetrologyFWVersionMin Then
'' ' Fehler
'' MsgBox ("Die Metrology FW Version " & Formatversion(Einbauplatz.eRegister.m_Metrology_FW_Version) & " ist kleiner als die minmal erlaubte Version " & Formatversion(intMetrologyFWVersionMin) & "." & vbCrLf & "In der Produktion dürfen Werke mit dieser Version nicht verwendet werden.")
'' FW_Revision_Ueberpruefen = False
'' Else
'' ' OK
'' End If
'' Else
'' ' Min Wert ignoriert
'' End If
''
'' If intRadioFWVersionMax > 0 Then
'' If Einbauplatz.eRegister.m_Metrology_FW_Version > intMetrologyFWVersionMax Then
'' ' Fehler
'' MsgBox ("Die Metrology FW Version " & Formatversion(Einbauplatz.eRegister.m_Metrology_FW_Version) & " ist grösser als die maximal erlaubte Version " & Formatversion(intMetrologyFWVersionMax) & "." & vbCrLf & "In der Produktion dürfen Werke mit dieser Version nicht verwendet werden.")
'' FW_Revision_Ueberpruefen = False
'' Else
'' ' OK
'' End If
'' Else
'' ' Max Wert ignoriert
'' End If
''
'' If FW_Revision_Ueberpruefen = True Then
'' MSFlexGrid1.CellBackColor = RGB(128, 255, 128)
'' End If
''
'' End If
'' End If
'' End If
'' End If
'' End If
'' Next
''
'' If FW_Revision_Ueberpruefen = False Then
'' If g_blnVersuch Then
'' ' Versuchprüfer darf weitermachen
'' If MsgBox("Als Versuchs-Prüfer dürfen sie weiter prüfen. Möchten Sie fortfahren?" & vbCrLf & "Mit 'Nein' brechen Sie den aktuellen Vorgang ab.", vbYesNo Or vbDefaultButton1, "FW Revision war zu klein.") = vbYes Then
'' FW_Revision_Ueberpruefen = True
'' End If
'' End If
'' End If
''
''Exit Function
''Errorhandler:
'' MsgBox "Fehler " & Err.Number & " in FW_Revision_Ueberpruefen(): " & Err.Description & vbCrLf & "GlobaleEinstellungen " & Section & "|" & KEY & "= '" & strGrenzwert & "'." & vbCrLf & Err.Description
''End Function
Private Function Formatversion(intVersion As Integer) As String
Formatversion = Mid(Hex(intVersion), 1, 1) & "." & Mid(Hex(intVersion), 2, 1) & "." & Val("&h" & Mid(Hex(intVersion), 3, 2))
End Function
' Wenn eine Batteriespannung zu klein ist, gibt diese Funktion false zurück
Private Function BatterieSpannungUberpruefenOK() As Boolean
Dim Einbauplatz As CEinbauplatz
Dim dblVoltage As Double
' Die Spannung wird aus dem DEBUG Telegramm ermittelt, z.B. beim LED an/aus
Const MINVOLTAGE = 3.565 ' Die Mindestspannung
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "Batterie [V]: "
BatterieSpannungUberpruefenOK = True
' Für alle Zähler
For Each Einbauplatz In m_colEinbauplatz
MSFlexGrid1.col = Einbauplatz.getNr
If Not Einbauplatz.eRegister Is Nothing Then
If Not Einbauplatz.eRegister.m_lastDEBUG Is Nothing Then
' Formel von A.Pfeiffer am 13.8.2015
dblVoltage = 2 + Einbauplatz.eRegister.m_lastDEBUG.Battery_Voltage / 64
If dblVoltage < MINVOLTAGE Then
MSFlexGrid1.CellBackColor = vbRed Or 8421504
MSFlexGrid1.text = Format(dblVoltage, "0.000") & " <" & MINVOLTAGE
WriteToLog "Einbauplatz: " & Einbauplatz.getNr & ": Batteriespannung=" & dblVoltage & "V zu klein! Werk mit FAdr:" & Einbauplatz.eRegister.m_lastSEMI.RadioAdr & ", PCBId: " & Einbauplatz.eRegister.m_sPCBid
MsgBox "Die Batteriespannung " & dblVoltage & "V ist zu klein!" & vbCrLf & "Tauschen Sie das Werk an Einbauplatz " & Einbauplatz.getNr & " aus und informieren Sie die Qualitätssicherung!"
BatterieSpannungUberpruefenOK = False
Else
WriteToLog "Einbauplatz: " & Einbauplatz.getNr & ": Batteriespannung=" & dblVoltage & "V OK"
MSFlexGrid1.text = Format(dblVoltage, "0.000") & " OK"
MSFlexGrid1.CellBackColor = vbGreen Or 8421504
End If
Else
' TODO
MsgBox "Die Batteriespannung an Ebp " & Einbauplatz.getNr & " konnte nicht überprüft werden, da kein DEBUG Telegramm empfangen wurde."
BatterieSpannungUberpruefenOK = False
End If
End If
Next
End Function
Public Function GetAuftragPositionHZ(AuftragPositionNZ As CAuftragPosition, ByRef AuftragPositionHZ As CAuftragPosition) As Boolean
Dim lLead_AuftragNr As Long
lLead_AuftragNr = AuftragPositionNZ.m_lLead_AuftragNr
End Function
Public Function GetVakoForHauptzaehler(LeadAuftragNr As Long) As CVakoCode
Dim strSQL As String
Dim rs As CRecordset
Dim AuftragPosition As CAuftragPosition
Dim objIdentNr As CIdentNr
Dim objVakoCode As CVakoCode
Dim strVakoCode As String
strSQL = "SELECT * from AlleAuftragpositionen where Lead_AufNr = " & LeadAuftragNr
Set rs = New CRecordset
rs.openRS strSQL, True
Do While Not rs.EOF
' für alle Auftragpositionen im Netz
Set AuftragPosition = New CAuftragPosition
If AuftragPosition.load(rs.getLongValue("AuftragNr"), rs.getIntValue("PositionNr")) Then
Set objIdentNr = AuftragPosition.getIdentNrObj
strVakoCode = objIdentNr.GetVakoCode
If Left(strVakoCode, 5) <> "MTWNZ" And Left(strVakoCode, 3) = "MTW" Then
'kein NZ also Hauptzähler
Set objVakoCode = New CVakoCode
If objVakoCode.load(strVakoCode) Then
Set GetVakoForHauptzaehler = objVakoCode
Else
Set GetVakoForHauptzaehler = Nothing
End If
Exit Function
End If
End If
rs.MoveNext
Loop
End Function
Public Function PruefungInitialisierung_NeuerVako(Optional blnNichtProgrammieren As Boolean = False) As Boolean
On Error GoTo Errorhandler
Dim ret As Long
Dim Einbauplatz As CEinbauplatz
Dim strCMDHex As String
Dim Laenge As Byte
Dim objPAM As SIRTCOM.PAM
Dim objDEBUG As SIRTCOM.DEBUG
Dim eRegister As CeRegister
Dim Pruefzaehler As CPruefzaehler
Dim AuftragPosition As CAuftragPosition
Dim FertigungsauftragNr As Long
Dim objVakoCode As CVakoCode
Dim objIdentNr As CIdentNr
Dim strVakoCode As String
Dim ByteParameterHex As String
Dim strFunkschluessel As String
Dim strDeviceID As String
Dim strOrderNumber As String
Dim byteMetersize As Byte
Dim intWdhZaehler As Integer
Dim strCSD As String
Dim strFunkschluesselArt As String
Dim objVakoCodeHZ As CVakoCode
Dim strListeDerFertigungsauftragsnummern As String
mintFrequenz = 0
Me.caption = FORMCAPTION & " Vorbereitung zur Prüfung"
StartAgain:
' Abbruch ermöglichen
m_blnAbbruch = False
cmdCancel.Enabled = True
PrintStatus "init Displays"
SetupDisplay
PrintStatus "init Displays fertig"
' entfernt vorhandene CeRegister Objekte aus der vorhergehenden Prüfung
' aus den CEinbauplatz Objekten
' diese werden durch das Laden aus der eRegister Tabelle über die SerienNr neu erzeugt
' und durch die Opto Telegramme mit Daten ergänzt
Call Entferne_eRegister_Daten
MSFlexGrid1.Rows = 1
'''''''''''''''''''''''''''''''''''''''''''''''''
'' vorhandene Zählerdaten aus DB lesen
'''''''''''''''''''''''''''''''''''''''''''''''''
SetFlexgridRow fgZeile.Zeile_Pz_RadioAdr, MSFlexGrid1, "Radio Adr"
SetFlexgridRow fgZeile.Zeile_Pz_FinalRadioAdr, MSFlexGrid1, "Finale Funkadr"
SetFlexgridRow fgZeile.Zeile_Pz_State, MSFlexGrid1, "Status"
strListeDerFertigungsauftragsnummern = ""
' eRegister-Objekt erzeugen und über die Seriennummer aus der Datenbank laden
' eRegister Auftragsdaten-Objekt erzeugen und über die FertigungsauftragNr aus der Datenbank laden
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
Set eRegister = New CeRegister
MSFlexGrid1.col = Einbauplatz.getNr
If eRegister.loadForSerienNr(Pruefzaehler.getSerienNr) Then
Set AuftragPosition = Pruefzaehler.getAuftragPosition
byteMetersize = GetMetersize(Einbauplatz)
If byteMetersize = 0 Then
MsgBox "Metersize für Einbauplatz " & Einbauplatz.getNr & " konnte nicht bestimmt werden."
PruefungInitialisierung_NeuerVako = False
Exit Function
End If
Set objIdentNr = AuftragPosition.getIdentNrObj
strVakoCode = objIdentNr.GetVakoCode
If strVakoCode <> "" Then
Dim objVako As CVakoCode
Set objVako = New CVakoCode
If objVako.load(strVakoCode) Then
strCSD = objVako.GetWert("Ausfuehrung")
If strCSD <> "" Then
' CSD möglicherweise vorhanden
If InStr(1, strCSD, "ohne") = 0 Then
' CSD ist nicht "ohne"
If Left(strCSD, 4) = "CSD " Then
' CSD + Leerzeichen ist enthalten
' CSD Angabe normieren
eRegister.mstr_CSD = Split(strCSD, " ")(0) & " " & Split(strCSD, " ")(1)
End If
End If
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Verbundzähler bestimmen
If Left(strVakoCode, 3) = "MTW" Then
If Left(strVakoCode, 5) = "MTWNZ" Then
eRegister.m_Verbundzaehler = NZ
Else
eRegister.m_Verbundzaehler = HZ
End If
Else
eRegister.m_Verbundzaehler = KEIN
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If InStr(1, strListeDerFertigungsauftragsnummern, AuftragPosition.GetFertigungsauftragNr) = 0 Then
' FertigungsauftragNr noch nicht behandelt
If strListeDerFertigungsauftragsnummern <> "" Then
' Trennzeichen einfügen
strListeDerFertigungsauftragsnummern = strListeDerFertigungsauftragsnummern & "|"
End If
strListeDerFertigungsauftragsnummern = strListeDerFertigungsauftragsnummern & AuftragPosition.GetFertigungsauftragNr
If Copy_CSD_Data(byteMetersize, objVako, AuftragPosition) = False Then
If g_blnVersuch Then
If MsgBox("Sie sind Versuchsprüfer. Möchten sie versuchen mit ggf. vorhandenen Daten in eRegister_Auftragposition, weiterzuprüfen?", vbYesNo Or vbDefaultButton1, "") = vbNo Then
PruefungInitialisierung_NeuerVako = False
Exit Function
End If
Else
PruefungInitialisierung_NeuerVako = False
Exit Function
End If
Else
'OK
End If
Else
' FertigungsauftragNr wurde schon behandelt
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''
' soeben angelegte eRegister_Auftragposition laden
' wird für "Kundenschlüssel nach CSD" benötigt
''''''''''''''''''''''''''''''''''''''''''''''''''''
Set eRegister.mobj_eRegister_Auftragposition = New CeRegister_Auftragposition
FertigungsauftragNr = AuftragPosition.GetFertigungsauftragNr
If Not eRegister.mobj_eRegister_Auftragposition.LoadForFertigungsAuftragNr(FertigungsauftragNr) Then
PrintStatus "eRegister Auftragposition " & FertigungsauftragNr & " konnte nicht in der Datenbank gefunden werden."
MsgBox "eRegister Auftragposition " & FertigungsauftragNr & " konnte nicht in der Datenbank gefunden werden."
PruefungInitialisierung_NeuerVako = False
Exit Function
Else
' Alle Programmier-Daten in Logdatei schreiben
WriteToLog eRegister.mobj_eRegister_Auftragposition.strValuesText
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''' Funkschlüssel '''''''''''''''''''''''''''''''''''''''''''''
If Left(objVako.VakoCode, 5) = "MTWNZ" Or Left(objVako.VakoCode, 5) = "WPVIM" Then
' Ausnahme Nebenzähler: Funkschlüssel-Art aus Hauptzähler Vakocode bestimmen
Set objVakoCodeHZ = GetVakoForHauptzaehler(Einbauplatz.getPruefzaehler.getAuftragPosition.m_lLead_AuftragNr)
If objVakoCodeHZ Is Nothing Then
MsgBox "Die FunkschluesselArt für den Nebenzähler kann aus der Hauptzähler-Auftragposition nicht bestimmt werden!"
Else
strFunkschluesselArt = objVakoCodeHZ.GetWert("Funkschluessel")
End If
' Neu RH 2017-07-03 WPV MS Auftrag
If Left(objVako.VakoCode, 5) = "WPVIM" Then
MsgBox "ungeprüftes Feature: Bitte überprüfen, ob Nebenzähler " & strFunkschluesselArt & "-Funkschlüssel richtig aus Vako bestimmt wird!"
If IsInIDE() Then
Stop
End If
End If
Else
' für alle anderen
strFunkschluesselArt = objVako.GetWert("Funkschluessel")
End If
Select Case strFunkschluesselArt
Case "Sensus (Standard)"
' SENSUS
eRegister.m_sKeyHex = FUNKSCHLUESSEL_SENSUS_STANDARD
PrintStatus "Einbauplatz " & Einbauplatz.getNr & " bekommt 'Sensus (Standard)'-Funkschlüssel"
Case "Zufallszahl"
' Zufallszahl
' Holt den gespeicherten Index (Device-ID und OrderNumber) auf den Zufallszahl Funkschlüssel mit Hilfe der Sensus-Seriennr aus der eRegister Tabelle
If Not GetFunkschluesselIndex(Einbauplatz.getPruefzaehler.getSerienNr, strDeviceID, strOrderNumber) Then
' Fehler
PrintStatus "Einbauplatz " & Einbauplatz.getNr & ": Zufallszahl Funkschlüssel-Index fehlt in Tabelle eRegister fr Seriennummer " & Einbauplatz.getPruefzaehler.getSerienNr
MsgBox "Einbauplatz " & Einbauplatz.getNr & ": Zufallszahl Funkschlüssel-Index fehlt in Tabelle eRegister für Seriennummer " & Einbauplatz.getPruefzaehler.getSerienNr
PruefungInitialisierung_NeuerVako = False
Exit Function
End If
PrintStatus "Funkschlüssel (für Einbauplatz " & Einbauplatz.getNr & ": OrderNumber=" & strOrderNumber & ", DeviceID=" & strDeviceID & ") abrufen..."
If getFunkschluessel(strOrderNumber, strDeviceID, strFunkschluessel) Then
If Len(strFunkschluessel) = 32 Then
PrintStatus "OK"
eRegister.m_sKeyHex = strFunkschluessel
Else
PrintStatus "Einbauplatz " & Einbauplatz.getNr & ": Zufallszahl Funkschlüssel hat nicht die Länge 32 sondern " & Len(strFunkschluessel)
MsgBox "Einbauplatz " & Einbauplatz.getNr & ": Zufallszahl Funkschlüssel hat nicht die Länge 32 sondern " & Len(strFunkschluessel)
PruefungInitialisierung_NeuerVako = False
Exit Function
End If
Else
PrintStatus "Der Zufallszahl-Funkschlüssel konnte für OrderNr=" & strOrderNumber & ", DeviceID=" & strDeviceID & " nicht abgerufen werden." & " Grund: " & strFunkschluessel
MsgBox "Der Zufallszahl-Funkschlüssel konnte für OrderNr=" & strOrderNumber & ", DeviceID=" & strDeviceID & " nicht abgerufen werden." & " Grund: " & strFunkschluessel
PruefungInitialisierung_NeuerVako = False
Exit Function
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case "Kundenschlüssel nach CSD"
If GetKundenFunkschluessel(eRegister, strFunkschluessel) = True Then
If Len(strFunkschluessel) = 32 Then
eRegister.m_sKeyHex = strFunkschluessel
PrintStatus "Einbauplatz " & Einbauplatz.getNr & " bekommt Kundenschlüssel nach CSD='" & eRegister.mstr_CSD & "'"
Else
MsgBox "Der in der Datenbank hinterlegte Kundenschlüssel nach CSD='" & eRegister.mstr_CSD & "' hat nicht die Länge von 16 Bytes! Bitte überprüfen."
PruefungInitialisierung_NeuerVako = False
Exit Function
End If
Else
MsgBox "Da kein Kundenfunkschlüssel ermittelt werden konnte, ist eine Prüfung nicht möglich."
PruefungInitialisierung_NeuerVako = False
Exit Function
End If
Case Else
PrintStatus "unbekannte Funkschlüssel-Art: " & objVako.GetWert("Funkschluessel") & vbCrLf & "Prüfung wird abgebrochen!"
MsgBox "unbekannte Funkschlüssel-Art: " & objVako.GetWert("Funkschluessel") & vbCrLf & "Prüfung wird abgebrochen!"
PruefungInitialisierung_NeuerVako = False
Exit Function
End Select
Else
MsgBox "Funkschlüssel: VakoCode konnte nicht geladen werden."
End If
Else
PrintStatus "Auftragosition (Einbauplatz " & Einbauplatz.getNr & ") hat keinen VakoCode. 'Sensus (Standard)' Funkschlüssel wird verwendet."
If MsgBox("Auftragosition (Einbauplatz " & Einbauplatz.getNr & ") hat keinen VakoCode! 'Sensus (Standard)' Funkschlüssel wird verwendet.", vbOKCancel Or vbDefaultButton1) = vbCancel Then
PruefungInitialisierung_NeuerVako = False
Exit Function
End If
eRegister.m_sKeyHex = FUNKSCHLUESSEL_SENSUS_STANDARD
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''
' SIRT Frequenz 433 oder 688. Diese muss für alle eRegister gleich sein!
If mintFrequenz = 0 Then
' Frequenz wurde in dieser Schleife noch nicht festgelegt
mintFrequenz = eRegister.mobj_eRegister_Auftragposition.mint_RadioFrequency
WriteToLog "(erste) Frequenz = " & mintFrequenz
Else
' Frequenz wurde in dieser Schleife schon festgelegt und muss für ale Einbauplätze gleich sein
If mintFrequenz <> eRegister.mobj_eRegister_Auftragposition.mint_RadioFrequency Then
WriteToLog "(weitere) Frequenz = " & eRegister.mobj_eRegister_Auftragposition.mint_RadioFrequency
WriteToLog "Fehler: Die eRegister haben unterschiedliche Radio Frequenzen und können nicht gemeinsam programmiert werden! "
MsgBox "Fehler: Die eRegister haben unterschiedliche Radio Frequenzen und können nicht gemeinsam programmiert werden! "
PruefungInitialisierung_NeuerVako = False
Exit Function
End If
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
MSFlexGrid1.row = fgZeile.Zeile_Pz_FinalRadioAdr
MSFlexGrid1.text = eRegister.m_sRadioAdressFinal
Set Einbauplatz.eRegister = eRegister
MSFlexGrid1.row = fgZeile.Zeile_Pz_SerienNr
MSFlexGrid1.text = Einbauplatz.getPruefzaehler.getSerienNr
MSFlexGrid1.row = fgZeile.Zeile_Pz_State
If Einbauplatz.eRegister.m_StateClosed Then
' laut Datenbank ist dieses eRegister verschlossen
MSFlexGrid1.text = "Verschlossen"
Else
MSFlexGrid1.text = "Offen"
End If
Else
ret = MsgBox("Es gibt keinen Datensatz in Tabelle eRegister für SerienNr " & Pruefzaehler.getSerienNr & ". Der Prüfling wird von weiterer Behandlung ausgeschlossen.", vbOKCancel)
If ret = vbCancel Then
PruefungInitialisierung_NeuerVako = False
Exit Function
End If
Einbauplatz.setPruefzaehler Nothing
MSFlexGrid1.row = fgZeile.Zeile_Pz_State
MSFlexGrid1.text = "unbekannt"
End If
End If
Next
AutoSpaltenBreite MSFlexGrid1, lblAutosize
'' SIRT Comport öffnen und Funkreceiver einschalten
If Not InitSirt(mintFrequenz) Then
' SIRT kann nicht initialisiert werden, also abbrechen
PruefungInitialisierung_NeuerVako = False
Exit Function
End If
mSIRTStatemashine.Stop
MSFlexGrid1.Rows = fgZeile.Zeile_PZ_Ende
m_PAMZeile = fgZeile.Zeile_PZ_Ende
SetFlexgridRow m_PAMZeile, MSFlexGrid1, ""
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''' ' verschlossene Werke mit WUP-IV=0 wecken mit WakeUSequenz
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Change Wake Up = PAM 0 + 1 Data Byte, no Single Cmd, Auth Level 2
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, ""
For Each Einbauplatz In m_colEinbauplatz
strCMDHex = ""
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
If Einbauplatz.eRegister.m_StateClosed Then
' verschlossene Zähler wecken
strCMDHex = "0000"
strCMDHex = strCMDHex & ProvideAuthLevelHexCommand(2)
Einbauplatz.eRegister.m_bUseKey = True
' Länge der PAM berechnen und davor setzen
Laenge = Len(strCMDHex) / 2
strCMDHex = Hex2(Laenge) & strCMDHex
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
Else
' unverschlossene Zähler werden erst nach dem LED erkennen geweckt
MSFlexGrid1.text = " - "
strCMDHex = ""
Einbauplatz.eRegister.m_bUseKey = False
End If
End If
End If
Next
' P81_1 = (16+4) = 20: createWakeUp Sequence and delete PAM after SEMI
PruefungInitialisierung_NeuerVako = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("Wake up", 20)
If PruefungInitialisierung_NeuerVako = False Then Exit Function
'''''''''''''''''''''''''''''''''''''''''''''''''
'' Opto Empfang starten
'''''''''''''''''''''''''''''''''''''''''''''''''
PrintStatus "Zähle sendende Zähler"
mSIRTStatemashine.start
retryErkennen:
For Each Einbauplatz In m_colEinbauplatz
MSFlexGrid1.TextMatrix(fgZeile.Zeile_Pz_Timestamp, Einbauplatz.getNr) = ""
MSFlexGrid1.TextMatrix(fgZeile.Zeile_Pz_Volume, Einbauplatz.getNr) = ""
Next
PruefungInitialisierung_NeuerVako = StartOptoEmpfang()
If PruefungInitialisierung_NeuerVako = False Then Exit Function
PrintStatus "zum Aktivieren der eRegister ggf. Magnet benutzen"
' Warte, bis alle Zähler jeweils ein Telegramm gesendet haben oder Abbruch
If Get_New_eRegister_Opto_Data() = False Then
' hier wurde abbrechen gedückt
ret = MsgBox("Möchten Sie das Erkennen der Zählwerke abbrechen " & Chr(13) & "oder mit dem Einbauen der Zählwerke fortfahren (Wiederholen)" & Chr(13) & "oder mit der Prüfung beginnen und die fehlenden Zählwerke ignorieren? ", vbAbortRetryIgnore, "Achtung, nicht alle eRegister konnten erkannt werden!")
Select Case ret
Case vbAbort
PruefungInitialisierung_NeuerVako = False
Exit Function
Case vbIgnore
m_blnAbbruch = False
' fortfahren
Case vbRetry
GoTo retryErkennen
End Select
End If
If m_blnAbbruch = True Then Exit Function
If mSIRTStatemashine Is Nothing Then Exit Function
mSIRTStatemashine.Stop
' ab hier senden alle Einbauplätze Telegramme
If Check_For_Valid_eRegister_Data() = False Then
' etwas stimmt nicht
If g_blnVersuch And False Then
' Versuchprüfer darf weitermachen
If MsgBox("Als Versuchs-Prüfer dürfen Sie weiter prüfen. Möchten Sie fortfahren?" & vbCrLf & "Mit 'Nein' brechen Sie den aktuellen Vorgang ab.", vbYesNo Or vbDefaultButton1, "Pruef2000") = vbYes Then
PruefungInitialisierung_NeuerVako = True
Else
PruefungInitialisierung_NeuerVako = False
m_blnAbbruch = True
Call StopOptoEmpfang
Exit Function
End If
Else
PruefungInitialisierung_NeuerVako = False
m_blnAbbruch = True
Call StopOptoEmpfang
Exit Function
End If
End If
If m_blnAbbruch = True Then Exit Function
Call StopOptoEmpfang
If blnNichtProgrammieren Then
' Wenn nur die Zählerdaten neu ermittelt werden sollen, hier aussteigen
PruefungInitialisierung_NeuerVako = True
Exit Function
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''' ' offene Werke mit WUP-IV=0 wecken
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Change Wake Up = PAM 0 + 1 Data Byte, no Single Cmd, Auth Level 2
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, ""
For Each Einbauplatz In m_colEinbauplatz
strCMDHex = ""
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
If Einbauplatz.eRegister.m_StateClosed = False Then
' unverschlossene Zähler wecken
strCMDHex = "0000"
Einbauplatz.eRegister.m_bUseKey = False
' Länge der PAM berechnen und davor setzen
Laenge = Len(strCMDHex) / 2
strCMDHex = Hex2(Laenge) & strCMDHex
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
Else
' verschlossene Zähler wurden bereits geweckt, also hier überspringen
MSFlexGrid1.text = " - "
End If
End If
End If
Next
' P81_1 = 16 : delete PAM after SEMI (do not create WakeUp Sequence)
' +4: create WakeUp Sequence
' auch blinkende Werke können sich nach einer Stunde wieder schlafen gelegt haben
PruefungInitialisierung_NeuerVako = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("Wake up", 20)
If PruefungInitialisierung_NeuerVako = False Then
Exit Function
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''' TXIV+LAT
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Change Transmission Interval, 2 Data bytes, no single cmd, Auth Level 2
' Change number of LAT Windows N, 1 Data byte, no single cmd, Production Mode
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, ""
intWdhZaehler = 0
For Each Einbauplatz In m_colEinbauplatz
strCMDHex = ""
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
If Einbauplatz.eRegister.m_StateClosed = False Then
strCMDHex = ""
' Transmission Intervall für die Prüfung vorrübergehend auf 3s setzen
strCMDHex = strCMDHex & "100003" ' TX-IV=3s => 16,0,3 = 10 00 03
strCMDHex = strCMDHex & "0201" ' LAT = 1 => 2,1 = 02 01
strCMDHex = strCMDHex & "0507" ' M-Bus Status = 7
Laenge = Len(strCMDHex) / 2
strCMDHex = Hex2(Laenge) & strCMDHex
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
Else
MSFlexGrid1.text = " - "
Einbauplatz.eRegister.m_bytAuthLevel = 0
Einbauplatz.eRegister.m_curPIN = 0
End If
End If
End If
Next
PruefungInitialisierung_NeuerVako = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("TX LAT MBUS") '
If PruefungInitialisierung_NeuerVako = False Then Exit Function
'********** MBUS Status überprüfen
Wdh_MBUS_ueberpruefen:
Dim blnWdhErforderlich As Boolean
blnWdhErforderlich = False
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
Set eRegister = Einbauplatz.eRegister
If Not eRegister Is Nothing Then
Set objPAM = mSIRTStatemashine.GetPAM(Einbauplatz.getNr)
If Not objPAM Is Nothing Then
If objPAM.SEMI.OM_Status = 7 Then
' MBUS Status OK
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
Else
strCMDHex = "0507"
Laenge = Len(strCMDHex) / 2
strCMDHex = Hex2(Laenge) & strCMDHex
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
blnWdhErforderlich = True
End If
End If
End If
End If
Next
If blnWdhErforderlich Then
intWdhZaehler = intWdhZaehler + 1
If intWdhZaehler > 3 Then
MsgBox "Achtung M-BUS=7 wurde wiederholt gesendet."
Else
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "MBUS"
PruefungInitialisierung_NeuerVako = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("MBUS") '
If PruefungInitialisierung_NeuerVako = False Then Exit Function
GoTo Wdh_MBUS_ueberpruefen
End If
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''' ' Parametersatz Programmieren
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Multile PAM commands
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "Parametersatz"
For Each Einbauplatz In m_colEinbauplatz
MSFlexGrid1.col = Einbauplatz.getNr
MSFlexGrid1.row = m_PAMZeile
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
If Einbauplatz.eRegister.m_StateClosed = False Then
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ParametersatzNeuerVakoCmdHex(Einbauplatz)
Else
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
MSFlexGrid1.text = " - "
End If
End If
End If
Next
PruefungInitialisierung_NeuerVako = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("Parametersatz")
If PruefungInitialisierung_NeuerVako = False Then Exit Function
'''''''''''''''''''''''''''''''''''''''''''
'''' VOL = 1111111111
'''''''''''''''''''''''''''''''''''''''''''
' Change Meter Reading = PAM 48, 4 Data bytes, no single Cmd, (Production Mode) 3
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, ""
For Each Einbauplatz In m_colEinbauplatz
strCMDHex = ""
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
If Einbauplatz.eRegister.m_StateClosed = False Then
strCMDHex = strCMDHex & "30" & Hex8(111111111)
Laenge = Len(strCMDHex) / 2
strCMDHex = Hex2(Laenge) & strCMDHex
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
Else
MSFlexGrid1.text = " - "
End If
End If
End If
Next
PruefungInitialisierung_NeuerVako = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("Vol=111...") '
If PruefungInitialisierung_NeuerVako = False Then Exit Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''' ' LED an an alle
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
wdh_LEDan:
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, ""
If Not mblnVorbereitungFuzhoe Then
If g_blnVersuch Then
PruefungInitialisierung_NeuerVako = Sende_LED(True, False, True) ' einschalten
Else
PruefungInitialisierung_NeuerVako = Sende_LED(True, False, True) ' einschalten
End If
Else
'Wenn Fuzhoe dann muss explizit ein Debug angefordert werden da kein Sende LED ausgeführt wird
PruefungInitialisierung_NeuerVako = GetDEBUG()
End If
If PruefungInitialisierung_NeuerVako = False Then Exit Function
If BatterieSpannungUberpruefenOK() = False Then
' Batteriespannungwar bei einem der Zähler zu klein oder DEBUG wurde nicht emfangen
PruefungInitialisierung_NeuerVako = False
Exit Function
End If
If Battery_Remaining_UberpruefenOK() = False Then
' Batteriespannungwar bei einem der Zähler zu klein oder DEBUG wurde nicht emfangen
PruefungInitialisierung_NeuerVako = False
Exit Function
End If
If FW_Versionen_Ueberpruefen() = False Then
PruefungInitialisierung_NeuerVako = False
Exit Function
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''' MeterType
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Dieser Aufruf muss nach der Versionsüberprüfung kommen, da die FW Version notwendig ist
'If IsInIDE() Then
'Stop ' Haltepunkt zum Testen der neuen Funktion in der IDE
PruefungInitialisierung_NeuerVako = ChangeMeterType()
If PruefungInitialisierung_NeuerVako = False Then Exit Function
'End If
If mblnManuellePruefung = True Then
' sofort fortfahren
Exit Function
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' Warte auf Prüfung starten Button
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Not WarteAufWeiterButton("Prüfung starten", 10) Then
PruefungInitialisierung_NeuerVako = False
Exit Function
End If
If m_blnAbbruch = True Then
PruefungInitialisierung_NeuerVako = False
End If
Me.Visible = False
Exit Function
Errorhandler:
Select Case MsgBox("Es trat ein Fehler " & Err.Number & " in Initialisierung_durchführen auf: " & Err.Description & vbCrLf & "Möchten sie den Befehl, bei dem der Fehler auftrat wiederholen oder Ignorieren? 'Abbrechen' bricht die Prüfung ab.", vbAbortRetryIgnore)
Case vbIgnore
Resume Next
Case vbRetry
Resume
Case vbAbort
PruefungInitialisierung_NeuerVako = False
End Select
End Function
' Datenbank-Feld eRegister.FunkschluesselIndex DeviceID|Ordernumber[|...]
Function GetFunkschluesselIndex(ByVal lngSerienNr As Long, ByRef strDeviceID As String, ByRef strOrderNumber As String) As Boolean
Dim strSQL As String
Dim rs As CRecordset
Dim strIndex As String
Dim arIndex() As String
strSQL = "SELECT * from eRegister where Seriennummer = " & lngSerienNr
Set rs = New CRecordset
rs.openRS strSQL, True
If rs.EOF Then
GetFunkschluesselIndex = False
Exit Function
Else
strIndex = rs.getStringValue("FunkschluesselIndex")
' z.B. 16716061|71121752/10|8cc663df-36e0-4a8a-bdf0-bed17d4983ac
arIndex = Split(strIndex, "|")
If UBound(arIndex) >= 1 Then
GetFunkschluesselIndex = True
strDeviceID = Trim(arIndex(0))
strOrderNumber = Trim(arIndex(1))
Else
GetFunkschluesselIndex = False
Exit Function
End If
End If
End Function
Private Sub cmdTextFunkschluesel_Click()
Dim strFunkschluessel As String
Dim lngSerienNr As Long
Dim strListe As String
strListe = ""
For lngSerienNr = 15790864 To 15790872
If getFunkschluessel("3014757", CStr(lngSerienNr), strFunkschluessel) Then
strListe = strListe & lngSerienNr & " : " & strFunkschluessel & vbCrLf
Else
MsgBox "Fehler in GetFunkschluessel():" & strFunkschluessel
End If
Next
MsgBox strListe
End Sub
' Diese Funktion fordert ein neues X-Node-Token an, je nach Wahl des Benutzers:
' Entweder über direkte Eingabe vom Benutzer
' oder über die Eingabe von Login/Passwort vom Server
' Diese Funktion gibt False zurück, falls auf Abbruch geklickt wurde
' oder der Server z.B. durch falsches Login/Passwort oder Störungen kein X-Node-Token zurückgeben konnte
' Diese Funktion gibt True zurück, falls ein Token eingegeben wurde oder ein Token vom Server geliefert wurde.
' Das Token wird nicht überprüft!
Private Function GetNewToken(strMessage As String, ByRef strXNodeToken As String) As Boolean
Dim strLogin As String
Dim strPassword As String
Dim xmlhttp As MSXML2.ServerXMLHTTP
Dim strURL As String
Dim strData As String
Dim ret As Long
wdh_Wahl:
' Wahl von Token eingeben (Yes), Login/Password eingeben (No), Abbruch (Cancel)
ret = MsgBox(strMessage & vbCrLf & "Möchten Sie ein neues Token eingeben [Ja]?" & vbCrLf & "Klicken Sie auf [Nein] wenn sie ein neues Token per Login/Passwort anfordern wollen." & vbCrLf, vbYesNoCancel, strMessage)
Select Case ret
Case vbYes
wdh_Eingabe:
' Eingabe neues Token
strXNodeToken = InputBox("Bitte geben Sie ein neues X-Node-Token ein", "X-Node-Token für den Funkverschlüsselung-Server")
strXNodeToken = Trim(strXNodeToken)
If Len(strXNodeToken) = 36 Then
' Token hat die richtige Länge
GetNewToken = True
Exit Function
Else
' Token hat die falsche Länge
If Len(strXNodeToken) > 0 Then
MsgBox ("Falsche Länge!")
GoTo wdh_Eingabe
Else
' Token ist Leer
GoTo wdh_Wahl
End If
'''''''''''''''''''''
End If
Case vbCancel
' Abbruch
GetNewToken = False
Exit Function
End Select
' No= neues Token anfordern
strLogin = Trim(InputBox("Login:", "Neues X-Node-Token anfordern"))
strPassword = Trim(InputBox("Password:", "Neues X-Node-Token anfordern"))
strURL = g_App.Settings.readStringValue("eRegister", "URL_UserLogin", "")
strData = "{'Login':'" & strLogin & "','Password':'" & strPassword & "'}"
' REST API
Set xmlhttp = New MSXML2.ServerXMLHTTP
xmlhttp.Open "POST", strURL, True ' Async
xmlhttp.setOption SXH_OPTION_IGNORE_SERVER_SSL_CERT_ERROR_FLAGS, SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS
xmlhttp.setRequestHeader "Content-Type", "application/json"
xmlhttp.send (strData)
While xmlhttp.readyState <> 4
Debug.Print "xmlhttp.readyState = " & xmlhttp.readyState
xmlhttp.waitForResponse 1
Wend
'COMPLETED
If xmlhttp.Status <> 200 Then
'Abort the request.
strXNodeToken = xmlhttp.Status & " " & xmlhttp.responseText
MsgBox strXNodeToken, , "REST-API User/Login fehlgeschlagen"
xmlhttp.abort
GetNewToken = False
Exit Function
End If
' Status 200 OK
strXNodeToken = xmlhttp.responseText
GetNewToken = True
Exit Function
Errorhandler:
MsgBox "Fehler " & Err.Number & " in GetNewToken() " & Err.Description
GetNewToken = False
End Function
Private Function getFunkschluessel(strOrderNumber As String, strDeviceID As String, ByRef strFunkschluessel As String) As Boolean
Dim strURL As String
Dim strSecret As String
Dim xmlhttp As MSXML2.ServerXMLHTTP
Dim strXNodeToken As String
Dim strXNodeTokenEncrypted As String
On Error GoTo Errorhandler
' Falls INI Wert nicht existiert
' g_App.Settings.GetOrSetIniWert "eRegister", "URL_UserLogin", "http://10.1.14.121:8081/user/login"
' g_App.Settings.GetOrSetIniWert "eRegister", "URL_ApiKeys", "http://10.1.14.121:8081/api/keys"
'
'X-Node-Token aus der ini Datei lesen
strXNodeTokenEncrypted = g_App.Settings.readStringValue("eRegister", "X-Node-Token-Encrypted", "")
If Len(strXNodeTokenEncrypted) >= 10 Then
' und wenn vorhanden, dann entschlüsseln
strXNodeToken = g_App.Settings.AESDecryptString(strXNodeTokenEncrypted)
If strXNodeToken = "" Then
' Entschlüsselung fehlgeschlagen
Debug.Print "Entschlüsselung fehlgeschlagen"
End If
End If
If strXNodeToken = "" Then
' wenn nicht vorhanden, dann X-Node-Token direkt eingeben oder über Login/Passwort-Eingabe anfordern
If GetNewToken("Das X-Node-Token ist nicht (korrekt) in der ini Datei eingetragen.", strXNodeToken) Then
' Token wurde eingegeben
' verschlüsseln
strXNodeTokenEncrypted = g_App.Settings.AESEncryptString(strXNodeToken)
' speichern
g_App.Settings.saveStringValue "eRegister", "X-Node-Token-Encrypted", strXNodeTokenEncrypted
Else
strFunkschluessel = "Abbruch von GetNewToken()"
getFunkschluessel = False
Exit Function
End If
End If
Wiederholen:
'Test URL http://10.1.14.121:8081/api/keys/devices?orderNumber=Laatzen_Test&deviceId=123456789
strURL = g_App.Settings.readStringValue("eRegister", "URL_ApiKeys", "") & "/devices?orderNumber=" & strOrderNumber & "&deviceId=" & strDeviceID
Set xmlhttp = New MSXML2.ServerXMLHTTP
xmlhttp.Open "GET", strURL, True ' Async
xmlhttp.setOption SXH_OPTION_IGNORE_SERVER_SSL_CERT_ERROR_FLAGS, SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS
xmlhttp.setRequestHeader "Content-Type", "application/json"
xmlhttp.setRequestHeader "X-Node-Token", strXNodeToken
xmlhttp.send ("")
'(0) UNINITIALIZED The object has been created, but not initialized (the open method has not been called).
'(1) LOADING The object has been created, but the send method has not been called.
'(2) LOADED The send method has been called, but the status and headers are not yet available.
'(3) INTERACTIVE Some data has been received. Calling the responseBody and responseText properties at this state to obtain partial results will return an error, because status and response headers are not fully available.
'(4) COMPLETED All the data has been received, and the complete data is available in the responseBody and responseText properties.
While xmlhttp.readyState <> 4
Debug.Print "xmlhttp.readyState = " & xmlhttp.readyState
xmlhttp.waitForResponse 1
Wend
'COMPLETED
Select Case xmlhttp.Status
Case 200
' Funkschlüssel Antwort OK
strFunkschluessel = xmlhttp.responseText
strFunkschluessel = Replace(strFunkschluessel, Chr(34), "")
' Kontrolle
If Len(strFunkschluessel) = 32 Then
getFunkschluessel = True
Else
' Funkschlüssel hat falsche Länge
getFunkschluessel = False
MsgBox "Länge stimmt nicht: " & strFunkschluessel
strFunkschluessel = xmlhttp.responseText
End If
Case 403
If Not GetNewToken("Das X-Node-Token ist ungültig (" & xmlhttp.responseText & ")", strXNodeToken) Then
getFunkschluessel = False
strFunkschluessel = strXNodeToken
Exit Function
Else
' Token verschlüsselt
strXNodeTokenEncrypted = g_App.Settings.AESEncryptString(strXNodeToken)
' in ini speichern
g_App.Settings.saveStringValue "eRegister", "X-Node-Token-Encrypted", strXNodeTokenEncrypted
End If
GoTo Wiederholen
Case Else 'alle anderen Fehler:
' (404: No key stored in database for passed parameters)
strFunkschluessel = xmlhttp.Status & ": " & xmlhttp.responseText
MsgBox "Der Funkschlüssel für OrderNumber=" & strOrderNumber & ", DevideID=" & strDeviceID & " konnte auf dem Funkschlüssel-Server nicht gefunden werden." & vbCrLf & "HTTP-Status=" & xmlhttp.Status & vbCrLf & "Server-Antwort:" & xmlhttp.responseText
getFunkschluessel = False
End Select
Exit Function
Errorhandler:
strFunkschluessel = "Fehler " & Err.Number & " in GetFunkschluessel(): " & Err.Description
getFunkschluessel = False
End Function
Private Function Copy_CSD_Data(byteMetersize As Byte, objVako As CVakoCode, AuftragPosition As CAuftragPosition) As Boolean
On Error GoTo Errorhandler
Debug.Print objVako.GetWert("Einheit")
Dim rs As CRecordset
Dim rsQuelle As CRecordset
Dim rsZiel As CRecordset
Dim Unid_id As Byte
Dim Frequency_id As Byte
Dim DecimalPoint_id As Byte
Dim strCSD As String
Dim FertigungsauftragNr As Long
Dim strMsg As String
Dim strSQL As String
Dim strTemp As String
FertigungsauftragNr = AuftragPosition.GetFertigungsauftragNr
''''''''''''
Dim blnMeldungKeinCSD As Boolean
strTemp = objVako.GetWert("Einheit")
If strTemp = "" Then
strTemp = "m³"
End If
strSQL = "SELECT * from [eRegister_Unit] where Label = '" & strTemp & "'"
Debug.Print strSQL
Set rs = New CRecordset
rs.openRS strSQL, True
If rs.EOF Then
MsgBox "Einheit " & strTemp & " nicht in Tabelle [eRegister_Unit] definiert!"
Exit Function
End If
Unid_id = rs.getByteValue("Id")
''''''''''''
strSQL = "SELECT * from [eRegister_Radiofrequency] where Frequency = '" & objVako.GetWert("E_RADIO") & "'"
Set rs = New CRecordset
rs.openRS strSQL, True
If rs.EOF Then
MsgBox "Einheit " & objVako.GetWert("E_RADIO") & " nicht in Tabelle [eRegister_Radiofrequency] definiert!"
Exit Function
End If
Frequency_id = rs.getByteValue("Id")
If AuftragPosition.getIdentNrObj.getNennweite <= 125 Then
DecimalPoint_id = 1
Else
DecimalPoint_id = 2
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
strCSD = objVako.GetWert("Ausfuehrung")
If strCSD <> "" Then
' CSD möglicherweise vorhanden
If InStr(1, strCSD, "ohne") = 0 Then
' CSD ist nicht "ohne"
If UBound(Split(strCSD, " ")) > 0 Then
' Leerzeichen ist enthalten
' CSD Angabe normieren
strCSD = Split(strCSD, " ")(0) & " " & Split(strCSD, " ")(1)
strSQL = "SELECT * FROM CSD.ViewCSDConfiguration WHERE Customer_CSDNumber = '" & strCSD & "' and MeterSize_Value = " & byteMetersize & " AND Released = 1 "
Else
' kein Leerzeichen kein enthalten
MsgBox "Unbekannte CSD / Ausführung '" & strCSD & "' im VakoCode für FertigungsauftragNr " & FertigungsauftragNr & ". Muss entweder 'ohne' entghalten sein oder das Format 'CSD xxxx ...' haben."
Exit Function
End If
Else
' ohne CSD den Default Wert für diese Metersize kopieren
strSQL = "SELECT * FROM CSD.ViewCSDConfiguration WHERE MeterSize_Value = " & byteMetersize & " AND Released = 1 and Customer_Template = 1"
End If
Else
' CSD Ausführung ist leer, also Default Wert für diese Metersize kopieren
strSQL = "SELECT * FROM CSD.ViewCSDConfiguration WHERE MeterSize_Value = " & byteMetersize & " AND Released = 1 and Customer_Template = 1"
End If
Wdh_CSDConfiguration:
Set rsQuelle = New CRecordset
rsQuelle.openRS strSQL
Debug.Print strSQL
' Überprüfen
If rsQuelle.EOF Or rsQuelle.RecordCount = 0 Then
' Kein Datensatz. Fallback auf Default CSD
strSQL = "SELECT * FROM CSD.ViewCSDConfiguration WHERE MeterSize_Value = " & byteMetersize & " AND Released = 1 and Customer_Template = 1"
rsQuelle.openRS strSQL, True
Debug.Print strSQL
If rsQuelle.EOF Then
strMsg = "CSD-Default Konfiguration für " & AuftragPosition.getIdentNrObj.getTyp & AuftragPosition.getIdentNrObj.getTypzusatz & " " & AuftragPosition.getIdentNrObj.getNennweite & " ( = Metersize " & byteMetersize & ") konnte nicht gefunden werden. Die Prüfung kann nicht fortgeführt werden."
MsgBox strMsg
SendMail "donotreply@sensus.com", "reinhard.henning@sensus.com; Peter.Buch@sensus.com; Andreas.Pfeiffer@sensus.com", "Pruefstation " & g_App.PruefstationNr & " meldet mögl. fehlende Default-CSD Konfiguration für FertigungsauftragNr " & AuftragPosition.GetFertigungsauftragNr, strMsg
Copy_CSD_Data = False
Exit Function
Else
strMsg = "Keine CSD Konfiguration für CSD='" & strCSD & "' und " & AuftragPosition.getIdentNrObj.getTyp & AuftragPosition.getIdentNrObj.getTypzusatz & " " & AuftragPosition.getIdentNrObj.getNennweite & " d.h. Metersize=" & byteMetersize & " definiert. Fallback auf Default-CSD Konfiguration für Auftrag " & AuftragPosition.getAuftragNr & "/" & AuftragPosition.getNr & ", FANr " & AuftragPosition.GetFertigungsauftragNr
WriteToLog strMsg
blnMeldungKeinCSD = True
End If
ElseIf rsQuelle.RecordCount > 1 Then
strMsg = "Es gibt " & rsQuelle.RecordCount & " (nicht eindeutige) freigegebene CSD Daten für Metersize " & byteMetersize & " und CSD '" & strCSD & "'" & vbCrLf & strSQL
LogIntoDB strMsg, "Datenpflege"
SendMail "donotreply@sensus.com", "reinhard.henning@sensus.com; Peter.Buch@sensus.com; Andreas.Pfeiffer@sensus.com", "Pruefstation meldet nicht eindeutige Daten", strMsg
Exit Function
Else
' Datensatz gefunden
End If
Set rsZiel = New CRecordset
strSQL = "SELECT * from [eRegister_Auftragposition] where [FertigungsauftragNr] = " & FertigungsauftragNr
rsZiel.openRS strSQL, False
If rsZiel.EOF Then
' neuen Datensatz erzeugen
rsZiel.addNew
If blnMeldungKeinCSD = True Then
' nur einmal die "kein CSD"-Meldung absetzen, wenn der Datensatz zum ersten Mal erzeugt wird
SendMail "donotreply@sensus.com", "reinhard.henning@sensus.com; Peter.Buch@sensus.com; Andreas.Pfeiffer@sensus.com", "Pruefstation " & g_App.PruefstationNr & " meldet mögl. fehlende CSD Konfiguration für FertigungsauftragNr " & AuftragPosition.GetFertigungsauftragNr, strMsg
End If
Else
If rsZiel.getBooleanValue("Ueberschreibschutz") = True Then
' eRegister_Auftragposition Datensatz hat einen Ueberschreibschutz
MsgBox "eRegister_Auftragposition-Daten (FANr: " & FertigungsauftragNr & ") wurden nicht vom CSD '" & strCSD & "' / Metersize " & byteMetersize & " überschrieben da Ueberschreibschutz=1. " & rsZiel.getStringValue("CSD") & " / Meter_size_id=" & rsZiel.getStringValue("Meter_size_id") & " wird weiterhin verwendet.", vbInformation, "Zur Info"
' es darf weitergeprüft werden
Copy_CSD_Data = True
Exit Function
Else
' Datensatz überschreiben
rsZiel.setValue ("Aenderungsdatum"), Now
End If
End If
rsZiel.setValue "FertigungsauftragNr", FertigungsauftragNr
' Herkunft
rsZiel.setValue "CSD", rsQuelle.getStringValue("Customer_CSDNumber")
rsZiel.setValue "Meter_Size_Id", byteMetersize
rsZiel.setValue "Bemerkung", "Kopiert aus CSD ID=" & rsQuelle.getLongValue("Id")
rsZiel.setValue "Radiofrequency_Id", Frequency_id
' Konfiguration aus Auftrag
rsZiel.setValue "Unit_Id", Unid_id
rsZiel.setValue "Decimal_Point_Id", DecimalPoint_id
' database field "Disallow_Reverse_Volume" is deprecated / dieses Feld wird nicht mehr benutzt da diese Info nur noch abhängig von der Metersize ist
' Todo: dieses Feld aus der Datenbank endgültig entfernen
rsZiel.setValue "Disallow_Reverse_Volume", 1
rsZiel.setValue "Alarm_Leakage", rsQuelle.getBooleanValue("AlertLeakage")
rsZiel.setValue "Alarm_Broken_Pipe", rsQuelle.getBooleanValue("AlertBrokenPipe")
rsZiel.setValue "Alarm_Low_Battery", rsQuelle.getBooleanValue("AlertLowBattery")
rsZiel.setValue "Alarm_Magnetic_Tamper", rsQuelle.getBooleanValue("AlertMagneticTampering")
rsZiel.setValue "Alarm_Backflow", rsQuelle.getBooleanValue("AlertBackflow")
rsZiel.setValue "Alarm_Metrology_Unavailable", False
rsZiel.setValue "Alarm_Medium_Absent", False
rsZiel.setValue "Alarm_Specific_Error", False
rsZiel.setValue "Data_Logging_Forward_Counter", rsQuelle.getBooleanValue("DataLoggingForwardCounter")
rsZiel.setValue "Data_Logging_Time_Of_Minimum_Flow", rsQuelle.getBooleanValue("DataLoggingTimeOfMinimumFlow")
rsZiel.setValue "Data_Logging_Minimum_Flow", rsQuelle.getBooleanValue("DataLoggingMinimumFlow")
rsZiel.setValue "Data_Logging_Time_Of_Broken_Pipe", rsQuelle.getBooleanValue("DataLoggingTimeOfBrokenPipe")
rsZiel.setValue "Data_Logging_Broken_Pipe_Flow", rsQuelle.getBooleanValue("DataLoggingBrokenPipeFlow")
rsZiel.setValue "Data_Logging_Current_Flow", rsQuelle.getBooleanValue("DataLoggingCurrentFlow")
rsZiel.setValue "Data_Logging_Time_Of_Peak_Flow", rsQuelle.getBooleanValue("DataLoggingTimeOfPeakFlow")
rsZiel.setValue "Data_Logging_Peak_Flow", rsQuelle.getBooleanValue("DataLoggingPeakFlow")
rsZiel.setValue "Data_Logging_Time_Of_Maximum_Flow", rsQuelle.getBooleanValue("DataLoggingTimeOfMaximumFlow")
rsZiel.setValue "Data_Logging_Maximum_Flow", rsQuelle.getBooleanValue("DataLoggingMaximumFlow")
rsZiel.setValue "Data_Logging_Backward_Volume", rsQuelle.getBooleanValue("DataLoggingBackwardVolume")
rsZiel.setValue "Data_Logging_Counter", rsQuelle.getBooleanValue("DataLoggingCounter")
rsZiel.setValue "Data_Logging_Alarm_State", rsQuelle.getBooleanValue("DataLoggingAlertState")
rsZiel.setValue "FDR_Day_Of_Data_Reading", rsQuelle.getByteValue("ReadingDayofMonth_Value")
rsZiel.setValue "FDR_Forward_Counter", rsQuelle.getBooleanValue("FixDataReadingForwardCounter")
rsZiel.setValue "FDR_Time_Of_Minimum_Flow", rsQuelle.getBooleanValue("FixDataReadingTimeOfMinimumFlow")
rsZiel.setValue "FDR_Minimum_Flow", rsQuelle.getBooleanValue("FixDataReadingMinimumFlow")
rsZiel.setValue "FDR_Time_Of_Broken_Pipe", rsQuelle.getBooleanValue("FixDataReadingTimeOfBrokenPipe")
rsZiel.setValue "FDR_Broken_Pipe_Flow", rsQuelle.getBooleanValue("FixDataReadingBrokenPipeFlow")
rsZiel.setValue "FDR_Current_Flow", rsQuelle.getBooleanValue("FixDataReadingCurrentFlow")
rsZiel.setValue "FDR_Time_Of_Peak_Flow", rsQuelle.getBooleanValue("FixDataReadingTimeOfPeakFlow")
rsZiel.setValue "FDR_Peak_Flow", rsQuelle.getBooleanValue("FixDataReadingPeakFlow")
rsZiel.setValue "FDR_Time_Of_Maximum_Flow", rsQuelle.getBooleanValue("FixDataReadingTimeOfMaximumFlow")
rsZiel.setValue "FDR_Maximum_Flow", rsQuelle.getBooleanValue("FixDataReadingMaximumFlow")
rsZiel.setValue "FDR_Backward_Volume", rsQuelle.getBooleanValue("FixDataReadingBackwardVolume")
rsZiel.setValue "FDR_Counter", rsQuelle.getBooleanValue("FixDataReadingCounter")
rsZiel.setValue "FDR_Alarm_State", rsQuelle.getBooleanValue("FixDataReadingAlertState")
rsZiel.setValue "Broken_Pipe_Period_Id", rsQuelle.getByteValue("BrokenPipePeriode_ID")
rsZiel.setValue "Broken_Pipe_Threshold_Id", rsQuelle.getByteValue("BrokenPipeThreshold_ID")
rsZiel.setValue "Leakage_Period_Id", rsQuelle.getByteValue("LeakagePeriode_ID")
rsZiel.setValue "Leakage_Threshold_Id", rsQuelle.getByteValue("LeakageThreshold_ID")
rsZiel.setValue "Data_Logging_Period_Id", rsQuelle.getByteValue("DataLoggingPeriod_ID")
rsZiel.setValue "History_Error_Limits_Days", rsQuelle.getByteValue("HistoricErrorLimitDay_Value")
rsZiel.setValue "LAT_Interval", rsQuelle.getByteValue("ListenAfterTalk_Value")
rsZiel.setValue "Transmission_Intervall", rsQuelle.getByteValue("TransmissionInterval_Value")
rsZiel.setValue "UTC_Offset_Id", rsQuelle.getByteValue("UTCOffset_ID")
rsZiel.setValue "Wake_Up_Interval_Id", rsQuelle.getByteValue("WakeUpInterval_ID")
rsZiel.update
Copy_CSD_Data = True
Exit Function
Errorhandler:
MsgBox "ViewCSDConfiguration=>eRegister_Auftragposition (CSD=" & strCSD & "," & byteMetersize & ") konnte nicht kopiert werden." & vbCrLf & " Fehler " & Err.Number & " :" & Err.Description
End Function
Private Function GetKundenFunkschluessel(eRegister As CeRegister, ByRef strKey) As Boolean
Dim strCSD As String
Dim strSQL As String
Dim rs As CRecordset
strKey = ""
GetKundenFunkschluessel = False
If Not eRegister Is Nothing Then
If Not eRegister.mobj_eRegister_Auftragposition Is Nothing Then
strCSD = eRegister.mstr_CSD
Set rs = New CRecordset
strSQL = "SELECT * from eRegister_CSD_Radiokey where CSD='" & strCSD & "'"
rs.openRS strSQL, True
If Not rs.EOF Then
strKey = rs.getStringValue("Radiokey")
GetKundenFunkschluessel = True
Exit Function
Else
MsgBox "Laut SAP gibt es einen Kundenschlüssel für diesen Auftrag. " & vbCrLf & "Der Kundenschlüssel für CSD='" & strCSD & "' wurde in Tabelle [eRegister_CSD_Radiokey] nicht gefunden. Bitte überprüfen lassen."
Exit Function
End If
Else
MsgBox "Fehler in GetKundenFunkschluessel(): eRegister.mobj_eRegister_Auftragposition Is Nothing"
Exit Function
End If
Else
MsgBox "Fehler in GetKundenFunkschluessel(): eRegister Is Nothing "
Exit Function
End If
Exit Function
Errorhandler:
MsgBox "Fehler " & Err.Number & " in GetKundenFunkschluessel. " & Err.Description
GetKundenFunkschluessel = False
End Function
Public Function MesspunktAufnehmen() As Boolean
Dim Einbauplatz As CEinbauplatz
' vorhandene Werte löschen
For Each Einbauplatz In m_colEinbauplatz
MSFlexGrid1.TextMatrix(fgZeile.Zeile_Pz_Timestamp, Einbauplatz.getNr) = ""
MSFlexGrid1.TextMatrix(fgZeile.Zeile_Pz_Volume, Einbauplatz.getNr) = ""
Next
'letzte Zeile
m_PAMZeile = MSFlexGrid1.Rows - 1
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, ""
' LED für 5 Minuten einschalten, um das Startvolumen und Endvolumen zu lesen
Sende_LED True, False, False
PrintStatus "Öffne COMPorts"
' alle COM öffnen
StartOptoEmpfang
' Warten bis alle Einbauplätze gesendet haben
PrintStatus "Warte auf Opto Telegramme"
Get_New_eRegister_Opto_Data (True) ' auch Befundprüfungen zulassen
' alle COM schliessen
PrintStatus "Schliesse COM Ports"
StopOptoEmpfang
End Function
Public Function WakeUp() As Boolean
Dim Einbauplatz As CEinbauplatz
Dim strCMDHex As String
Dim Laenge As Byte
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "Wake Up"
For Each Einbauplatz In m_colEinbauplatz
strCMDHex = ""
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
If Einbauplatz.eRegister.m_StateClosed Then
' verschlossene Zähler wecken mit Key und AuthLevel 2
strCMDHex = "0000"
strCMDHex = strCMDHex & ProvideAuthLevelHexCommand(2)
Einbauplatz.eRegister.m_bUseKey = True
' Länge der PAM berechnen
Laenge = Len(strCMDHex) / 2
strCMDHex = Hex2(Laenge) & strCMDHex
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
Else
' offenens Werk wecken
strCMDHex = "0000"
Laenge = Len(strCMDHex) / 2
strCMDHex = Hex2(Laenge) & strCMDHex
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
End If
End If
End If
Next
WakeUp = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("Wake Up", 20)
End Function
Private Function ChangePowerLevel() As Boolean
On Error GoTo Errorhandler
'Auth. Level: (Production Mode for SensusRF Power Level) 3 (For setting FlexNet Power Level)
Dim Einbauplatz As CEinbauplatz
Dim strCMDHex As String
Dim Laenge As Byte
Dim strSQL As String
Dim strTyp As String
Dim rs As CRecordset
Dim strPowerlevelHex As String
Dim bytePowerlevel As Byte
Dim intNennweite As Integer
Dim objVakoCode As CVakoCode
Dim strVakoCode As String
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "RFPowerLevel"
For Each Einbauplatz In m_colEinbauplatz
strCMDHex = ""
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
' Suche nach einem von der Norm abweichenden PowerLevel
' VakoCode des aktuellen Werkes
strVakoCode = Einbauplatz.getPruefzaehler.getIdentNrObj.GetVakoCode
Set objVakoCode = New CVakoCode
' Laden zum auswerten
If Not objVakoCode.load(strVakoCode) Then
MsgBox "RF PowerLevel: VakoCode " & strVakoCode & " konnte nicht nicht geladen werden!", vbCritical, "Fehler beim Bestimmen des RFPowerlevels"
ChangePowerLevel = False
Exit Function
End If
strTyp = Einbauplatz.getPruefzaehler.getIdentNrObj.getTyp
' Typ normalisieren
Select Case strTyp
Case "MMS"
'Normierter Typ vom MS zum Suchen in der Tabelle eRegister_RFPowerlevel
strTyp = "MS"
Case "Meitwin", "MTW", "612", "MeitwinRF"
'Normierter Typ vom Nebenzähler zum Suchen in der Tabelle eRegister_RFPowerlevel
strTyp = "Meitwin"
If IsInIDE() Then
Stop
End If
If Left(strVakoCode, 5) = "MTWNZ" Then
' Ist Nebenzähler?
' ==> Die Nennweite vom HZ wird zum Nachschlagen verwendet
If Einbauplatz.getPruefzaehler.getAuftragPosition.m_lLead_AuftragNr > 0 Then
' NZ ist im Auftragsnetz
' VakoCode neu laden mit der FANr vom HZ ( = LeadAuftragNr)
Set objVakoCode = GetVakoForHauptzaehler(Einbauplatz.getPruefzaehler.getAuftragPosition.m_lLead_AuftragNr)
If objVakoCode Is Nothing Then
MsgBox "RF Powerlevel: HZ VakoCode (FaNr " & Einbauplatz.getPruefzaehler.getAuftragPosition.m_lLead_AuftragNr & ") konnte nicht geladen werden!", vbCritical, "Fehler beim Bestimmen des RFPowerlevels"
ChangePowerLevel = False
Exit Function
End If
' ende im Auftragsnetz
Else
' nicht im Auftragsnetz
If Val(objVakoCode.GetWert("Mehrbereich")) > 0 Then
' Mehrbereich!
' noch nicht geklärt !
PrintStatus "Ebp " & Einbauplatz.getNr & ": RFPowerlevel für Mehrbereich Nebenzähler ist nicht definiert!"
MsgBox "RF Powerlevel für Mehrbereich Nebenzähler ist nicht definiert! ", vbCritical, "Fehler beim Bestimmen des RFPowerlevels"
MSFlexGrid1.text = " Fehler! "
ChangePowerLevel = False
Exit Function
Else
' kein Mehrbereich
End If
' ende nicht im Auftragsnetz
End If
' ende ' Ist Nebenzähler?
Else
' HZ
End If
Case Else
' andere Typen
End Select
intNennweite = Val(objVakoCode.GetWert("Nennweite"))
If intNennweite = 0 Then
PrintStatus "RF Powerlevel für Zähler an Ebp " & Einbauplatz.getNr & " mit Nennweite = 0 ist nicht definiert!" & vbCrLf & "Typ= " & strTyp & ", Vako=" & objVakoCode.GetVakoCode
MsgBox "RF Powerlevel für Zähler an Ebp " & Einbauplatz.getNr & " mit Nennweite = 0 ist nicht definiert!" & vbCrLf & "Typ= " & strTyp & ", Vako=" & objVakoCode.GetVakoCode, vbCritical, "Fehler beim Bestimmen des RFPowerlevels"
MSFlexGrid1.text = " ERR "
ChangePowerLevel = False
Exit Function
Else
' Nennweite und Typ vorhanden
strSQL = "SELECT PowerLevelHex,ID from eRegister_RFPowerlevel where Typ = '" & strTyp & "' and Nennweite = " & intNennweite & " and Frequenz = " & Einbauplatz.eRegister.m_iFrequenz
End If
Set rs = New CRecordset
rs.openRS strSQL, True
If Not rs.EOF Then
' von der Norm abweichenden PowerLevel gefunden
If Einbauplatz.eRegister.m_StateClosed = False Then
' Production Only
strPowerlevelHex = UCase(rs.getStringValue("PowerLevelHex"))
'in Dezimal umwandeln
bytePowerlevel = HexToDec(strPowerlevelHex) And 255
' Test auf Richtigkeit des HEX strings
If Hex2(bytePowerlevel) = strPowerlevelHex And Len(strPowerlevelHex) = 2 Then
' String ist korrekter Hexwert
' 2 PAMS kombinieren für SensusRF (Bit 7 ist nicht gesetzt) und Flexnet (Bit 7 ist gesetzt)
strCMDHex = "01" & Hex2(bytePowerlevel And 127) & "01" & Hex2(bytePowerlevel Or 128)
Laenge = Len(strCMDHex) / 2
strCMDHex = Hex2(Laenge) & strCMDHex
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
PrintStatus "Ebp " & Einbauplatz.getNr & ": " & strTyp & " DN " & intNennweite & ", " & Einbauplatz.eRegister.m_iFrequenz & " Mhz: RF Powerlevel: " & Hex2(bytePowerlevel And 127)
Else
MSFlexGrid1.text = " ERR "
PrintStatus "RF Powerlevel: Kein gültiger Hex-Wert '" & strPowerlevelHex & "' in Tabelle eRegister_RFPowerlevel: ID=" & rs.getIntValue("ID")
LogIntoDB "RF Powerlevel: Kein gültiger Hex-Wert '" & strPowerlevelHex & "' in Tabelle eRegister_RFPowerlevel: ID=" & rs.getIntValue("ID"), "eRegister"
MsgBox "RF Powerlevel: Kein gültiger Hex-Wert '" & strPowerlevelHex & "' in Tabelle eRegister_RFPowerlevel: ID=" & rs.getIntValue("ID"), vbCritical, "Fehler beim Bestimmen des RFPowerlevels"
ChangePowerLevel = False
Exit Function
End If
Else
' Zähler ist geschlossen, RF Powerlevel überspringen
MSFlexGrid1.text = " - "
End If
Else
NextEinbauplatz:
' für diese Typ/Nennweite/Frequenz wird der Powerlevel nicht geändert
PrintStatus "kein abweichender RF Powerlevel definiert für " & strTyp & " " & intNennweite & ", " & Einbauplatz.eRegister.m_iFrequenz & " Mhz"
MSFlexGrid1.text = " - "
End If
End If
End If
Next
ChangePowerLevel = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("RFPowerLevel")
ChangePowerLevel = True
Exit Function
Errorhandler:
LogIntoDB "Fehler " & Err.Number & " in ChangePowerLevel() " & Err.Description, "Softwarefehler"
MsgBox "Fehler " & Err.Number & " in ChangePowerLevel() " & Err.Description & vbCrLf & "Bitte die Softwareentwicklung mit Screenshot benachrichtigen."
ChangePowerLevel = True
Exit Function
Resume
End Function
Private Function ChangeMeterType() As Boolean
Dim Einbauplatz As CEinbauplatz
Dim strCMDHex As String
Dim Laenge As Byte
Dim byteMeterType As Byte
Dim strTemp As String
' neu ab Radio FW Version 1.1.08
' Jeder C&I Zähler, auch der Nebenzähler vom MeitwinRF, bekommt die Kennung C&I in "Meter Type" zu Beginn der Prüfung beim Initialisieren:
' Added PAM 1F 01 11 command to allow the factory to set "Meter Type" to C & I
' For Residential Meter, Meter Type reported in SEMI is set to 10 and Flow Reporting is limited to +/- 32767.
' For C&I Meter, Meter Type in SEMI is set to 12 and Flow Reporting is exponentially compressed to fit into a 16 bit report value.
' Thames
' Rest der Kunden
' auf "Residential" (0x0A) belassen
On Error GoTo Errorhandler
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "Metertype"
For Each Einbauplatz In m_colEinbauplatz
strCMDHex = ""
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
' Meter Type nur bei offenen Werke setzen
If Einbauplatz.eRegister.m_StateClosed = False Then
' nur Werke mit FW Version gleich 1.1.08 oder höher
If Val(Replace(Einbauplatz.eRegister.m_strRadio_FW_Version, ".", "")) < 1108 Then
MSFlexGrid1.text = " - "
PrintStatus "Für eRegister unterhalb Radio FW Version 1.1.08 MeterType nicht ändern."
Else
' Werke mit FW Version gleich 1.1.08 oder höher
strTemp = Replace(Einbauplatz.eRegister.mstr_CSD, " ", "")
If Val(GetGlobaleEinstellung("Pruefstation_eRegister", "FW_1108_Metertype_Residential_" & strTemp)) = 1 Then
' Ausnahmen
' neu 2017-10-12 RH
' Added PAM 1F XX 11 command to allow the factory to set Meter Type to Residential XX = 0
strCMDHex = "1F0011"
Laenge = Len(strCMDHex) / 2
strCMDHex = Hex2(Laenge) & strCMDHex
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
PrintStatus "FW 1.1.08: Ausnahme " & strTemp & " Metertype auf Residential setzen!"
Else
' für alle anderen Kunden wird die Sensus Auslesesoftware genutzt, diese kann schon jetzt mit Metertype = 0x0C = C&I umgehen
' MeterType = 12 = 0x0C = C&I:
' Debug PAM = 1F
' Debug Command Parameter = 0x01 = 1 – C & I Meter
' Debug Command Code = 17 = 0x11 = Set Metertype (C & I or Residential Meter)
strCMDHex = "1F0111"
Laenge = Len(strCMDHex) / 2
strCMDHex = Hex2(Laenge) & strCMDHex
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
PrintStatus "ab FW1.1.08 MeterType = C&I setzen!"
End If
End If ' Version >= 1.1.08
End If ' closed=false
End If ' eRegister
End If 'Pruefzaehler
Next
ChangeMeterType = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("Metertype C&I")
Exit Function
Errorhandler:
LogIntoDB "Fehler " & Err.Number & " in ChangeMeterType() " & Err.Description, "Softwarefehler"
MsgBox "Fehler " & Err.Number & " in ChangeMeterType() " & Err.Description & vbCrLf & "Bitte die Softwareentwicklung mit Screenshot benachrichtigen."
Exit Function
Resume
End Function
Private Function SetActivationByFlowThreshold()
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim strCMDHex As String
Dim Laenge As Byte
On Error GoTo Errorhandler
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "ActivationByFlow"
For Each Einbauplatz In m_colEinbauplatz
strCMDHex = ""
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
' Prüfzähler muss geprüft sein und alle Fehler innerhalb der Fehlergrenzen sein: getStatusFertigung >= 30
' eRegister darf noch nicht verschlossen sein: m_StateClosed = False
' aber alle Voraussetzungen zu m verschliessen müssen gegeben sein: m_StateClosingAllowed = true
' Aber wie ist es bei der Vorbereitung für Fuzhoe und Ebeling&Sohn ?
If (Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getStatusFertigung >= 30 And Einbauplatz.eRegister.m_StateClosed = False And Einbauplatz.eRegister.m_StateClosingAllowed = True) And Val(Replace(Einbauplatz.eRegister.m_strMetrology_FW_Version, ".", "")) >= 1108 Then
' nur erfolgreich geprüfte Werke
' "Production Only" also nur nicht-geschlossene Werke
' FW min 1.1.08
' Get Debug mit Set Activation By Flow Threshold Setting
' 1F = Get Debug
' xx = Debug Command Parameter
' 00 = Set to Default Rotations value of 8 (8*10) Rotations
' xx = 1-255 Increments of 10 * setting which translates to (10 to 2550) Rotations.
' A0 = 160 => which translates to 10 * 160 = 1600 Rotations
' 08 => which translates to 10 * 8 = 80 Rotations.
' 0F = Debug Command Code = 15 = Set Activation By Flow Threshold
Select Case Einbauplatz.eRegister.mstr_CSD
Case "CSD 769400"
' für Thames Water
' Mail vom 28.8.2017: Wenn wir die Funkaktivierung durch Durchfluss einführen,
' müssen für ThamesWater die jetzigen Parameter bleiben (80 Pulse). Gruß Jens
' also 00 = Set to Default Rotations value of 8 (8*10) Rotations
strCMDHex = "1F000F"
PrintStatus "Ebp " & Einbauplatz.getNr & ": CSD 769400! Activation By Flow Threshold = 0x08 (8 * 10 = 80)"
Case Else
Select Case Einbauplatz.eRegister.mb_Programming_Metersize
Case 53, 54, 55
' für Nebenzähler 612
strCMDHex = "1F080F"
PrintStatus "Ebp " & Einbauplatz.getNr & ": 612 NZ! Activation By Flow Threshold = 0x08 (8 * 10 = 80)"
Case Else
' für alle anderen
strCMDHex = "1FA00F"
PrintStatus "Ebp " & Einbauplatz.getNr & ": Activation By Flow Threshold = 0xA0 (160 * 10 = 1600)"
End Select
End Select
Laenge = Len(strCMDHex) / 2
strCMDHex = Hex2(Laenge) & strCMDHex
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
Else
MSFlexGrid1.text = " - "
End If
End If 'Einbauplatz.eRegister
End If 'Einbauplatz.getPruefzaehler
Next
SetActivationByFlowThreshold = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("ActivationByFlow")
AutoSpaltenBreite MSFlexGrid1, lblAutosize
Exit Function
Errorhandler:
LogIntoDB "Fehler " & Err.Number & " in SetActivationByFlowThreshold() " & Err.Description, "Softwarefehler"
MsgBox "Fehler " & Err.Number & " in SetActivationByFlowThreshold() " & Err.Description & vbCrLf & "Bitte die Softwareentwicklung mit Screenshot benachrichtigen."
SetActivationByFlowThreshold = False
End Function
Private Function DisableOTA() As Boolean
Dim Einbauplatz As CEinbauplatz
Dim strCMDHex As String
Dim Laenge As Byte
On Error GoTo Errorhandler
m_PAMZeile = m_PAMZeile + 1
SetFlexgridRow m_PAMZeile, MSFlexGrid1, "Disable OTA"
For Each Einbauplatz In m_colEinbauplatz
strCMDHex = ""
MSFlexGrid1.row = m_PAMZeile
MSFlexGrid1.col = Einbauplatz.getNr
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = ""
If Left(Einbauplatz.eRegister.m_strMetrology_FW_Version, 4) = "1.0." Then
' Bei der Version FW 1.0 kein OTA deaktivieren
MSFlexGrid1.text = " - "
PrintStatus "Für eRegister mit FW Version 1.0.xx kein OTA deaktivieren."
ElseIf Left(Einbauplatz.eRegister.m_strMetrology_FW_Version, 4) = "1.1." Then
' ab FW Version 1.1
Select Case Einbauplatz.eRegister.mstr_CSD
Case "CSD 769400"
' Thames Water darf weiterhin FW-Updates OTA durchführen
MSFlexGrid1.text = " - "
PrintStatus "OTA zulassen für 'CSD 769400'"
Case Else
If Einbauplatz.eRegister.m_StateClosed = False Then
' Production Only
' bei allen anderen OTA deaktivieren!
strCMDHex = "1F0110"
Laenge = Len(strCMDHex) / 2
strCMDHex = Hex2(Laenge) & strCMDHex
Einbauplatz.eRegister.m_sNaechsterPAMBefehl = strCMDHex
Else
MSFlexGrid1.text = " - "
PrintStatus "OTA deaktivieren ist bei geschlossenen Werken unmöglich und wird übersprungen für Einbauplatz " & Einbauplatz.getNr
End If
End Select
Else
MSFlexGrid1.text = " / "
PrintStatus "DisableOTA ist für die Firmware Version " & Left(Einbauplatz.eRegister.m_strMetrology_FW_Version, 4) & "xx nicht definiert!"
MsgBox "DisableOTA ist für die Firmware Version " & Left(Einbauplatz.eRegister.m_strMetrology_FW_Version, 4) & "xx nicht definiert!", vbCritical, "Fehler beim "
End If ' version
End If 'Einbauplatz.eRegister
End If 'Einbauplatz.getPruefzaehler
Next
DisableOTA = Sende_PAM_an_alle_Zaehler_und_Warte_auf_Semi("DisableOTA")
Exit Function
Errorhandler:
LogIntoDB "Fehler " & Err.Number & " in DisableOTA() " & Err.Description, "Softwarefehler"
MsgBox "Fehler " & Err.Number & " in DisableOTA() " & Err.Description & vbCrLf & "Bitte die Softwareentwicklung mit Screenshot benachrichtigen."
DisableOTA = True
End Function
Public Function Fortschrittrueckmeldung_eRegister_Geschlossen(lngFertigungsAuftragNr As Long, intTeilmenge As Integer)
Dim rs As CRecordset
Dim strSQL As String
Dim strQL As String
Dim lngPrueferNr As Long
Dim lngAuftragsMenge As Long
Dim lngGeschlossenMenge As Long
' PP01 Meistream "eRegister wurde verschlossen"
Const VORGANGSNUMMER_EREG_CLOSED = 997
On Error GoTo Errorhandler
lngPrueferNr = g_App.Mitarbeiter.getPrueferNr
strSQL = "SELECT * From Fortschrittsrueckmeldung WHERE 1=0"
Set rs = New CRecordset
rs.openRS strSQL, False
rs.addNew
rs.setValue "FertigungsauftragNr", lngFertigungsAuftragNr
rs.setValue "Vorgang", "eRegG"
rs.setValue "TLMenge", intTeilmenge
rs.setValue "Vorgangsnr", VORGANGSNUMMER_EREG_CLOSED
rs.setValue "Rueckmeldedatum", Null
rs.setValue "Version", "Pruef2000 " & App.Major & "." & App.Minor & "." & App.Revision
rs.setValue "Personalnr", lngPrueferNr
rs.update
PrintStatus "Fortschrittsrueckmeldung (" & VORGANGSNUMMER_EREG_CLOSED & "=Geschlossen) für " & intTeilmenge & " Zähler des Fertigungsauftrag " & lngFertigungsAuftragNr & ": OK"
Fortschrittrueckmeldung_eRegister_Geschlossen = True
Exit Function
Errorhandler:
Fortschrittrueckmeldung_eRegister_Geschlossen = False
LogIntoDB "Fehler " & Err.Number & " in Fortschrittrueckmeldung_eRegister_Geschlossen(): " & Err.Description, "Softwarefehler"
End Function
Reference in New Issue View Git Blame Copy Permalink