Initial commit 3

2021-10-01 11:11:04 +02:00
parent 8d9b529721
commit 70e2645059
486 changed files with 279955 additions and 0 deletions
@@ -0,0 +1,146 @@
+VERSION 5.00
+Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.1#0"; "MSCOMCTL.OCX"
+Begin VB.Form frmUSFW2WarteAufOpto 
+   BackColor       =   &H8000000B&
+   BorderStyle     =   3  'Fester Dialog
+   Caption         =   "Pruef2000"
+   ClientHeight    =   2610
+   ClientLeft      =   45
+   ClientTop       =   405
+   ClientWidth     =   4680
+   LinkTopic       =   "Form1"
+   MaxButton       =   0   'False
+   MinButton       =   0   'False
+   ScaleHeight     =   2610
+   ScaleWidth      =   4680
+   ShowInTaskbar   =   0   'False
+   StartUpPosition =   3  'Windows-Standard
+   Begin VB.CommandButton cmdCancel 
+      Caption         =   "Abbrechen"
+      Height          =   315
+      Left            =   1740
+      TabIndex        =   2
+      ToolTipText     =   "Bricht das Warten auf die Opto-Verbindung ab"
+      Top             =   1920
+      Width           =   1155
+   End
+   Begin MSComctlLib.StatusBar StatusBar1 
+      Align           =   2  'Unten ausrichten
+      Height          =   315
+      Left            =   0
+      TabIndex        =   1
+      Top             =   2295
+      Width           =   4680
+      _ExtentX        =   8255
+      _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 VB.Timer Timer1 
+      Left            =   3840
+      Top             =   1920
+   End
+   Begin VB.Label lblText 
+      Alignment       =   2  'Zentriert
+      BackColor       =   &H8000000B&
+      BeginProperty Font 
+         Name            =   "MS Sans Serif"
+         Size            =   18
+         Charset         =   0
+         Weight          =   700
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      Height          =   2235
+      Left            =   0
+      TabIndex        =   0
+      Top             =   0
+      Width           =   4635
+   End
+End
+Attribute VB_Name = "frmUSFW2WarteAufOpto"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Public m_COMPort As Integer
+Public mbln_Erfolg As Boolean
+Private m_iStufe As Integer
+Public m_iEinbauplatzNr As Integer
+Public mstrText As String
+
+Private Sub cmdCancel_Click()
+    mbln_Erfolg = False
+    Unload Me
+End Sub
+
+Private Sub Form_Load()
+    If m_COMPort = 0 Then
+        MsgBox "kein COMPort angegeben"
+        Unload Me
+    End If
+    
+    lblText.Caption = "Opto-Verbindung zu Einbauplatz " & m_iEinbauplatzNr & " wird überprüft..."
+    
+    m_iStufe = 0
+    Timer1.Interval = 1
+    Timer1.Enabled = True
+End Sub
+
+
+Private Sub Form_Resize()
+    lblText.Top = 0
+    lblText.Left = 0
+    lblText.Width = Me.ScaleWidth
+    lblText.Height = Me.ScaleHeight
+End Sub
+
+Private Sub Timer1_Timer()
+    Timer1.Enabled = False
+    Dim strFWGen As String
+    
+    Select Case m_iStufe
+        Case 0 ' noch nichts erkannt
+        
+            StatusBar1.SimpleText = "Send NKE..."
+            DoEvents
+            
+            If modMBUS_SMS.SendNKE(m_COMPort) = 0 Then
+                lblText.BackColor = vbYellow
+                m_iStufe = 1
+                StatusBar1.SimpleText = "Send NKE: OK"
+            Else
+                lblText.BackColor = vbRed
+                lblText.Caption = mstrText
+                StatusBar1.SimpleText = "Send NKE: fehlgeschlagen"
+                DoEvents
+            End If
+        Case 1 ' ping NKE erfolgreich
+            ' REQU UD2
+            StatusBar1.SimpleText = "REQ UD2..."
+            DoEvents
+            
+            If GetFWGeneration(m_COMPort, strFWGen) = 0 Then
+                mbln_Erfolg = True
+                Timer1.Enabled = False
+                Unload Me
+                Exit Sub
+            Else
+                lblText.BackColor = vbRed
+                StatusBar1.SimpleText = "REQ_UD2 fehlgeschlagen"
+                DoEvents
+                m_iStufe = 0
+            End If
+    End Select
+    
+    Timer1.Interval = 100
+    Timer1.Enabled = True
+End Sub