111 lines
3.5 KiB
OpenEdge ABL
111 lines
3.5 KiB
OpenEdge ABL
VERSION 1.0 CLASS
|
|
BEGIN
|
|
MultiUse = -1 'True
|
|
Persistable = 0 'NotPersistable
|
|
DataBindingBehavior = 0 'vbNone
|
|
DataSourceBehavior = 0 'vbNone
|
|
MTSTransactionMode = 0 'NotAnMTSObject
|
|
End
|
|
Attribute VB_Name = "CopcSps"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = True
|
|
Attribute VB_PredeclaredId = False
|
|
Attribute VB_Exposed = False
|
|
Option Explicit On
|
|
Dim registerWritePre As String ' "ns=3;s=""Daten VB Schreiben""."""
|
|
Dim registerReadPre As String ' "ns=3;s=""Daten PC""."""
|
|
Dim registerWriteSuffix As String ' """;"
|
|
Dim registerReadSuffix As String ' """;"
|
|
Dim bench As New Vb6Testbench
|
|
' Referenz auf die ProTool Applikation
|
|
Private m_OpcServer As Vb6Testbench
|
|
|
|
' Initialilisierung des OpcServer Objektes
|
|
' Return: true bei Erfolg
|
|
' False bei Fehler
|
|
Public Function init()
|
|
Dim Counter As Integer
|
|
|
|
On Error GoTo InitError
|
|
Set m_OpcServer = New Vb6Testbench
|
|
m_OpcServer.connect g_App.Settings.getOpcServerUrl
|
|
registerWritePre = "ns=3;s=""Daten VB Schreiben""."""
|
|
registerReadPre = "ns=3;s=""Daten PC""."""
|
|
registerWriteSuffix = """;"
|
|
registerReadSuffix = """;"
|
|
|
|
|
|
registerWritePre = g_App.Settings.getOpcRegisterWritePre
|
|
registerReadPre = g_App.Settings.getOpcRegisterReadPre
|
|
registerWriteSuffix = g_App.Settings.getOpcRegisterWriteSuffix
|
|
registerReadSuffix = g_App.Settings.getOpcRegisterReadSuffix
|
|
init = True
|
|
Exit Function
|
|
InitError:
|
|
init = False
|
|
LogIntoDB "Fehler " & Err.Number & " beim setzen des Init SPS OpcServer :" & Err.Description
|
|
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 RegisterGrp(Register As String) As String
|
|
Register = UCase(Register)
|
|
If (Len(Register) <= 2) Then
|
|
RegisterGrp = Register
|
|
Else
|
|
If Left(Register, 2) = "PT" Or Register = "VB_QSOLL" Or Register = "VB_QDIFF" Or Register = "VB_REGU" Or Register = "VB_SERVOST" Then
|
|
RegisterGrp = registerReadPre & Register & registerReadSuffix
|
|
Else
|
|
RegisterGrp = registerWritePre & Register & registerWriteSuffix
|
|
End If
|
|
End If
|
|
|
|
End Function
|
|
|
|
|
|
Public Function VarLesen(Register As String) As Variant
|
|
On Error GoTo VarLesenError
|
|
Dim Var As Variant
|
|
Dim VarKlasse As String
|
|
Register = RegisterGrp(Register)
|
|
VarLesen = m_OpcServer.ReadValueVar(Register)
|
|
Exit Function
|
|
VarLesenError:
|
|
'MsgBox "ERROR: m_OpcServer.ReadValueVar(" & Register & ") has Error : " & Err.Description
|
|
LogIntoDB "Fehler in CopcSps.VarLesen(" & Register & ")."
|
|
End Function
|
|
|
|
|
|
|
|
Public Sub Disconnect()
|
|
m_OpcServer.Disconnect
|
|
End Sub
|
|
Public Function VarSchreiben(Register As String, Wert As Variant) As Boolean
|
|
On Error GoTo VarSchreibenError
|
|
Dim Var As Object
|
|
|
|
Dim VarKlasse As String
|
|
Dim Versuch As Integer
|
|
|
|
Register = RegisterGrp(Register)
|
|
Err.Clear
|
|
On Error GoTo VarSchreibenError
|
|
m_OpcServer.WriteValue Wert, Register
|
|
VarSchreiben = True
|
|
Exit Function
|
|
VarSchreibenError:
|
|
|
|
'MsgBox "ERROR: m_OpcServer.VarSchreiben(" & Register & ", " & Wert & ") has Error : " & Err.Description
|
|
LogIntoDB "Fehler " & Err.Number & " beim setzen des SPS Registers " & Register & " auf " & Wert & ":" & Err.Description
|
|
VarSchreiben = False
|
|
End Function |