VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CProTool"
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"
Option Explicit

' Referenz auf die ProTool Applikation
Private m_ProToolAppObj As Object

Public Function initNeu() As Boolean
    On Error GoTo InitError
    Set m_ProToolAppObj = GetObject(, "PTPRORUN.Document")
    
    Debug.Print "ProTool Objekt initialisiert"
    initNeu = True
    Exit Function
InitError:
    initNeu = False
    Exit Function

End Function

' Initialilisierung des ProTool Objektes
' Return:   true bei Erfolg
'           False bei Fehler
Public Function init()
Dim Counter As Integer

On Error GoTo InitError
    Set m_ProToolAppObj = GetObject(, "PTPRORUN.Document")
    
    Debug.Print "ProTool Objekt initialisiert"
    init = True
Exit Function
InitError:
    If Counter < 120 Then
        frmSplash.LabelDoing.caption = "Warte auf ProTool (" & Counter & "s): ProTool.init: " & Err.Description
        DebugMsg Counter & ".Versuch: ProTool.init: " & Err.Description
        DoEvents
        Counter = Counter + 1
        Sleep 1000, 0
        Resume
    Else
        
    End If
    
    init = False
    'Set m_ProToolAppObj = Nothing    Error (Err.Number)
End Function

'Public Function ProtoolAufVorhandenseinVariableTesten(ProToolVarName As String) As Boolean
'    On Error GoTo Errorhandler
'    Call m_ProToolAppObj.GetInstance(VarKlasse, ProToolVarName, Var)
'    If Not Var Is Nothing Then
'        ProtoolAufVorhandenseinVariableTesten = True
'    End If
'    Exit Function
'Errorhandler:
'
'End Function


Public Function VarLesen(ProToolVarName As String) As Variant
On Error GoTo VarLesenError
Dim Var         As Object
Dim VarKlasse   As String
Dim timedif As Long
Dim Versuch As Integer

VarKlasse = "Var"

nochmallesen:
Call m_ProToolAppObj.GetInstance(VarKlasse, ProToolVarName, Var)
' manchmal "lügt" die SPS, Vorschlag: Sleep 200, False
'-----------------------------------------------------------------------------------
' Warte max 2 Sekunden um ProTool die Zeit zu geben, um den Wert auf ungleich 0 zu aktualisieren
'timedif = GetTickCount()
'Do While Var = 0
'    If GetTickCount() > timedif + 2000 Then Exit Do
'Loop
'Debug.Print "Zeitverzögerung beim Lesen der ProTool Variablen (" & ProToolVarName & "=" & Var & ") :" & GetTickCount() - timedif & " msec"
'-----------------------------------------------------------------------------------

If Not Var Is Nothing Then
    VarLesen = Var
'DebugMsg "Lese ProTool(" & ProToolVarName & ")=" & CStr(Var)
Else
    Versuch = Versuch + 1
    
    If Versuch <= 3 Then
        Sleep 500, True
        DebugMsg "Prootool Variable " & ProToolVarName & " lesen fehlgeschlagen"
        GoTo nochmallesen
    End If
    'ErrorMsg ("ProTool Variablen Objekt existiert nicht (mehr). Var ist nothing für ProToolVarName='" & ProToolVarName & "'")
    LogIntoDB "ProTool Variablen Objekt existiert nicht (mehr). " & Versuch & " mal: Var ist nothing für ProToolVarName='" & ProToolVarName & "'", "ProTool"
    VarLesen = False
End If
Exit Function
VarLesenError:
    Select Case ProToolVarName
        Case "PT_M1_Ist", "PT_M2_Ist", "PT_M3_Ist", "PT_M4_Ist", "PT_M5_Ist"
            LogIntoDB "Fehler in ProTool.VarLesen(" & ProToolVarName & ") Variable unbekannt. Angenommen=2"
            VarLesen = 2
        Case Else
            VarLesen = InputBox("SPS Anfrage " & vbCrLf & "Variable " & ProToolVarName & ": ", "SPS Anfrage")
            LogIntoDB "Fehler in ProTool.VarLesen(" & ProToolVarName & ") Variable unbekannt. User Eingabe=" & VarLesen
    End Select
End Function

'Public Function NoSysVarLesen(ProToolVarName As String) As Variant
'On Error GoTo SysVarLesenError
'Dim Var         As Object
'Dim VarKlasse   As String

'If m_ProToolAppObj Is Nothing Then Call init

'VarKlasse = "VarSys"
    
