VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CApplication"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
       
       
'==============================================================================
'
' File   : Application.cls
' Date   : 06.04.1999
' Version: 1.01
' Author : Reinhard Henning, Andreas Schmidt, lindner&partner
'
'==============================================================================
'
' Hauptklasse der Anwendung
'
'==============================================================================
'
' History:
'
' Date   : 06.04.1999
' Version: 1.01
' Author : Reinhard Henning, Andreas Schmidt, lindner&partner
'
' Neuer Member: m_SPS
'
' Date   : 18.03.1999
' Version: 1.00
' Author : Reinhard Henning, Andreas Schmidt, lindner&partner
'
' Erste dokumentierte Version.
'
'==============================================================================

Option Explicit

' Private Member
' --------------
Private m_DB As CDBAccess
Private m_FMBus As CFMBus
Private m_Waage As CWaage
Private m_SPS As CSPS

Private m_EAKit As CEAKIT

Private m_Settings As CSettings
Private m_Mitarbeiter As CMitarbeiter
Private m_bInitialized As Boolean

Private mvarAppName As String 'lokale Kopie
Private mvarCompanyName As String 'lokale Kopie
Private mvarAppDescription As String 'lokale Kopie
Private m_PruefstationTyp As Long
Private m_PruefstationNr As Long

Public m_SIRTCOM_Statemashine As SIRTCOM.Statemashine

'Public m_frmPZP1 As Form
'Public m_frmPZP2 As Form

'Public m_SPS_OLE As CSPS_OLE

'Private Const APP_NAME$ = "Prüfstation 2000"
'Private Const APP_VERSION$ = "0.01"
'Private Const APP_DATE$ = "XX.XX.1999"
'Private Const APP_INIFILE$ = "pruef2000.ini"
   
Private Const APP_ShortName = "PRUEF2000"
' API declares
' ------------
Private Declare Function WNetGetUser Lib "mpr" Alias "WNetGetUserA" (ByVal lpName As String, ByVal lpusername As String, lpnLength As Long) As Long

Public Property Let CompanyName(ByVal vData As String)
'wird beim Zuweisen eines Werts zu der Eigenschaft auf der linken Seite einer Zuweisung verwendet.
'Syntax: X.CompanyName = 5
    mvarCompanyName = vData
End Property


Public Property Get CompanyName() As String
'wird beim Ermitteln eines Eigenschaftswertes auf der rechten Seite einer Zuweisung verwendet.
'Syntax: Debug.Print X.CompanyName
    CompanyName = mvarCompanyName
End Property


' Initialisierung der Klasse
'
Public Function initAsP2000() As Boolean
    
    'Dim hProtool As Variant
    Call modMsgBox.setStdCaption(AppName)
    
    
    ' Bus der FMs initialisieren
    ' --------------------------
    frmSplash.LabelDoing = "initialising FM85P"
    frmSplash.Refresh
    Call initFMBus(16)
    
    ' Waage initialisieren
    ' --------------------
'    frmSplash.LabelDoing = "initialising Waage"
'    frmSplash.Refresh
    'Call initWaage
    
    ' Displays initialisieren
    ' --------------------
    frmSplash.LabelDoing = "initialising Displays"
    frmSplash.Refresh
    Call initEAKIT
    
    ' SPS-Objekt erzeugen
    ' --------------------
    Set m_SPS = New CSPS
        
    m_bInitialized = True
    initAsP2000 = True
initExit:
    Exit Function
End Function

Public Function get_SIRT_Statemashine(ByRef errnum As Long, ByRef errdesc As String) As SIRTCOM.Statemashine
   On Error GoTo Errorhandler
   
   If m_SIRTCOM_Statemashine Is Nothing Then
      Set m_SIRTCOM_Statemashine = New SIRTCOM.Statemashine
   End If
   
   Set get_SIRT_Statemashine = m_SIRTCOM_Statemashine
   Exit Function
Errorhandler:
   Set get_SIRT_Statemashine = Nothing
   errnum = Err.Number
   errdesc = Err.Description
End Function

Public Function initAsManuell() As Boolean
' initialisiert App Objekt für manuelle Dateneingabe
' (ohne FM85, SPS, Waage...)
On Error GoTo initAsManuellError
    Call modMsgBox.setStdCaption(AppName)
    
    initAsManuell = True
    m_bInitialized = True
Exit Function
initAsManuellError:
End Function

' FMBus mit FM85Ps der Prüfstation erzeugen und initialisieren
'
Private Function initFMBus(nFM85P As Integer) As Boolean
    Dim fm85p As CFM85P
    Dim i As Integer
    
    On Error GoTo initFMBusErr
    
    Set m_FMBus = New CFMBus
    m_FMBus.setMScomm frmSerial.commFMBus
    
    ' FM85P-Objekte erzeugen
    For i = 1 To nFM85P
        If Not m_FMBus.addFM85P(0 + i) Then Exit For
        Set fm85p = m_FMBus.getFM85P(i)
        Call g_Logger.log(3, "OK: index: " & i & " FM85P Adresse: " & fm85p.getAdress())
    Next i
    
    initFMBus = True
    Exit Function

