1222 lines
43 KiB
Plaintext
1222 lines
43 KiB
Plaintext
VERSION 5.00
|
|
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 frmUSFW2Konfigurationsvergleich
|
|
Caption = "Konfigurationsvergleich"
|
|
ClientHeight = 9345
|
|
ClientLeft = 60
|
|
ClientTop = 345
|
|
ClientWidth = 14160
|
|
LinkTopic = "Form1"
|
|
ScaleHeight = 9345
|
|
ScaleWidth = 14160
|
|
StartUpPosition = 3 'Windows-Standard
|
|
Begin VB.Frame frameSchloss
|
|
Height = 975
|
|
Left = 60
|
|
TabIndex = 5
|
|
Top = 7980
|
|
Width = 11835
|
|
Begin VB.CheckBox chkNurFehlerhafte
|
|
Caption = "nur fehlerhafte Variablen"
|
|
Height = 315
|
|
Left = 9540
|
|
TabIndex = 12
|
|
Top = 480
|
|
Value = 1 'Aktiviert
|
|
Width = 2055
|
|
End
|
|
Begin VB.CheckBox chkNurWichtigeSpalten
|
|
Caption = "nur wichtige Spalten"
|
|
Height = 315
|
|
Left = 9540
|
|
TabIndex = 11
|
|
Top = 180
|
|
Width = 1995
|
|
End
|
|
Begin VB.CommandButton cmdPrint
|
|
Caption = "Drucken"
|
|
Height = 675
|
|
Left = 5700
|
|
TabIndex = 10
|
|
Top = 240
|
|
Width = 1515
|
|
End
|
|
Begin VB.CommandButton cmdEnableCloseLock
|
|
Height = 135
|
|
Left = 60
|
|
TabIndex = 9
|
|
ToolTipText = "nur für Notfälle: schaltet die Buttons frei."
|
|
Top = 210
|
|
Width = 135
|
|
End
|
|
Begin VB.CommandButton cmdNichtSchliessen
|
|
Caption = "NICHT Schliessen"
|
|
Height = 315
|
|
Left = 3630
|
|
TabIndex = 7
|
|
Top = 600
|
|
Width = 1755
|
|
End
|
|
Begin VB.CommandButton cmdSchlossSchliessen
|
|
BackColor = &H008080FF&
|
|
Caption = "Schloss schliessen"
|
|
Height = 315
|
|
Left = 3600
|
|
MaskColor = &H8000000B&
|
|
TabIndex = 6
|
|
Top = 240
|
|
Width = 1755
|
|
End
|
|
Begin VB.Label Label1
|
|
Caption = "Möchten Sie das Schloss schliessen ? "
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 13.5
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 735
|
|
Left = 270
|
|
TabIndex = 8
|
|
Top = 180
|
|
Width = 3345
|
|
End
|
|
End
|
|
Begin VB.Timer Timer1
|
|
Left = 12420
|
|
Top = 60
|
|
End
|
|
Begin VB.TextBox txtOutput
|
|
Height = 2625
|
|
Left = 60
|
|
MultiLine = -1 'True
|
|
ScrollBars = 2 'Vertikal
|
|
TabIndex = 3
|
|
Top = 5220
|
|
Width = 13995
|
|
End
|
|
Begin MSComctlLib.StatusBar StatusBar1
|
|
Align = 2 'Unten ausrichten
|
|
Height = 345
|
|
Left = 0
|
|
TabIndex = 1
|
|
Top = 9000
|
|
Width = 14160
|
|
_ExtentX = 24977
|
|
_ExtentY = 609
|
|
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 MSFlexGrid1
|
|
Height = 4695
|
|
Left = 90
|
|
TabIndex = 0
|
|
Top = 480
|
|
Width = 14025
|
|
_ExtentX = 24739
|
|
_ExtentY = 8281
|
|
_Version = 393216
|
|
End
|
|
Begin VB.Label lblKonfigurationsvergleichInfo
|
|
BorderStyle = 1 'Fest Einfach
|
|
Caption = "Der Konfigurationsvergleich wird durchgeführt."
|
|
Height = 645
|
|
Left = 120
|
|
TabIndex = 13
|
|
Top = 480
|
|
Width = 13905
|
|
End
|
|
Begin VB.Label lblZaehlerdaten
|
|
Height = 375
|
|
Left = 120
|
|
TabIndex = 4
|
|
Top = 60
|
|
Width = 13875
|
|
End
|
|
Begin VB.Label lblAutoSize
|
|
BorderStyle = 1 'Fest Einfach
|
|
Caption = "Label1"
|
|
Height = 255
|
|
Left = 180
|
|
TabIndex = 2
|
|
Top = 8640
|
|
Width = 1230
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmUSFW2Konfigurationsvergleich"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
Option Explicit
|
|
|
|
' Todo INI Datei Scharf (Ausfall möglich) oder nur Logging und PASS
|
|
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpTo As Any, lpFrom As Any, ByVal lLen As Long)
|
|
|
|
Public m_dateKonfig As Date
|
|
|
|
Public m_Einbauplatz As CEinbauplatz
|
|
|
|
Private m_COMPort As Integer
|
|
Private m_blnNurLogging As Boolean
|
|
|
|
Public m_blnActivated As Boolean
|
|
Public m_lngFabNr As Long
|
|
|
|
Public m_blnZaehlerStatusPASS As Boolean
|
|
Public m_strKonfigurationsverzeichnis As String
|
|
Public m_blnIgnoreMissingKonfigfile As Boolean
|
|
Public m_strKonfigFile As String
|
|
|
|
Private m_strLogFiles As String
|
|
Private fso As scripting.FileSystemObject
|
|
Private mobjTextstreamCompareFile As scripting.TextStream
|
|
Private mobjTextstreamLogFile As scripting.TextStream
|
|
|
|
Private mblnCancel As Boolean
|
|
|
|
Private m_intAnzahlFehler As Integer
|
|
|
|
Const SECTION_USFW2 = "USFirmware2"
|
|
|
|
Const FARBE_GRUEN = 8454016
|
|
Const FARBE_ROT = 8421631
|
|
|
|
Private Enum enumMemoryKennung
|
|
UNKNOWN = 0
|
|
E1 = 1
|
|
E2 = 2
|
|
FL = 3
|
|
End Enum
|
|
|
|
Private Enum enumDatentyp
|
|
UNKNOWN = 0
|
|
DT_U8 = 1
|
|
DT_U16 = 2
|
|
DT_U32 = 3
|
|
DT_I16 = 4
|
|
DT_I32 = 5
|
|
DT_FLOAT = 6
|
|
End Enum
|
|
|
|
Private Type TYPE_KONFIGVERGLEICH
|
|
MemoryKennung As enumMemoryKennung
|
|
Index As Long
|
|
Laenge As Long
|
|
Datentyp As enumDatentyp
|
|
IgnoreFlag As Boolean
|
|
RangeFlag As Boolean
|
|
RangeLow As Double
|
|
RangeHigh As Double
|
|
CompareFlag As Boolean
|
|
CompareValueLong As String
|
|
CompareValueFloat As Single
|
|
Varname As String
|
|
Adresse As String
|
|
CorrectionFlag As Boolean
|
|
CorrectionValuelong As String
|
|
CorrectionValueFloat As String
|
|
End Type
|
|
|
|
|
|
Private Sub chkNurFehlerhafte_Click()
|
|
Dim i As Integer
|
|
For i = 1 To MSFlexGrid1.Rows - 1
|
|
If chkNurFehlerhafte.value = vbChecked Then
|
|
If MSFlexGrid1.TextMatrix(i, MSFlexGrid1.Cols - 1) <> "ERR" Then
|
|
MSFlexGrid1.RowHeight(i) = 0
|
|
End If
|
|
Else
|
|
MSFlexGrid1.RowHeight(i) = 250
|
|
End If
|
|
Next
|
|
End Sub
|
|
|
|
Private Sub chkNurWichtigeSpalten_Click()
|
|
AutoSpaltenBreite MSFlexGrid1, lblAutosize
|
|
If chkNurWichtigeSpalten.value = vbChecked Then
|
|
ShowMinimal
|
|
Else
|
|
AutoSpaltenBreite MSFlexGrid1, lblAutosize
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub cmdEnableCloseLock_Click()
|
|
cmdSchlossSchliessen.Enabled = True
|
|
cmdNichtSchliessen.Enabled = True
|
|
End Sub
|
|
|
|
|
|
|
|
|
|
Private Sub cmdNichtSchliessen_Click()
|
|
Unload Me
|
|
End Sub
|
|
|
|
Private Sub ShowMinimal()
|
|
Dim i As Integer
|
|
For i = 0 To MSFlexGrid1.Cols - 1
|
|
Select Case i
|
|
' Spalten durch Breite=0 ausblenden
|
|
Case 0, 1, 2, 3, 4, 9, 12, 13, 14, 15
|
|
MSFlexGrid1.ColWidth(i) = 0
|
|
Case 5, 8 'flags
|
|
' Spalten verkleinern
|
|
MSFlexGrid1.ColWidth(i) = 400
|
|
End Select
|
|
Next
|
|
End Sub
|
|
|
|
Private Sub cmdPrint_Click()
|
|
Dim orient As Long
|
|
Dim strMessage As String
|
|
|
|
cmdPrint.Enabled = False
|
|
Me.MousePointer = vbHourglass
|
|
|
|
orient = Printer.Orientation
|
|
|
|
Printer.Orientation = vbPRORLandscape
|
|
|
|
strMessage = "Ergebnisse des Konfigurationsvergleichs" & vbCrLf
|
|
strMessage = strMessage & "SerienNr: " & m_Einbauplatz.getPruefzaehler.getSerienNr & vbCrLf
|
|
strMessage = strMessage & "GeräteNr: " & m_Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getFabNr & vbCrLf
|
|
strMessage = strMessage & "Prüfer: " & g_App.Mitarbeiter.getVorname & " " & g_App.Mitarbeiter.getName & vbCrLf
|
|
|
|
PrintGrid MSFlexGrid1, 15, 50, 10, 10, strMessage, Format(Now, "dd.mm.yyyy hh:mm"), 0
|
|
|
|
Printer.Orientation = orient
|
|
cmdPrint.Enabled = True
|
|
Me.MousePointer = vbNormal
|
|
End Sub
|
|
|
|
Private Sub cmdSchlossSchliessen_Click()
|
|
|
|
cmdSchlossSchliessen.Enabled = False
|
|
|
|
If FW2_Schloss_schliessen_und_Fortschrittrueckmeldung(m_Einbauplatz) = True Then
|
|
MsgBox "Schloss schließen ist erfolgreich verlaufen."
|
|
Else
|
|
MsgBox "Schloss schliessen ist fehlgeschlagen!"
|
|
End If
|
|
|
|
cmdSchlossSchliessen.Enabled = True
|
|
Unload Me
|
|
|
|
Exit Sub
|
|
|
|
|
|
|
|
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''' alt
|
|
' Dim byteSchloss As Byte
|
|
' Dim AuftragPosition As CAuftragPosition
|
|
'
|
|
'
|
|
'
|
|
' ' Schloss soll geschlossen werden
|
|
' modUSchall.FW2_SetzeSchloss m_Einbauplatz, False
|
|
' Call modUSchall.FW2_ReadVar(m_Einbauplatz, "u8_schloss", byteSchloss)
|
|
'
|
|
' Select Case byteSchloss
|
|
' Case 90
|
|
' ' Schloss ist geschlossen
|
|
' m_Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.setFW2SchlossGeschlossen True
|
|
' m_Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.save False
|
|
'
|
|
' Set AuftragPosition = m_Einbauplatz.getPruefzaehler.getAuftragPosition
|
|
' AuftragPosition.updateTLMenge_G
|
|
' AuftragPosition.save m_Einbauplatz.getPruefzaehler.getAuftrag
|
|
'
|
|
' MsgBox "Das Schloss ist geschlossen! " & AuftragPosition.GetTLMenge_G & " von " & AuftragPosition.getMenge & " Zähler(n) der Auftragsposition sind verschlossen."
|
|
' Case 165
|
|
' MsgBox "Das Schloss ist noch offen!"
|
|
' End Select
|
|
'
|
|
' ' Fertig, Formular beenden
|
|
' Unload Me
|
|
|
|
End Sub
|
|
|
|
|
|
|
|
Private Sub Form_Activate()
|
|
If m_blnActivated = True Then Exit Sub
|
|
|
|
cmdSchlossSchliessen.Enabled = False
|
|
cmdNichtSchliessen.Enabled = False
|
|
cmdPrint.Enabled = False
|
|
|
|
m_blnActivated = True
|
|
Me.caption = "Konfigurationsvergleich Einbauplatz :" & m_Einbauplatz.getNr
|
|
If Val(g_App.Settings.getUSComPort(m_Einbauplatz.getNr)) <> 0 Then
|
|
m_COMPort = Val(g_App.Settings.getUSComPort(m_Einbauplatz.getNr))
|
|
Else
|
|
MsgBox "Einbauplatz " & m_Einbauplatz.getNr & " ist keinem COM-Port zugeordnet!"
|
|
Unload Me
|
|
Exit Sub
|
|
End If
|
|
|
|
m_blnNurLogging = IIf(g_App.Settings.GetOrSetIniWert(SECTION_USFW2, "NurLogging", "1") = "1", True, False)
|
|
m_blnIgnoreMissingKonfigfile = IIf(g_App.Settings.GetOrSetIniWert(SECTION_USFW2, "IgnoreMissing", "1") = "1", True, False)
|
|
|
|
|
|
' If IsInIDE() And g_strHostname = "LAA-D-CPX565J" Then
|
|
' MsgBox "Testen der neuen Zähler-Abschluss"
|
|
' cmdTest.Visible = True
|
|
' Exit Sub
|
|
' End If
|
|
|
|
If modMBUS_SMS.WarteAufOpto(m_Einbauplatz.getNr) Then
|
|
startKonfigVergleich
|
|
Else
|
|
MsgBox "Keine Opto.Verbindung zum Einbauplatz " & m_Einbauplatz.getNr & vbCrLf & "Der Konfigurationsvergleich für diesen Einbauplatz wird übersprungen."
|
|
End If
|
|
|
|
End Sub
|
|
|
|
|
|
|
|
Private Sub Form_Load()
|
|
m_blnActivated = False
|
|
Me.Top = 0
|
|
Me.Left = 0
|
|
Me.Width = Me.ScaleWidth
|
|
Me.Height = Me.ScaleHeight
|
|
Me.WindowState = vbMaximized
|
|
|
|
Me.caption = "Pruef2000 FW2 Ultraschallzähler Konfigurationsvergleich Version" & g_App.AppVersion
|
|
|
|
chkNurWichtigeSpalten.value = vbChecked
|
|
|
|
lblKonfigurationsvergleichInfo.ZOrder (1)
|
|
MSFlexGrid1.ZOrder (0)
|
|
End Sub
|
|
|
|
|
|
|
|
Private Sub startKonfigVergleich()
|
|
On Error GoTo Errorhandler
|
|
|
|
Dim strZeile As String
|
|
Dim lngZeile As Long
|
|
Dim arZeile() As String
|
|
|
|
Dim varWert As Variant
|
|
Dim KonfigSatz As TYPE_KONFIGVERGLEICH
|
|
Dim strFileName As String
|
|
|
|
''' MSFlexGrid1.Visible = False (geht dann schneller mit vnc)
|
|
|
|
m_intAnzahlFehler = 0
|
|
|
|
m_dateKonfig = Now()
|
|
|
|
Set fso = New scripting.FileSystemObject
|
|
|
|
mblnCancel = False
|
|
|
|
If m_Einbauplatz.getPruefzaehler Is Nothing Then Exit Sub
|
|
|
|
m_lngFabNr = m_Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getFabNr
|
|
|
|
printOutput "Konfig-Vergleich für GeräteNr " & m_lngFabNr
|
|
printOutput "==================="
|
|
|
|
InitLogFile
|
|
|
|
m_strKonfigFile = m_Einbauplatz.m_strCompareFile
|
|
|
|
If Not fso.FileExists(m_strKonfigFile) Then
|
|
If m_blnIgnoreMissingKonfigfile = True Then
|
|
' Fehlen einer Datei ignorieren
|
|
MsgBox "Das Konfigurationsfile " & m_strKonfigFile & " fehlt. Konfigurationsvergleich wird überprungen."
|
|
Unload Me
|
|
Exit Sub
|
|
Else
|
|
MsgBox "Das Konfigurationsfile " & m_strKonfigFile & " fehlt. Zähler an Einbauplatz " & m_Einbauplatz.getNr & " wird FAIL"
|
|
' Fehlen einer Datei mit FAIL bestraft
|
|
FW2_writeVar m_Einbauplatz, "u8_hydraulik_flag_KEV1", 1
|
|
Unload Me
|
|
Exit Sub
|
|
End If
|
|
Else
|
|
' Datei ist vorhanden
|
|
End If
|
|
|
|
|
|
Set mobjTextstreamCompareFile = fso.OpenTextFile(m_strKonfigFile, ForReading, False, TristateMixed)
|
|
LogConfigVergleich "// CompareFile " & m_strKonfigFile & " eingelesen" & vbCrLf
|
|
|
|
MSFlexGrid1.Clear
|
|
MSFlexGrid1.Rows = 1
|
|
MSFlexGrid1.FormatString = "Memory Kennung|Index|Länge|Datentyp|Ignore Flag|Range Flag|Range Low|Range High|Compare Flag|Compare Value|Comp Value Float|Var Name|Adr|Correction Flag|Correction Value|Correction Value Float|Wert|Ergebnis"
|
|
'AutoSpaltenBreite MSFlexGrid1, lblAutoSize, , 0
|
|
ShowMinimal
|
|
DoEvents
|
|
|
|
MSFlexGrid1.FixedRows = 0
|
|
MSFlexGrid1.FixedCols = 0
|
|
|
|
With MSFlexGrid1
|
|
.WordWrap = True
|
|
.AllowUserResizing = flexResizeBoth
|
|
.RowHeight(0) = 600
|
|
.ColWidth(0) = 800
|
|
'if the height is not big enough then end of the line will be truncated
|
|
End With
|
|
|
|
If modMBUS_SMS.fw2_open_comport(m_COMPort, 9600, m_Einbauplatz.m_strMapfile, True, 1) = 0 Then
|
|
|
|
MSFlexGrid1.Visible = False
|
|
DoEvents
|
|
Do
|
|
strZeile = mobjTextstreamCompareFile.ReadLine()
|
|
lblKonfigurationsvergleichInfo.caption = lblKonfigurationsvergleichInfo.caption & "."
|
|
|
|
If Left(strZeile, 2) = "//" Then
|
|
LogConfigVergleich strZeile & vbCrLf
|
|
End If
|
|
|
|
arZeile = Split(strZeile, ";")
|
|
|
|
If ParseKonfigZeile(strZeile, KonfigSatz) Then
|
|
LogConfigVergleich " " & strZeile & vbCrLf
|
|
VerarbeiteConfigZeile arZeile, KonfigSatz
|
|
Else
|
|
Debug.Print "Zeile nicht geparsed" & strZeile
|
|
End If
|
|
|
|
If mblnCancel Then
|
|
printOutput "Der Konfig-Vergleich wurde abgebrochen."
|
|
MsgBox ("Der Konfig-Vergleich wurde abgebrochen. Der Zähler darf so nicht ausgeliefert werden. Wiederholen Sie den Konfigvergleich für diesen Zähler!")
|
|
GoTo CloseCom
|
|
End If
|
|
|
|
Loop While Not mobjTextstreamCompareFile.AtEndOfStream
|
|
End If
|
|
|
|
'u8_nowa_task_byte;13AF;1;R
|
|
strZeile = "E1;000;1;u8;F;F;0;0;T;0x00;0;u8_nowa_task_byte;13AF;F;0x00;0"
|
|
If ParseKonfigZeile(strZeile, KonfigSatz) Then
|
|
arZeile = Split(strZeile, ";")
|
|
|
|
LogConfigVergleich "// Hinzugefügt vom Pruef2000.exe :"
|
|
LogConfigVergleich " " & strZeile & vbCrLf
|
|
VerarbeiteConfigZeile arZeile, KonfigSatz
|
|
Else
|
|
Debug.Print "Zeile nicht geparsed" & strZeile
|
|
End If
|
|
|
|
CloseCom:
|
|
|
|
modMBUS_SMS.IECCOM_CloseCom
|
|
CloseLogConfigVergleich
|
|
|
|
MSFlexGrid1.Visible = True
|
|
chkNurWichtigeSpalten_Click
|
|
chkNurFehlerhafte_Click
|
|
|
|
If m_intAnzahlFehler = 0 Then
|
|
cmdSchlossSchliessen.Enabled = True
|
|
cmdNichtSchliessen.Enabled = False
|
|
printOutput "Konfig-Vergleich ergab 0 Fehler!. Alles OK! Zähler muss nun geschlossen werden!"
|
|
Else
|
|
printOutput "==================="
|
|
printOutput "Konfig-Vergleich ergab " & m_intAnzahlFehler & " Fehler!. Bitte klären!"
|
|
cmdSchlossSchliessen.Enabled = False
|
|
cmdNichtSchliessen.Enabled = True
|
|
End If
|
|
cmdPrint.Enabled = True
|
|
StatusBar1.SimpleText = "Konfig-Vergleich für diesen Zähler ist fertig!"
|
|
|
|
Exit Sub
|
|
|
|
Errorhandler:
|
|
MsgBox Err.Description
|
|
modMBUS_SMS.IECCOM_CloseCom
|
|
Exit Sub
|
|
Resume
|
|
End Sub
|
|
|
|
Private Sub VerarbeiteConfigZeile(arZeile() As String, KonfigSatz As TYPE_KONFIGVERGLEICH)
|
|
On Error GoTo Errorhandler
|
|
|
|
Dim lngZeile As Long
|
|
Dim lngSpalte As Long
|
|
Dim lngCol As Long
|
|
|
|
Dim varWert As Variant
|
|
Dim strFileName As String
|
|
|
|
MSFlexGrid1.AddItem ""
|
|
MSFlexGrid1.FixedRows = 1
|
|
|
|
lngZeile = MSFlexGrid1.Rows - 1
|
|
|
|
MSFlexGrid1.row = lngZeile
|
|
|
|
If MSFlexGrid1.Visible Then
|
|
MSFlexGrid1.SetFocus ' Required to make grid page scroll
|
|
SendKeys "{DOWN}", True
|
|
MSFlexGrid1.Refresh
|
|
End If
|
|
|
|
lngSpalte = 0
|
|
For Each varWert In arZeile
|
|
MSFlexGrid1.TextMatrix(lngZeile, lngSpalte) = arZeile(lngSpalte)
|
|
lngSpalte = lngSpalte + 1
|
|
Next
|
|
|
|
Dim err_msg As String
|
|
|
|
StatusBar1.SimpleText = "lese " & KonfigSatz.Varname
|
|
|
|
If DoConfigVergleich(KonfigSatz, err_msg, varWert) Then
|
|
MSFlexGrid1.TextMatrix(lngZeile, lngSpalte + 1) = "PASS"
|
|
MSFlexGrid1.row = lngZeile
|
|
|
|
For lngCol = 0 To lngSpalte + 1
|
|
MSFlexGrid1.col = lngCol
|
|
MSFlexGrid1.CellBackColor = FARBE_GRUEN
|
|
Next
|
|
If chkNurFehlerhafte.value = vbChecked Then
|
|
MSFlexGrid1.RowHeight(lngZeile) = 0
|
|
End If
|
|
Else
|
|
MSFlexGrid1.TextMatrix(lngZeile, lngSpalte + 1) = "ERR"
|
|
MSFlexGrid1.row = lngZeile
|
|
|
|
WriteToFW2Logfile m_Einbauplatz, " ERR: " & KonfigSatz.Varname & " = " & varWert
|
|
|
|
For lngCol = 0 To lngSpalte + 1
|
|
MSFlexGrid1.col = lngCol
|
|
MSFlexGrid1.CellBackColor = FARBE_ROT
|
|
Next
|
|
|
|
m_intAnzahlFehler = m_intAnzahlFehler + 1
|
|
End If
|
|
|
|
|
|
MSFlexGrid1.TextMatrix(lngZeile, lngSpalte) = varWert
|
|
|
|
Exit Sub
|
|
|
|
Errorhandler:
|
|
MsgBox "Fehler beim Verarbeiten einer Zeile (" & KonfigSatz.Varname & ") im Konfigvergleich: " & Err.Description, vbOKOnly Or vbCritical, "Pruef2000"
|
|
modMBUS_SMS.IECCOM_CloseCom
|
|
mblnCancel = True
|
|
|
|
Exit Sub
|
|
Resume
|
|
|
|
End Sub
|
|
|
|
' Führt einen Konfig-Vergleich für eine Variable durch
|
|
' Rückgabewert true wenn der Variablenwert positov zu bewerten ist, false wenn fehlerhaft
|
|
' Die Variable mblnCancel wird aif false gesetzt, falls ein Fortsetzen des Konfig-Vergleich danach nicht sinnvoll wäre
|
|
Private Function DoConfigVergleich(KonfigSatz As TYPE_KONFIGVERGLEICH, err_msg As String, varWert As Variant) As Boolean
|
|
Dim lngValue As Long
|
|
Dim sngValue As Single
|
|
Dim returnValue As Integer
|
|
Dim intWdh As Integer
|
|
Dim replyvalue As Integer
|
|
|
|
DoConfigVergleich = False
|
|
|
|
If KonfigSatz.IgnoreFlag Then
|
|
' Ignorierflag ist gesetzt, Variable hat also NICHT einen falschen Wert,
|
|
' der Wert muss nicht weiter überprüft werden
|
|
' und die Funktion kann mit einem positiven Ergbnis zurückkehren
|
|
DoConfigVergleich = True
|
|
LogConfigVergleich " + IgnoreFlag = true" & vbCrLf
|
|
Exit Function
|
|
End If
|
|
|
|
' automatische Wiederholung neu starten
|
|
intWdh = 0
|
|
' Einsprungspunkt für die automatische Wiederholung des Lesens bei einem Timeout
|
|
RetryVarlesen:
|
|
DoEvents
|
|
StatusBar1.SimpleText = "lese " & KonfigSatz.Varname & IIf(intWdh = 0, "", " (" & intWdh & ". Wiederholung)") & " " & IIf(returnValue = 0, "", " Grund: " & modMBUS_SMS.Errorstring(returnValue))
|
|
' Variable lesen
|
|
returnValue = modMBUS_SMS.ReadValue(KonfigSatz.Varname, varWert)
|
|
If returnValue <> modMBUS_SMS.MBUS_SMS_ERR_OK Then
|
|
' Es trat iregndein Fehler auf
|
|
Select Case returnValue
|
|
Case -1
|
|
' selbstdefinierter Fehler = falscher Variablen Typ.
|
|
printOutput "Variable " & KonfigSatz.Varname & " konnte nicht gelesen werden. Unbekannter Typ"
|
|
DoConfigVergleich = False
|
|
Exit Function
|
|
' Case 31
|
|
' ' Fehler = unbekannte Variable: Konfigvergleich abbrechen
|
|
' printOutput "Variable " & KonfigSatz.Varname & " konnte nicht gelesen werden. Grund: " & modMBUS_SMS.Errorstring(returnvalue)
|
|
' mblnCancel = True
|
|
Case Else
|
|
StatusBar1.SimpleText = "Variable " & KonfigSatz.Varname & " konnte nicht gelesen werden. Grund: " & modMBUS_SMS.Errorstring(returnValue)
|
|
' Fehler = Timeout: bis zu 4 automatische Wiedholungen
|
|
intWdh = intWdh + 1
|
|
If intWdh <= 4 Then
|
|
DoEvents
|
|
GoTo RetryVarlesen
|
|
End If
|
|
' letzte Wiedeholung leider auch fehlgeschlagen
|
|
DoEvents
|
|
' Benutzer fragen was zu tun ist. Er kann auch den Opto-Kopf aufsetzen und letze Variable wiederholt lesen
|
|
replyvalue = MsgBox("Variable '" & KonfigSatz.Varname & "' konnte nicht gelesen werden. " & vbCrLf & "Grund: " & modMBUS_SMS.Errorstring(returnValue) & vbCrLf & "Bitte Verbindung überprüfen und wiederholen." & vbCrLf & "'Abbruch' beendet den Konfigvergleich." & vbCrLf & "'Ignorieren' fährt mit der nächsten Variablen fort und führt zu einem nicht bestandenen Konfigvergleich.", vbAbortRetryIgnore Or vbDefaultButton2)
|
|
|
|
If replyvalue = vbRetry Then
|
|
' "Wiederholung" wurde geklickt
|
|
' automatische Wiederholungen zurücksetzen und das Lesen noch ein mal versuchen
|
|
intWdh = 0
|
|
GoTo RetryVarlesen
|
|
End If
|
|
|
|
If replyvalue = vbAbort Then
|
|
' "Abbrechen" wurde geklickt. Konfig-Vergleich abbrechen.
|
|
printOutput "Variable " & KonfigSatz.Varname & " konnte nicht gelesen werden. Grund: " & modMBUS_SMS.Errorstring(returnValue)
|
|
mblnCancel = True
|
|
Exit Function
|
|
End If
|
|
|
|
If replyvalue = vbIgnore Then
|
|
' "Ignorieren" wurde geklickt, diese Variable negativ bewerten und mit nächster Variable fortfahren.
|
|
DoConfigVergleich = False
|
|
printOutput "Variable " & KonfigSatz.Varname & " konnte nicht gelesen werden. Grund: " & modMBUS_SMS.Errorstring(returnValue) & " (Ignoriert)."
|
|
LogConfigVergleich " - Speicherwert = $xx -> ?; Vergleichwert " & KonfigSatz.CompareValueFloat & "; Vergleichsprüfung err;" & vbCrLf
|
|
Exit Function
|
|
End If
|
|
End Select
|
|
End If
|
|
|
|
' Die Variable konnte erfolgreich gelesen werden
|
|
If KonfigSatz.CompareFlag = True Then
|
|
' Wert auf Gleichheit überprüfen
|
|
Debug.Print KonfigSatz.Varname & "=" & CSng(varWert) & " vergleichen mit " & KonfigSatz.CompareValueFloat
|
|
' RH 2015-03-19 vergleich mit Single werten, da CompareValueFloat auch Single ist
|
|
If CSng(varWert) = CSng(KonfigSatz.CompareValueFloat) Then
|
|
DoConfigVergleich = True
|
|
'logToDB KonfigSatz.Varname, CDbl(varWert), True, CStr(KonfigSatz.CompareValueFloat)
|
|
LogConfigVergleich " + Speicherwert = $xx -> " & varWert & "; Vergleichwert " & KonfigSatz.CompareValueFloat & "; Vergleichsprüfung ok;" & vbCrLf
|
|
Exit Function
|
|
Else
|
|
'logToDB KonfigSatz.Varname, CDbl(varWert), False, CStr(KonfigSatz.CompareValueFloat)
|
|
printOutput "Falscher Wert in " & KonfigSatz.Varname & "=" & varWert & ", Sollwert=" & KonfigSatz.CompareValueFloat
|
|
LogConfigVergleich " - Speicherwert = $xx -> " & varWert & "; Vergleichwert " & KonfigSatz.CompareValueFloat & "; Vergleichsprüfung err;" & vbCrLf
|
|
End If
|
|
End If
|
|
|
|
If KonfigSatz.RangeFlag Then
|
|
' Wert auf Range überprüfen
|
|
modMBUS_SMS.ReadValue KonfigSatz.Varname, varWert
|
|
Debug.Print KonfigSatz.Varname & "=" & varWert & " zwischen " & KonfigSatz.RangeLow & " und " & KonfigSatz.RangeHigh
|
|
If varWert >= KonfigSatz.RangeLow And varWert <= KonfigSatz.RangeHigh Then
|
|
DoConfigVergleich = True
|
|
'logToDB KonfigSatz.Varname, CDbl(varWert), True, KonfigSatz.RangeLow & "-" & KonfigSatz.RangeHigh
|
|
LogConfigVergleich " + Speicherwert = $xx -> " & varWert & "; Bereich von " & KonfigSatz.RangeLow & " bis " & KonfigSatz.RangeHigh & " Bereichsprüfung ok;" & vbCrLf
|
|
Exit Function
|
|
Else
|
|
'logToDB KonfigSatz.Varname, CDbl(varWert), False, KonfigSatz.RangeLow & "-" & KonfigSatz.RangeHigh
|
|
printOutput "Wert " & KonfigSatz.Varname & "=" & varWert & " ist nicht im Sollbereich von " & KonfigSatz.RangeLow & " bis " & KonfigSatz.RangeHigh
|
|
LogConfigVergleich " - Speicherwert = $xx -> " & varWert & "; Bereich von " & KonfigSatz.RangeLow & " bis " & KonfigSatz.RangeHigh & " Bereichsprüfung err;" & vbCrLf
|
|
End If
|
|
End If
|
|
|
|
End Function
|
|
|
|
|
|
|
|
|
|
'Private Sub logToDB(Varname As String, Wert As Double, Status As Boolean, Sollwert As String)
|
|
'Dim strSQL As String
|
|
'Dim rs As CRecordset
|
|
'
|
|
'' FW2_Configvergleich
|
|
' Set rs = New CRecordset
|
|
' rs.openRS "SELECT * from FW2_Configvergleich where 1=0"
|
|
' rs.addNew
|
|
' rs.setValue "Fabnr", m_lngFabNr
|
|
' rs.setValue "Datum", m_dateKonfig
|
|
' rs.setValue "Varname", Varname
|
|
' rs.setValue "Wert", Wert
|
|
' rs.setValue "Status", Status
|
|
' rs.setValue "Sollwert", Sollwert
|
|
' 'rs.setValue "CompareFile", m_strKonfigFile
|
|
' rs.update
|
|
' Set rs = Nothing
|
|
'
|
|
'End Sub
|
|
|
|
|
|
Private Function ParseKonfigZeile(strZeile As String, KonfigSatz As TYPE_KONFIGVERGLEICH) As Boolean
|
|
Dim arZeile() As String
|
|
arZeile = Split(strZeile, ";")
|
|
|
|
On Error GoTo Errorhandler
|
|
|
|
If UBound(arZeile) = 15 Then
|
|
|
|
Select Case UCase(arZeile(0))
|
|
Case "E1"
|
|
KonfigSatz.MemoryKennung = enumMemoryKennung.E1
|
|
Case "E2"
|
|
KonfigSatz.MemoryKennung = enumMemoryKennung.E2
|
|
Case "F"
|
|
KonfigSatz.MemoryKennung = enumMemoryKennung.FL
|
|
Case Else
|
|
Debug.Print "Zeile wird nicht geparsed da unbekannte Memorykennung: " & Join(arZeile, ";")
|
|
KonfigSatz.MemoryKennung = enumMemoryKennung.UNKNOWN
|
|
ParseKonfigZeile = False
|
|
Exit Function
|
|
End Select
|
|
|
|
|
|
KonfigSatz.Index = CLng(arZeile(1))
|
|
KonfigSatz.Laenge = CLng(arZeile(2))
|
|
|
|
Debug.Print LCase(arZeile(3))
|
|
|
|
|
|
Select Case LCase(arZeile(3))
|
|
Case "u8"
|
|
KonfigSatz.Datentyp = enumDatentyp.DT_U8
|
|
Case "u16"
|
|
KonfigSatz.Datentyp = enumDatentyp.DT_U16
|
|
Case "u32"
|
|
KonfigSatz.Datentyp = enumDatentyp.DT_U32
|
|
Case "i16"
|
|
KonfigSatz.Datentyp = enumDatentyp.DT_I16
|
|
Case "i32"
|
|
KonfigSatz.Datentyp = enumDatentyp.DT_I32
|
|
Case "float"
|
|
KonfigSatz.Datentyp = enumDatentyp.DT_FLOAT
|
|
Case Else
|
|
KonfigSatz.Datentyp = enumDatentyp.UNKNOWN
|
|
End Select
|
|
|
|
KonfigSatz.IgnoreFlag = IIf(arZeile(4) <> "F", True, False)
|
|
KonfigSatz.RangeFlag = IIf(arZeile(5) <> "F", True, False)
|
|
|
|
KonfigSatz.RangeLow = CDbl(arZeile(6))
|
|
KonfigSatz.RangeHigh = CDbl(arZeile(7))
|
|
KonfigSatz.CompareFlag = IIf(arZeile(8) <> "F", True, False)
|
|
KonfigSatz.CompareValueLong = arZeile(9)
|
|
KonfigSatz.CompareValueFloat = CSng(arZeile(10))
|
|
KonfigSatz.Varname = arZeile(11)
|
|
KonfigSatz.Adresse = arZeile(12)
|
|
|
|
KonfigSatz.CorrectionFlag = IIf(arZeile(13) <> "F", True, False)
|
|
KonfigSatz.CorrectionValuelong = arZeile(14)
|
|
KonfigSatz.CorrectionValueFloat = CDbl(arZeile(15))
|
|
ParseKonfigZeile = True
|
|
Else
|
|
ParseKonfigZeile = False
|
|
Debug.Print "Zeile wird nicht geparsed da keine 15 Felder: " & Join(arZeile, ";")
|
|
Exit Function
|
|
End If
|
|
|
|
Exit Function
|
|
Errorhandler:
|
|
ParseKonfigZeile = False
|
|
End Function
|
|
|
|
Private Sub Form_Resize()
|
|
On Error Resume Next
|
|
|
|
|
|
lblZaehlerdaten.Top = 0
|
|
lblZaehlerdaten.Left = 0
|
|
lblZaehlerdaten.Width = Me.ScaleWidth
|
|
|
|
MSFlexGrid1.Left = 0
|
|
MSFlexGrid1.Top = lblZaehlerdaten.Top + lblZaehlerdaten.Height
|
|
MSFlexGrid1.Width = Me.ScaleWidth
|
|
MSFlexGrid1.Height = Me.ScaleHeight - StatusBar1.Height - txtOutput.Height - lblZaehlerdaten.Height - frameSchloss.Height
|
|
|
|
txtOutput.Top = MSFlexGrid1.Top + MSFlexGrid1.Height
|
|
txtOutput.Left = 0
|
|
txtOutput.Width = Me.ScaleWidth
|
|
|
|
frameSchloss.Left = 0
|
|
frameSchloss.Top = txtOutput.Top + txtOutput.Height
|
|
frameSchloss.Width = Me.ScaleWidth
|
|
|
|
Debug.Print Me.ScaleHeight
|
|
End Sub
|
|
|
|
|
|
|
|
Private Sub printOutput(strZeile As String)
|
|
txtOutput.text = txtOutput.text & strZeile & vbCrLf
|
|
txtOutput.SelStart = Len(txtOutput.text)
|
|
txtOutput.SelLength = 1
|
|
End Sub
|
|
|
|
Private Sub CopyToClipboard()
|
|
Dim x As Integer
|
|
Dim y As Integer
|
|
Dim strInhalt As String
|
|
For y = 0 To MSFlexGrid1.Rows - 1
|
|
For x = 0 To MSFlexGrid1.Cols - 1
|
|
strInhalt = strInhalt & MSFlexGrid1.TextMatrix(y, x) & vbTab
|
|
Next
|
|
strInhalt = strInhalt & vbCrLf
|
|
Next
|
|
strInhalt = Replace(strInhalt, vbTab & vbCrLf, vbCrLf)
|
|
Clipboard.setText strInhalt
|
|
End Sub
|
|
|
|
|
|
Private Sub InitLogFile()
|
|
On Error GoTo Errorhandler
|
|
Dim strFileName As String
|
|
If Not mobjTextstreamLogFile Is Nothing Then
|
|
mobjTextstreamLogFile.Close
|
|
End If
|
|
|
|
|
|
m_strLogFiles = g_App.Settings.readStringValue(SECTION_USFW2, "Logfiles", "")
|
|
If m_strLogFiles <> "" Then
|
|
If Right(m_strLogFiles, 1) <> "\" Then m_strLogFiles = m_strLogFiles & "\"
|
|
|
|
strFileName = m_strLogFiles & m_lngFabNr & "_compare_" & Format(Now, "yyyy-mm-dd_hh-mm") & ".log"
|
|
DebugMsg "Configvergleich Logfile=" & strFileName
|
|
Set mobjTextstreamLogFile = fso.CreateTextFile(strFileName, True, False)
|
|
End If
|
|
Errorhandler:
|
|
End Sub
|
|
|
|
Private Sub LogConfigVergleich(strText As String)
|
|
On Error Resume Next
|
|
mobjTextstreamLogFile.Write strText
|
|
End Sub
|
|
|
|
Private Sub CloseLogConfigVergleich()
|
|
If Not mobjTextstreamLogFile Is Nothing Then
|
|
mobjTextstreamLogFile.Close
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub Form_Unload(Cancel As Integer)
|
|
On Error Resume Next
|
|
If Not mobjTextstreamLogFile Is Nothing Then
|
|
mobjTextstreamLogFile.Close
|
|
End If
|
|
|
|
IECCOM_CloseCom
|
|
End Sub
|
|
|
|
|
|
|
|
'Private Sub cmdTest_Click()
|
|
' cmdTest.Enabled = False
|
|
'
|
|
' If Schloss_schliessen() = True Then
|
|
' MsgBox "Schloss schliessen ist erfolgreich verlaufen."
|
|
' Else
|
|
' MsgBox "Schloss schliessen ist fehlgeschlagen!"
|
|
' End If
|
|
'
|
|
' cmdTest.Enabled = True
|
|
'End Sub
|
|
|
|
|
|
'Public Function Schloss_schliessen() As Boolean
|
|
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
' ' Schloss schließen
|
|
' ' Schloss geschlossen überprüfen
|
|
' '
|
|
' ' Schloss geschlossen in Datenbank vermerken
|
|
' ' Schloss geschlossen protokollieren
|
|
' ' Fortschrittrückmeldung "G" für diesen einen Zähler, wenn noch nicht bereits erledigt
|
|
' ' TLMenge in Auftragposition vermerken
|
|
' ' wenn TLMenge = Menge dann FertMeld_GTerm_Dat und FertMeld_GTerm_MA setzen
|
|
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
' Dim byteSchloss As Byte
|
|
' Dim AuftragPosition As CAuftragPosition
|
|
' Dim AuftragpositionSerienNr As CAuftragPositionSerienNr
|
|
' Dim Pruefzaehler As CPruefzaehler
|
|
'
|
|
' Dim ret As Integer
|
|
' Dim strSQL As String
|
|
' Dim rs As CRecordset
|
|
' Dim recordsaffected As Long
|
|
' Dim errnum As Long
|
|
' Dim errdesc As String
|
|
'
|
|
' On Error GoTo Errorhandler
|
|
'
|
|
' Set Pruefzaehler = m_Einbauplatz.getPruefzaehler
|
|
' Set AuftragPosition = Pruefzaehler.getAuftragPosition
|
|
' Set AuftragpositionSerienNr = Pruefzaehler.getAuftragPositionSerienNr
|
|
'
|
|
'Wiederholen_Lesen_1:
|
|
' ''''''''''''''''''''''''''''''''''''''
|
|
' ' Schloss überprüfen, sollte noch offen sein
|
|
' ret = modUSchall.FW2_ReadVar(m_Einbauplatz, "u8_schloss", byteSchloss)
|
|
' If ret <> 0 Then
|
|
' ret = MsgBox("Das Schloss konnte nicht überprüft werden. " & modMBUS_SMS.Errorstring(ret), vbAbortRetryIgnore)
|
|
' Select Case ret
|
|
' Case vbRetry
|
|
' GoTo Wiederholen_Lesen_1
|
|
' Case vbIgnore
|
|
' ' egal, weitermachen!
|
|
' Case vbAbort
|
|
' Schloss_schliessen = False
|
|
' Exit Function
|
|
' End Select
|
|
' Else
|
|
' Select Case byteSchloss
|
|
' Case 165
|
|
' ' Schloss ist offen, alles OK
|
|
' Case 90
|
|
' ' OK geschlossen
|
|
' MsgBox "Das Schloss im Rechenwerk von Einbauplazt " & m_Einbauplatz.getNr & " ist schon geschlossen.", vbInformation
|
|
' End Select
|
|
' End If
|
|
' ''''''''''''''''''''''''''''''''''''''''
|
|
'
|
|
'
|
|
'Wiederholen_schließen:
|
|
' ''''''''''''''''''''''''''''''''''''''
|
|
' ' Schloss schließen
|
|
' ret = modUSchall.FW2_SetzeSchloss(m_Einbauplatz, False)
|
|
' If ret <> 0 Then
|
|
' ret = MsgBox("Das Schloss im RW konnte nicht verschlossen werden. " & modMBUS_SMS.Errorstring(ret), vbRetryCancel Or vbCritical)
|
|
' Select Case ret
|
|
' Case vbRetry
|
|
' GoTo Wiederholen_schließen
|
|
' Case vbCancel
|
|
' Schloss_schliessen = False
|
|
' Exit Function
|
|
' End Select
|
|
' End If
|
|
' ''''''''''''''''''''''''''''''''''''''
|
|
'
|
|
'Wiederholen_Schloss_ueberpruefen:
|
|
' ''''''''''''''''''''''''''''''''''''''
|
|
' ' Schloss geschlossen überprüfen
|
|
' ret = modUSchall.FW2_ReadVar(m_Einbauplatz, "u8_schloss", byteSchloss)
|
|
' If ret <> 0 Then
|
|
' ret = MsgBox("Der Status des Schlosses konnte nicht überprüft werden. " & modMBUS_SMS.Errorstring(ret), vbAbortRetryIgnore Or vbCritical)
|
|
' Select Case ret
|
|
' Case vbRetry
|
|
' GoTo Wiederholen_Schloss_ueberpruefen
|
|
' Case vbIgnore
|
|
' ' egal, weitermachen, ohne den Status zu überprüfen
|
|
' Case vbAbort
|
|
' Schloss_schliessen = False
|
|
' Exit Function
|
|
' End Select
|
|
' Else
|
|
' Select Case byteSchloss
|
|
' Case 165
|
|
' ' hat leider nicht geklappt, Schloss ist offen
|
|
' ret = MsgBox("Das Schloss ist leider noch offen. Möchten Sie das Schließen noch einmal versuchen?", vbRetryCancel Or vbCritical)
|
|
' Select Case ret
|
|
' Case vbRetry
|
|
' GoTo Wiederholen_schließen
|
|
' Case vbCancel
|
|
' Schloss_schliessen = False
|
|
' Exit Function
|
|
' End Select
|
|
' Case 90
|
|
' ' OK geschlossen
|
|
' End Select
|
|
' End If
|
|
'
|
|
' ''''''''''''''''''''''''''''''''''''''''
|
|
' ''' GeschlosseneZaehlerAusSerienNrNachtragen
|
|
' ''''''''''''''''''''''''''''''''''''''''
|
|
'
|
|
' ' Schloss als geschlossen in Datenbank vermerken
|
|
' ' und_Fortschrittrueckmeldung "G" durchführen
|
|
' Schloss_Als_Geschlossen_In_Datenbank_vermerken_und_Fortschrittrueckmeldung m_Einbauplatz.getPruefzaehler.getSerienNr
|
|
' ''''''''''''''''''''''''''''''''''''''''
|
|
'
|
|
' ''''''''''''''''''''''''''''''''''''''''
|
|
' ' Aus Kompatibilität zu älteren Versionen StatusFlag, Seriennummer, LogIntoDb, mit AuftragpositionSerienNr.save
|
|
' AuftragpositionSerienNr.setFW2SchlossGeschlossen True
|
|
' ''''''''''''''''''''''''''''''''''''''''
|
|
'
|
|
' ''''''''''''''''''''''''''''''''''''''''''''
|
|
' ' Schauen, ob ALLE Zaehler der Auftragposition geschlossen sind
|
|
' ''''''''''''''''''''''''''''''''''''''''''''
|
|
' ' alle FW2 Zähler der Auftragposition, die geschlossen sind
|
|
' strSQL = "SELECT * from FW2_Zaehler_Info where FertigungsauftragNr = " & m_Einbauplatz.getPruefzaehler.getAuftragPosition.GetFertigungsauftragNr & " and Schloss_geschlossen_Datum is not null"
|
|
' Set rs = New CRecordset
|
|
' rs.openRS strSQL, False
|
|
' recordsaffected = rs.RecordCount
|
|
' '''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
' ' vermerken der Teilmenge in der Auftragsposition
|
|
' AuftragPosition.SetTLMenge_G recordsaffected
|
|
' AuftragPosition.save m_Einbauplatz.getPruefzaehler.getAuftrag
|
|
' '''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
' ' vermerken der Mengen in FW2_Zaehler_Info in allen betroffenen Datensätzen
|
|
' Do While Not rs.EOF
|
|
' rs.setValue "Geschlossen", recordsaffected
|
|
' rs.setValue "Menge", AuftragPosition.getMenge
|
|
' rs.update
|
|
' rs.MoveNext
|
|
' Loop
|
|
'
|
|
' If recordsaffected = AuftragPosition.getMenge Then
|
|
' ' Auftragsmenge = Anzahl der geschlossenen Zaehler
|
|
' '
|
|
' ' Alle Zähler der Auftragsposition sind komplett geschlossen:
|
|
' ' FertMeld_GTerm_Dat, FertMeld_GTerm_MA ändern per SQL update in der Statistik/Auftragposition Tabelle
|
|
' AuftragPosition.KomplettAlsGeschlossenVerzeichnenUndSpeichern
|
|
' End If
|
|
'
|
|
' Schloss_schliessen = True
|
|
'
|
|
'Exit Function
|
|
'Errorhandler:
|
|
' errnum = Err.Number
|
|
' errdesc = Err.Description
|
|
' LogIntoDB "Fehler " & errnum & " in Schloss_schliessen():" & errdesc, "Softwarefehler"
|
|
' MsgBox "Fehler " & errnum & " in Schloss_schliessen(): " & errdesc
|
|
' Schloss_schliessen = False
|
|
'Exit Function
|
|
' Resume
|
|
'End Function
|
|
|
|
'
|
|
'Private Function Schloss_Als_Geschlossen_In_Datenbank_vermerken_und_Fortschrittrueckmeldung_alt(lngSerienNr As Long, Optional strBemerkung As String) As Boolean
|
|
'
|
|
' ''''''''''''''''''''''''''''''''''''''''
|
|
' ' Schloss geschlossen für diesen Zähler in Datenbank vermerken
|
|
' ''''''''''''''''''''''''''''''''''''''''
|
|
' Dim strSQL As String
|
|
' Dim rs As CRecordset
|
|
' Dim recordsaffected As Long
|
|
'
|
|
' Dim AuftragpositionSerienNr As CAuftragPositionSerienNr
|
|
' Dim AuftragPosition As CAuftragPosition
|
|
'
|
|
' Set AuftragpositionSerienNr = New CAuftragPositionSerienNr
|
|
' If Not AuftragpositionSerienNr.load(lngSerienNr) Then
|
|
' ' SerienNr unbekannt, ignore
|
|
' Exit Function
|
|
' End If
|
|
'
|
|
' Set AuftragPosition = New CAuftragPosition
|
|
' If Not AuftragPosition.load(AuftragpositionSerienNr.getAuftragNr, AuftragpositionSerienNr.getPositionNr) Then
|
|
' 'Position unbekannt, ignore
|
|
' Exit Function
|
|
' End If
|
|
'
|
|
' ' suchen, ob es diese SerienNr schon gibt
|
|
' strSQL = "SELECT * from FW2_Zaehler_Info where SerienNr = " & lngSerienNr ''''& " and FabNr = " & m_Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getFabNr
|
|
' Set rs = New CRecordset
|
|
'
|
|
' rs.openRS strSQL, False
|
|
'
|
|
' If rs.EOF Then
|
|
' ' es gibt noch keinen Eintrag
|
|
' rs.addNew
|
|
' rs.setValue "SerienNr", lngSerienNr
|
|
' rs.setValue "FabNr", AuftragpositionSerienNr.getFabNr
|
|
' rs.setValue "AuftragNr", AuftragpositionSerienNr.getAuftragNr
|
|
' rs.setValue "PositionNr", AuftragpositionSerienNr.getPositionNr
|
|
' rs.setValue "FertigungsauftragNr", AuftragPosition.GetFertigungsauftragNr
|
|
'
|
|
' rs.setValue "Schloss_geschlossen_Datum", Now
|
|
'
|
|
' If strBemerkung <> "" Then
|
|
' rs.setValue "Bemerkung", strBemerkung
|
|
' End If
|
|
'
|
|
' Fortschrittrueckmeldung_G_fuer_einen_Zaehler AuftragPosition.GetFertigungsauftragNr, strBemerkung
|
|
'
|
|
' rs.setValue "SAP_Meldung_G_Datum", Now
|
|
' rs.update
|
|
' Else
|
|
' If Not rs.isFieldNull("Schloss_geschlossen_Datum") Then
|
|
' ' Es gibt schon einen Eintrag mit geschlossenem Schloss
|
|
' MsgBox "zur Info: Das Schloss für SNr=" & lngSerienNr & " wurde (lt. Datenbank) schon am " & Format(rs.getDateValue("Schloss_geschlossen_Datum"), "dd.mm.yyyy \u\m hh:mm") & " geschlossen."
|
|
' LogIntoDB "Das Schloss für SNr=" & lngSerienNr & " wurde (lt. Datenbank) schon am " & Format(rs.getDateValue("Schloss_geschlossen_Datum"), "dd.mm.yyyy \u\m hh:mm") & " geschlossen.", "FW2"
|
|
' Else
|
|
' ' Es gibt schon einen Eintrag, aber Schloss ist nicht geschlossen
|
|
' rs.setValue "Schloss_geschlossen_Datum", Now
|
|
' Fortschrittrueckmeldung_G_fuer_einen_Zaehler AuftragPosition.GetFertigungsauftragNr
|
|
' rs.setValue "SAP_Meldung_G_Datum", Now
|
|
' rs.update
|
|
' End If
|
|
' End If
|
|
' Schloss_Als_Geschlossen_In_Datenbank_vermerken_und_Fortschrittrueckmeldung = True
|
|
'End Function
|
|
|
|
Private Sub GeschlosseneZaehlerAusSerienNrNachtragen()
|
|
Dim strSQL As String
|
|
Dim rs As CRecordset
|
|
' alle geschlossenen Zähler aus Tabelle Seriennummer, die noch nicht in FW2_Zaehler_Info stehen
|
|
strSQL = "select * from Seriennummer where Schloss_geschlossen = 1 and SerienNr not in (select SerienNr from FW2_Zaehler_Info)"
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, True
|
|
If Not rs.EOF Then
|
|
Do While Not rs.EOF
|
|
If Schloss_Als_Geschlossen_In_Datenbank_vermerken_und_Fortschrittrueckmeldung(rs.getLongValue("SerienNr"), rs.getLongValue("SerienNr") & " nachgetragen") Then
|
|
LogIntoDB "wegen Kompatiblität SerienNr=" & rs.getLongValue("SerienNr") & " aus Tabelle Seriennummer in FW2_Zaehler_Info nachgetragen.", "FW2"
|
|
End If
|
|
|
|
rs.MoveNext
|
|
DoEvents
|
|
Loop
|
|
|
|
End If
|
|
End Sub
|
|
|
|
Private Function ConvertFloatToLong(fvalue As Single) As Long
|
|
Dim lngValue As Long
|
|
CopyMemory lngValue, fvalue, 4
|
|
ConvertFloatToLong = lngValue
|
|
End Function
|
|
|
|
|
|
|
|
'Private Function Fortschrittrueckmeldung_G_fuer_einen_Zaehler(lngFertigungsauftragNr As Long, Optional strBemerkung As String) As Boolean
|
|
'
|
|
' Dim rs As CRecordset
|
|
' Dim strSQL As String
|
|
'
|
|
' strSQL = "SELECT * from Fortschrittsrueckmeldung where 1=0"
|
|
' Set rs = New CRecordset
|
|
' rs.openRS strSQL, False
|
|
'
|
|
' rs.addNew
|
|
' rs.setValue "FertigungsauftragNr", lngFertigungsauftragNr
|
|
' rs.setValue "Vorgang", "G"
|
|
' rs.setValue "TLMenge", 1
|
|
' rs.setValue "Vorgangsnr", 40
|
|
' rs.setValue "Version", "Pruef2000 " & App.Major & "." & App.Minor & "." & App.Revision
|
|
' rs.setValue "Personalnr", g_App.Mitarbeiter.getPrueferNr
|
|
'
|
|
' If strBemerkung <> "" Then
|
|
' rs.setValue "Bemerkung", strBemerkung
|
|
' End If
|
|
' rs.update
|
|
'
|
|
' If rs.RecordCount = 1 Then
|
|
' Fortschrittrueckmeldung_G_fuer_einen_Zaehler = True
|
|
' ' alles OK
|
|
' Else
|
|
' LogIntoDB "Fortschrittrueckmeldung_G_fuer_einen_Zaehler konnte nicht gespeichert werden." & vbCrLf & "Bitte bei Fertigungssteuerung melden!", "Datenbank"
|
|
' MsgBox "Fortschrittrueckmeldung_G_fuer_einen_Zaehler konnte nicht gespeichert werden." & vbCrLf & "Bitte bei Fertigungssteuerung melden!", vbCritical
|
|
' Fortschrittrueckmeldung_G_fuer_einen_Zaehler = False
|
|
' End If
|
|
'
|
|
'End Function
|
|
'
|