'Author :warrior
'Date :2009-6-01
'Description:OPC Data Access Class
'Version :1.0
'=========================================================
Private Node As String
Private ProgId As String
Public OPCDAServer As OPCAutomation.OPCServer
Private Const sleepingTime = 500
Private Const retryTimesWriteItem = 7
'API function
Declare Sub Sleep Lib "KERNEL32" (ByVal dwMilliseconds As Long)
Public Function InitialConfig()
If Node = "" Then
Node = Application.Range(BcpcConst.Node).Cells.Value //Computer Name
ProgId = Application.Range(BcpcConst.ProgId).Cells.Value //Yokogawa.ExaopcDACS1.1
End If
End Function
Public Function ConnectionOPC()
Call InitialConfig
Set OPCDAServer = New OPCAutomation.OPCServer
Call OPCDAServer.Connect(ProgId, Node)
If Err.Number <> 0 Then
MsgBox "Connect OPC error,description:" & Err.Description, vbOKOnly, "Error Prmpt"
Exit Function
End If
End Function
Public Function DisconnectOPC()
If OPCDAServer.ServerState = OPCAutomation.OPCServerState.OPCRunning Then
Call OPCDAServer.Disconnect
Set OPCDAServer = Nothing
End If
End Function
'Write a value to OPC
'=================================
Public Function WriteValueToDCS(ByVal groupName As String, ByRef itemPath() As String, ByRef strValue() As String) As Boolean
On Error GoTo Error_Hander
Call ConnectionOPC
Dim oneOpcGroup As OPCAutomation.OPCGroup
Set oneOpcGroup = OPCDAServer.OPCGroups.Add(groupName)
Dim oneOpcItem(1) As OPCItem
Set oneOpcItem(0) = oneOpcGroup.opcItems.AddItem(itemPath(0), 1)
oneOpcItem(0).Write (strValue(0))
WriteValueToDCS = True
Call DisconnectOPC
Exit Function
Error_Hander:
WriteValueToDCS = False
Call DisconnectOPC
End Function
'Read a item from OPC
'=============================
Public Function ReadValueFromDCS(ByVal groupName As String, ByVal itemPath As String) As String
Dim oneOpcGroup As OPCAutomation.OPCGroup
Dim oneOpcItem As OPCAutomation.OPCItem
Dim returnValue As Variant
Dim myValue As Variant
Dim myQuality, myTimeStamp As Variant
On Error Resume Next
If OPCDAServer Is Nothing Then
Exit Function
End If
If OPCDAServer.ServerState = OPCAutomation.OPCServerState.OPCRunning Then
Set oneOpcGroup = OPCDAServer.OPCGroups.Add(groupName)
Set oneOpcItem = oneOpcGroup.opcItems.AddItem(itemPath, 1)
If Err.Number <> 0 Then
ReadValueFromDCS = ""
GoTo EXIT_FUNCTION
End If
oneOpcItem.Read OPCDevice, myValue, myQuality, myTimeStamp
If IsNull(myValue) Then
ReadValueFromDCS = ""
Else
ReadValueFromDCS = CStr(myValue)
End If
Call OPCDAServer.OPCGroups.RemoveAll
Set newGroup = Nothing
Set oneOpcItem = Nothing
End If
EXIT_FUNCTION:
Set oneOpcGroup = Nothing
Set oneOpcItem = Nothing
Exit Function
End Function
'Read a array from OPC
'Remind,ServerHdls start index is 1
'ItemPath index from 1 to begin
'==================================
Public Function ReadValueFromDCSEx(ByRef itemPath() As String) As Variant()
Dim iLoopCounter As Long
Dim lBufferSize As Long
Dim ServerHdls() As Long
Dim ClientHdls() As Long
Dim AccessError() As Long
Dim valueVariant() As Variant
Dim MyOPCGroup As OPCAutomation.OPCGroup
OPCAccessBL.ConnectionOPC
If OPCDAServer.ServerState = OPCAutomation.OPCServerState.OPCRunning Then
Set MyOPCGroup = OPCDAServer.OPCGroups.Add()
MyOPCGroup.IsActive = False
lBufferSize = UBound(itemPath)
ReDim ServerHdls(lBufferSize), ClientHdls(lBufferSize)
For iLoopCounter = 1 To UBound(itemPath)
ClientHdls(iLoopCounter) = iLoopCounter
Next
Call MyOPCGroup.opcItems.AddItems(lBufferSize, itemPath, ClientHdls, ServerHdls, AccessError)
Call MyOPCGroup.SyncRead(0, lBufferSize, ServerHdls, valueVariant, AccessError)
ReadValueFromDCSEx = valueVariant()
Call MyOPCGroup.opcItems.Remove(lBufferSize, ServerHdls, AccessError)
Call OPCDAServer.OPCGroups.RemoveAll
Set MyOPCGroup = Nothing
OPCAccessBL.DisconnectOPC
End If
End Function
'Write a arry to OPC
'==============================
Public Function WriteValueToDCSEx(ByRef itemPath() As String, ByRef itemValue() As Variant) As Integer
Dim iLoopCounter As Long
Dim lBufferSize As Long
Dim ServerHdls() As Long
Dim ClientHdls() As Long
Dim AccessError() As Long
Dim valueVariant() As Variant
On Error GoTo Error_Hander
Dim MyOPCGroup As OPCAutomation.OPCGroup
OPCAccessBL.ConnectionOPC
If OPCDAServer.ServerState = OPCAutomation.OPCServerState.OPCRunning Then
Set MyOPCGroup = OPCDAServer.OPCGroups.Add()
MyOPCGroup.IsActive = False
lBufferSize = UBound(itemPath)
ReDim ServerHdls(lBufferSize), ClientHdls(lBufferSize)
For iLoopCounter = 1 To UBound(itemPath)
ClientHdls(iLoopCounter) = iLoopCounter
Next
Call MyOPCGroup.opcItems.AddItems(lBufferSize, itemPath, ClientHdls, ServerHdls, AccessError)
Call MyOPCGroup.SyncWrite(lBufferSize, ServerHdls, itemValue, AccessError)
Call MyOPCGroup.opcItems.Remove(lBufferSize, ServerHdls, AccessError)
Call OPCDAServer.OPCGroups.RemoveAll
Set MyOPCGroup = Nothing
OPCAccessBL.DisconnectOPC
WriteValueToDCSEx = 1
Exit Function
Error_Hander:
WriteValueToDCSEx = -1
End If
End Function