initFMBusErr:
    Exit Function
    
End Function

' Waage(n) der Prüfstation erzeugen und initialisieren
'
Private Function initWaage() As Boolean
    'DebugMsg "initWaage() DEVPORT_Waage=" & DEVPORT_Waage
    On Error GoTo initWaageErr
    
    If g_App.Settings.getCOMPort(DEVPORT_Waage) = 0 Then
      initWaage = False
      Exit Function
    End If
    
    Set m_Waage = New CWaage
    m_Waage.setMScomm frmSerial.commWaage
    initWaage = True
    Exit Function

initWaageErr:
    Exit Function
End Function

'------------------------------------------------------------------------------
' Properties bzw. set/get-Funktionen
'------------------------------------------------------------------------------

' @return   true  = Initialisierung ist erfolgreich verlaufen,
'           false = Fehler während der Initialisierung
'
Public Function IsInitialized() As Boolean
    IsInitialized = m_bInitialized
End Function


Public Property Get PruefstationTyp() As Long
    PruefstationTyp = m_PruefstationTyp
End Property

Public Property Let PruefstationTyp(vData As Long)
    m_PruefstationTyp = vData
End Property

Public Property Get PruefstationNr() As Long
    PruefstationNr = m_PruefstationNr
End Property

Public Property Let PruefstationNr(vData As Long)
    m_PruefstationNr = vData
End Property

Public Property Get AppName() As String
    AppName = mvarAppName
End Property

Public Property Let AppName(vData As String)
    mvarAppName = vData
End Property



Public Property Get AppVersion() As String
    AppVersion = App.Major & "." & App.Minor & "." & App.Revision
End Property

Public Property Get AppDate() As String
    On Error Resume Next
    If Dir(Me.AppPath & App.EXEName & ".exe") <> "" Then
        AppDate = FileDateTime(Me.AppPath & App.EXEName & ".exe")
    End If
End Property

Public Property Get AppPath() As String
    If Right(App.Path, 1) = "\" Then
       AppPath = App.Path
    Else
       AppPath = App.Path & "\"
    End If
End Property

Public Property Get AppDescription() As String
    AppDescription = mvarAppDescription
End Property

Public Property Let AppDescription(vData As String)
    mvarAppDescription = vData
End Property

' @return Referenz auf die Server-Datenbank
'
Public Function getDB() As CDBAccess
    Set getDB = m_DB
End Function

' @return Referenz auf die applikationsweiten Vorgaben
'
Public Property Get Settings() As CSettings
    Set Settings = m_Settings
End Property

' Aktuellen User der Anwendung neu vorgeben
'
' @param Mitarbeiter neuer aktueller User der Anwendung
'
Public Property Let Mitarbeiter(myMitarbeiter As CMitarbeiter)
   Set m_Mitarbeiter = myMitarbeiter
End Property

' @return Referenz auf den aktuell angemeldeten Mitarbeiter
'
Public Property Get Mitarbeiter() As CMitarbeiter
    Set Mitarbeiter = m_Mitarbeiter
End Property

' @return Referenz auf das FMBus-Objekt der Prüfstation
'
Public Function getFMBus()
   Set getFMBus = m_FMBus
End Function

' @return Referenz auf das Waage-Objekt der Prüfstation
'
Public Function getWaage() As CWaage
    On Error GoTo getWaage_Error
    Set getWaage = m_Waage
    
    If m_Waage Is Nothing Then
        If initWaage() = True Then
            Set getWaage = m_Waage
            DebugMsg "COM-PORT der Waage wird geöffnet"
            m_Waage.OpenMSComm
        End If
    Else
        Set getWaage = m_Waage
        
        
    End If
    
    If frmSerial.commWaage.PortOpen = False Then
        DebugMsg "COM-PORT der Waage wird geöffnet"
        m_Waage.OpenMSComm
    End If
Exit Function
getWaage_Error:
    'Set getWaage = Nothing
End Function

' @return Referenz auf das SPS-Objekt der Prüfstation
'
Public Function getSPS()
   Set getSPS = m_SPS
End Function

' @return   Name des aktuellen Windows-Users
'
Private Function getUser() As String
    On Error Resume Next
    Dim lpName As String
    Dim mvarlpUsername  As String
    Const lpnLength As Integer = 255
    
    mvarlpUsername = Space$(lpnLength + 1)
    
    If WNetGetUser(lpName, mvarlpUsername, lpnLength) = 0 Then
        getUser = Left$(mvarlpUsername, InStr(mvarlpUsername, Chr(0)) - 1)
    Else
        Call g_Logger.log(1, "Fehler bei der Abfrage nach der UserID. UserID = 'DEFAULT' wird angenommen.")
    End If
    If Err Then
        DebugMsg ("Fehler bei der Abfrage nach der UserID: " & Err.Description)
    End If
