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 '