'Call m_ProToolAppObj.GetInstance(VarKlasse, ProToolVarName, Var)
    
'If Not Var Is Nothing Then
'    SysVarLesen = Var
'Else
'    MsgBox ("ProTool Variablen Objekt existiert nicht (mehr).")
'    SysVarLesen = False
'End If
'Exit Function
'SysVarLesenError:
'    MsgBox ("Fehler beim Lesen der ProTool,SYSVariablen: " & ProToolVarName & vbCrLf & "Err: " & Err.Description)
'    SysVarLesen = False
'End Function


Public Function VarSchreiben(ProToolVarName As String, Wert As Variant) As Boolean
On Error GoTo VarSchreibenError
Dim Var         As Object

Dim VarKlasse   As String
Dim Versuch As Integer

Debug.Print "SPS: " & ProToolVarName & "=" & Wert

'If m_ProToolAppObj Is Nothing Then Call init
Versuch = 0
VarKlasse = "Var"

nochmalSchreiben:
Err.Clear
On Error GoTo VarSchreibenError

DebugMsg "ProTool.Varschreiben(" & ProToolVarName & "," & Wert & ") ..."
Call m_ProToolAppObj.GetInstance(VarKlasse, ProToolVarName, Var)

If Not Var Is Nothing Then
    Var = CVar(Wert)
    VarSchreiben = True
Else
    
    Versuch = Versuch + 1
    If Versuch <= 3 Then
        Sleep 500, True
        DebugMsg "Prootool Variable " & ProToolVarName & " schreiben fehlgeschlagen"
        GoTo nochmalSchreiben
    End If
    
    LogIntoDB "ProTool Variablen Objekt '" & ProToolVarName & "' existiert nicht (mehr). Var is nothing.", "ProTool"
    VarSchreiben = False
End If
Exit Function
VarSchreibenError:
    If InStr(1, Err.Description, "Der Remote-Server-Computer existiert nicht") > 0 Then
       Dim lngReturn As Long
       lngReturn = MsgBox("Die Verbindung zu Protool konnte nicht hergestellt werden. Möchten Sie es nochmal versuchen? Starten Sie ggF. ProTool neu." & vbCrLf & "Klicken Sie 'Nein' zum fortfahren oder 'Abbrechen' um die Anwendung zu beenden.", vbYesNoCancel Or vbDefaultButton1, Err.Description)
       Select Case lngReturn
       Case vbYes
            initNeu
            GoTo nochmalSchreiben
       Case vbCancel
            If MsgBox("Möchten Sie die Anwendung wirklich beenden?", vbYesNo Or vbDefaultButton2) = vbYes Then
                End
            End If
       End Select
    End If
    
    LogIntoDB "Fehler " & Err.Number & " beim setzen der Protool Variablen " & ProToolVarName & " auf " & Wert & ":" & Err.Description
    'MsgBox ("Setzen der SPS Variablen " & vbCrLf & ProToolVarName & " = " & Wert)
    
'    If Versuch <= 3 Then
'        Sleep 500, True
'        DebugMsg "Prootool Variable " & ProToolVarName & "= " & Wert & " schreiben fehlgeschlagen: " & Err.Description
'
'        Versuch = Versuch + 1
'        GoTo nochmalSchreiben
'    End If
'
    VarSchreiben = True
'    VarSchreiben = False
End Function



'Public Function SysVarSchreiben(ProToolVarName As String, Wert As Variant) As Boolean
'On Error GoTo SysVarSchreibenError
'Dim Var         As Object
'Dim VarKlasse   As String

'If m_ProToolAppObj Is Nothing Then Call init

'VarKlasse = "VarSys"
    
'Call m_ProToolAppObj.GetInstance(VarKlasse, ProToolVarName, Var)
    
'If Not Var Is Nothing Then
'    Var = Wert
'    SysVarSchreiben = True
'Else
'    MsgBox ("ProTool Variablen Objekt existiert nicht (mehr).")
'    SysVarSchreiben = False
'End If
'Exit Function
'SysVarSchreibenError:
'    MsgBox ("Fehler beim Schreiben der ProToolVariablen: " & ProToolVarName & vbCrLf & "Err: " & Err.Description)
'    SysVarSchreiben = False
'End Function

Public Function QuitProTool()
On Error GoTo QuitProToolError
    Call m_ProToolAppObj.Quit
    Set m_ProToolAppObj = Nothing
Exit Function
QuitProToolError:
    MsgBox ("ProTool konnte nicht beendet werden" & vbCrLf & Err.Description)
End Function