End Function

Public Property Get SystemPath() As String
   SystemPath = GetLPRegSetting(HKEY_LOCAL_MACHINE, "Pruefstation2000", "SystemPath", REG_SZ) '& "\"
End Property

Public Property Let SystemPath(ByVal vData As String)
    SaveLPRegSetting HKEY_LOCAL_MACHINE, "Pruefstation2000", "SystemPath", vData, REG_SZ
End Property


Private Sub Class_Initialize()
Dim dbuser As String
Dim dbpw As String
Dim ADOConnectionstring As String

   'schon mal mit vernünftigen Werten belegen
   mvarAppName = App.Title
   mvarCompanyName = App.CompanyName
   mvarAppDescription = App.FileDescription
      
   Set m_Settings = New CSettings
   'm_Settings.INIFilename = (AppPath() & APP_ShortName & ".INI")
   m_Settings.INIFilename = (APP_ShortName & ".INI")
      

NeuVerbinden:
    Set m_DB = New CDBAccess

    ADOConnectionstring = m_Settings.ADOConnectionstring
    
    Dim lngRet As Long
    
    If gblnIsInIDE And InStr(1, ADOConnectionstring, "Database=Auftrag") > 0 Then
      lngRet = MsgBox("Testdatenbank verwenden?", vbYesNoCancel Or vbDefaultButton1, "laufe in Entwicklungsumgebung")
        If lngRet = vbYes Then
            ADOConnectionstring = Replace(ADOConnectionstring, "Database=Auftrag", "Database=Testreplikation")
        End If
        If lngRet = vbCancel Then
          End
        End If
    ElseIf gblnIsInIDE And InStr(1, ADOConnectionstring, "Database=Testreplikation") > 0 Then
        If MsgBox("Produktiv-DB verwenden?", vbYesNo Or vbDefaultButton2, "laufe in Entwicklungsumgebung") = vbYes Then
            ADOConnectionstring = Replace(ADOConnectionstring, "Database=Testreplikation", "Database=Auftrag")
        End If
    End If
    
    
    DoEvents
    If ADOConnectionstring <> "" Then
       If Not m_DB.ADOConnect(ADOConnectionstring & ";Uid=PrgPruefstation;Password=PrgPruefstation") Then
            MsgBox ("Die ADO-Datenbankverbindung mit" & vbCrLf & "'" & m_Settings.ADOConnectionstring & "'" & vbCrLf & "ist fehlgeschlagen. Bitte überprüfen Sie die INI-Datei '" & m_Settings.INIFilename & "'.")
            End
       End If
    Else
        MsgBox "Es ist kein ADOConnectionstring in der INI definiert"
        End
'      If Not m_DB.connect(dbuser, dbpw, m_Settings.ServerDBPathname, "") Then
'            MsgBox ("Die Access-Datenbankverbindung mit '" & m_Settings.ServerDBPathname & "' ist fehlgeschlagen. Bitte überprüfen Sie die INI-Datei '" & m_Settings.INIFilename & "'.")
'            End
'        End
'      End If
    End If
    
    
    ' Mitarbeiter erzeugen
    ' --------------------
    Set m_Mitarbeiter = New CMitarbeiter
    

End Sub


Public Function initEAKIT() As Boolean
    Dim comport As Byte
    
    On Error GoTo Errorhandler
    If g_App.Settings.getCOMPort(DEVPORT_Display) = -1 Then
        initEAKIT = False
        Exit Function
    End If
    
    comport = g_App.Settings.getCOMPort(DEVPORT_Display)
    
    If comport > 0 Then
        Set m_EAKit = New CEAKIT
        Debug.Print "Display Settings: " & g_App.Settings.GetDisplayCOMSettings()
        m_EAKit.initMSComm frmSerial.commDisplay, comport, g_App.Settings.GetDisplayCOMSettings()
        
        
        m_EAKit.Adressierung 255
        m_EAKit.CallMakro 0
    
    End If
    
    initEAKIT = True
    
    
Exit Function
Errorhandler:
    Debug.Print Err.Description
    initEAKIT = False
    Exit Function
    Resume
End Function

Public Function GetDisplay() As CEAKIT
    Set GetDisplay = m_EAKit
End Function


Public Function getAnzahlBehaelter() As Integer
Dim i As Integer
Dim Behaelter As CBehaelter
Set Behaelter = New CBehaelter
getAnzahlBehaelter = 0
For i = 1 To 10
    If Behaelter.LoadFromIni(i) Then
       getAnzahlBehaelter = getAnzahlBehaelter + 1
    Else
        Exit Function
    End If
Next
End Function


Public Function GetBehaelterForVolumen(dblVolumen As Double) As CBehaelter
    Dim Behaelter As CBehaelter
    Set Behaelter = New CBehaelter
    
    If Behaelter.LoadForVolumen(dblVolumen) Then
        Set GetBehaelterForVolumen = Behaelter
    Else
        Set GetBehaelterForVolumen = Nothing
    End If
End Function