一、引言
现在有很多工业控制产品都支持OPC Server，如西门子SIMATIC NET、WINCC、WINAC、Protool/pro，亚控公司组态王等，这些产品本身在一些需要实现很复杂的数据模型功能上还显得不足，由于支持了OPC，我们就可以在VB或C++上通过OPC获取数据进而实现较复杂的功能（如强大的数据库管理或数据分析）。本文讨论了如何在VB中开发一个动态连接库，以方便开发者实现对OPC服务器的数据采集，将精力更多的放在界面开发和数据处理上。
二、功能设计
类型设计为ActiveX Dll，名称：OPC_Dll.dll，可以在VB工程[引用]中加载，加载后通过创建类BCA_OPC的实例来实现OPC数据通讯，BCA_OPC的调用功能如下：
1、配置初始化：Dll_Initial(strConfigFile As String) As Boolean
其中strConfigFile为连接OPC服务器对应的配置文件名称（*.ini），用户建立的配置文件应遵循一定的格式（在下面应用中说明），并且应放在系统目录下（如C:\WINNT下）。配置文件中包含了要连接的OPC服务器名称、log文件名称、变量组定义及对应组内的变量定义（本连接库最多支持1024个变量通讯，对变量组的数目没有限制）。配置成功返回TRUE。
2、连接OPC服务器：ConnectServer(Optional IPAddress As String) As Boolean
IPAddress为可选的远程OPC服务器所属PC的IP地址，如“192.168.0.1”，如果不提供IPAddress参数，则默认为本机OPC服务器。连接成功返回TRUE。
3、配置通讯变量（组态OPC客户机）：SetConfiguration() As Boolean
根据提供的ini配置文件组态OPC客户机与服务器的变量通讯，组态成功返回TRUE。
4、读变量数据：GetData(ItemName As String)
ItemName为变量名称，必须与ini配置文件中的变量名称一致。本功能返回该变量的实际数据。
5、写变量数据：WriteData(ItemName As String, ItemWriteData As Variant)
ItemName为变量名称，ItemWriteData为变量数据。
三、实现代码
1、在VB6.0中新建ActiveX Dll工程，如下图：
2、在工程菜单中添加引用，如下图：
如果系统中没有OPC Automation，你需要安装注册OPC自动化。一般装了OPC支持的软件，系统都支持OPC自动化。
3、在工程中添加模块，如下图：
模块API_Function为软件所需的一些API函数。
模块Global_constants为一些系统常量
类模块BCA_OPC为实现主类
类模块ItemInfo和ItemsInfo实现变量信息的封装
4、以下为各模块的程序代码：
API_Function:
Option Explicit
'----------------------------------
' 获取一个与给定初始化文件指定域中的一个键相联系的整数值(1)
Public Declare Function GetPrivateProfileInt Lib "kernel32" Alias _
"GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, _
ByVal nDefault As Long, ByVal lpFileName As String) As Long
' 从一个初始化文件中获取指定段的所有键和值(2)
Public Declare Function GetPrivateProfileSection Lib "kernel32" Alias _
"GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, _
ByVal nSize As Long, ByVal lpFileName As String) As Long
' 获取初始化文件中的制定断下的一个字符串(3)
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias _
"GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, _
ByVal lpFileName As String) As Long
Global_constants:
Option Explicit
Option Base 1
'Global constrants
'------------------------------
Global Const English = &H409
Global Const OPC_DS_CACHE = 1
Global Const OPC_DS_DEVICE = 2
BCA_OPC:
Option Explicit
Option Base 1
' Interface Objects 接口对象
'----------------------------------------------------------------------------
' 必须使用WithEvents来申明对象OPCServer和OPCGroup,
' WithEvents指定申明的对象用于处理对象的事件
Dim WithEvents ServerObj As OPCServer ' 定义OPCServer
Dim GroupObj As OPCGroup ' 定义OPCGroup
Dim WithEvents GroupCollection As OPCGroups ' 定义OPCGroups
Dim ItemCollection As OPCItems ' 定义OPCItems
Dim ItemObj As OPCItem ' 定义OPCItem
'----------------------------------------------------------------------------
' Global Variables 全局变量
'----------------------------------------------------------------------------
Dim ServerName As String ' OPC服务器名称
Dim ServerConnected As Boolean ' OPC服务器已连接标志
' OPCServer和OPCGroup都有ServerHandle和ClientHandle参数;
' ServerHandle用于OPC服务器定位;ClientHandle用于OPC客户端定位;
Dim ServerGroupHandle() As Long ' 服务器-组句柄(索引)
Dim ServerItemHandle() As Long ' 服务器-条目句柄
Dim ClientGroupHandle() As Long ' 客户机-组句柄
Dim ClientItemHandle() As Long ' 客户机-条目句柄
Dim Dll_is_Initial As Boolean ' DLL初始化
Dim Configuration_is_Set As Boolean ' 是否已组态
Dim TraceOn As Boolean ' 跟踪开关
Dim TraceFile As String ' 跟踪文件
Dim ConfigFile As String ' 组态文件
Dim ItemData(1024) As Variant ' 读取变量数据的储存地址
Dim AllItemsInfo As New ItemsInfo
'log文件记录操作
Private Function Trace(TraceMsg As String)
If TraceOn = True Then
Dim fs As Object, f As Object
Dim mHour, mMinute, mSecond, mMSecond As String
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile(TraceFile, 8, -2)
mHour = Format(Fix(Timer / 3600), "00")
mMinute = Format(Fix((Timer - mHour * 3600) / 60), "00")
mSecond = Format(Fix((Timer - mHour * 3600 - mMinute * 60)), "00")
mMSecond = Format(Fix((Timer - Fix(Timer)) * 1000), "000")
f.Writeline "[" & mHour & ":" & mMinute & ":" & mSecond & "." & mMSecond & "] " & TraceMsg
f.Close
Set fs = Nothing
Set f = Nothing
End If
End Function
'(1).DLL初始化
Public Function Dll_Initial(strConfigFile As String) As Boolean
Dim Result As String * 255, fs As Object, f As Object
ConfigFile = strConfigFile
GetPrivateProfileString "TRACE", "TraceOn", _
"ERROR", Result, 255, ConfigFile
If Result <> "ERROR" Then
If Result = 1 Then
GetPrivateProfileString "TRACE", "TraceFile", _
"ERROR", Result, 255, ConfigFile
If Result <> "ERROR" Then
TraceFile = Result
Else
TraceFile = App.Path & "\Trace.log"
End If
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.CreateTextFile(TraceFile, True)
f.Writeline ("*** BCA_OPC Trace Started , BeiChen Automation 2003 / Zhang Peng ***")
f.Close
TraceOn = True
Else
TraceOn = False
End If
Dll_is_Initial = True
Dll_Initial = True
Trace ">Dll_Initial"
Trace "<Dll_Initial OK"
Else
MsgBox "无法找到配置文件: " & strConfigFile, vbOKOnly, "错误"
Dll_is_Initial = False
Dll_Initial = False
End If
End Function
'(2).连接OPC服务器
Public Function ConnectServer(Optional IPAddress As String) As Boolean
Trace ">ConnectServer"
If Dll_is_Initial = False Then
Trace "<ConnectServer Cancelled,Because Dll_Initial has not been called"
Exit Function
End If
If Not ServerConnected Then
ServerName = GetServerName
On Error GoTo ErrorHandler
Set ServerObj = New OPCServer
ServerObj.Connect ServerName, IPAddress
ServerConnected = True
Trace "<ConnectServer OK"
Else
Trace "<Server has been connected,Please do not connect it again"
End If
ConnectServer = ServerConnected
Exit Function
ErrorHandler:
Trace "<ConnectServer Error,Please be sure that Server is running"
ConnectServer = False
End Function
'(3).组态OPC客户机
Public Function SetConfiguration() As Boolean
Trace ">SetConfiguration start..."
If Dll_is_Initial = False Then
Trace "<SetConfiguration Cancelled,Because Dll_Initial has not been called"
Exit Function
End If
If ServerConnected = False Then
Trace "<SetConfiguration Cancelled,Because ConnectServer has not been called"
Exit Function
End If
If Configuration_is_Set = True Then
Trace "<SetConfiguration Cancelled,Because configuration has been set"
Exit Function
End If
'Begin to configure
Dim f_ret As Long, ReturnedString As String * 1024, Valid_ReturnedString As String
Dim ReturnedString1 As String * 1024, Valid_ReturnedString1 As String
Dim Space_pos As Integer, GroupName As String
Dim Space_pos1, Equal_pos As Integer, ItemName As String, ItemIndex As Long
Dim NumItems As Long, ItemIDs(1) As String, ClientHandles(1) As Long, Serverhandles() As Long
Dim Errors() As Long
ReturnedString = ""
ReturnedString1 = ""
On Error GoTo ErrorHandler
Set GroupCollection = ServerObj.OPCGroups
GroupCollection.DefaultGroupIsActive = False
f_ret = GetPrivateProfileSection("GROUP", ReturnedString, 1024, ConfigFile)
Valid_ReturnedString = Left(ReturnedString, f_ret + 1)
Do Until InStr(Valid_ReturnedString, Chr(0)) < 0
Space_pos = InStr(Valid_ReturnedString, Chr(0))
GroupName = Left(Valid_ReturnedString, Space_pos - 1)
If GroupName = "" Then
GoTo nxt3
End If
Set GroupObj = GroupCollection.Add(GroupName)
GroupObj.IsSubscribed = False
Trace "<Add group: " & GroupName & " OK"
Set ItemCollection = GroupObj.OPCItems
ItemCollection.DefaultIsActive = True
f_ret = GetPrivateProfileSection(GroupName, ReturnedString1, 1024, ConfigFile)
Valid_ReturnedString1 = Left(ReturnedString1, f_ret + 1)
Do Until InStr(Valid_ReturnedString1, Chr(0)) < 0
Space_pos1 = InStr(Valid_ReturnedString1, Chr(0))
ItemName = Left(Valid_ReturnedString1, Space_pos1 - 1)
If ItemName = "" Then
GoTo nxt2
End If
If InStr(ItemName, "UpdateRate") > 0 Or InStr(ItemName, "IsSubscribed") > 0 Then
GoTo nxt1
End If
ItemCollection.DefaultRequestedDataType = GetItemDataType(ItemName)
ItemIndex = ItemIndex + 1
NumItems = 1
ItemIDs(1) = ItemName
ClientHandles(1) = ItemIndex
ItemCollection.AddItems NumItems, ItemIDs, ClientHandles, Serverhandles, Errors
AllItemsInfo.ItemInfo_Add ItemName, GroupName, ItemIndex, Serverhandles(1)
Trace "<Add Item: " & ItemName & " OK"
nxt1: Valid_ReturnedString1 = Mid(Valid_ReturnedString1, Space_pos1 + 1)
Loop
nxt2: f_ret = GetPrivateProfileInt(GroupName, "UpdateRate", 0, ConfigFile)
GroupObj.UpdateRate = f_ret
Trace "<Set group: " & GroupName & " UpdateRate=" & f_ret & " OK"
f_ret = GetPrivateProfileInt(GroupName, "IsSubscribed", 0, ConfigFile)
GroupObj.IsSubscribed = IIf(f_ret = 1, True, False)
GroupObj.IsActive = True
Trace "<Set group: " & GroupName & " IsSubscribed=" & f_ret & " OK"
Valid_ReturnedString = Mid(Valid_ReturnedString, Space_pos + 1)
Set GroupObj = Nothing
Set ItemCollection = Nothing
Loop
nxt3: Trace "<SetConfiguration end"
Configuration_is_Set = True
SetConfiguration = True
Exit Function
ErrorHandler:
Trace "<SetConfiguration Error,Please be sure that config file is correct"
Configuration_is_Set = False
End Function
'获取服务器名称
Private Function GetServerName() As String
Dim Result As String * 255
GetPrivateProfileString "SERVER", "Server", _
"ERROR", Result, 255, ConfigFile
GetServerName = RemoveSpaces(Result)
End Function
'获取服务器连接状态
Private Function GetConnectStatus() As Boolean
GetConnectStatus = ServerConnected
End Function
' 功能块:移除空格
Private Function RemoveSpaces(Item As String) As String
Dim Result As String
Dim i As Integer
i = 1
While (Mid$(Item, i, 1) <> Chr(0))
Result = Result & Mid$(Item, i, 1)
i = i + 1
Wend
RemoveSpaces = Result
End Function
Private Sub Class_Initialize()
Configuration_is_Set = False
Dll_is_Initial = False
ServerConnected = False
End Sub
'DLL终止
Private Sub Class_Terminate()
Set ServerObj = Nothing ' 释放ServerObj
Set GroupCollection = Nothing ' 释放GroupCollection
Set ItemCollection = Nothing ' 释放ItemCollection
ServerConnected = False
Dll_is_Initial = False
Configuration_is_Set = False
Trace "<Dll is terminate"
End Sub
'全局数据改变
Private Sub GroupCollection_GlobalDataChange(ByVal TransactionID As Long, ByVal GroupHandle As Long, ByVal NumItems As Long, ClientHandles() As Long, ItemValues() As Variant, Qualities() As Long, TimeStamps() As Date)
Dim i As Integer, GroupName As String, ItemName As String
Trace "<== GlobalDataChange!Following is the data:"
GroupName = GroupCollection.GetOPCGroup(GroupHandle).Name
Trace "<== GroupName: " & GroupName & " Number of Items:" & NumItems
For i = 1 To NumItems
ItemData(ClientHandles(i)) = ItemValues(i)
Trace "<== Item's Name: " & AllItemsInfo.GetItem_Name(ClientHandles(i)) & " Values: " & ItemValues(i) & " Changed Data: " & TimeStamps(i)
Next
Trace "<== GlobalDataChange End"
End Sub
'获取单个变量数据
Public Function GetData(ItemName As String)
Trace ">GetData start:ItemName= " & ItemName
If Dll_is_Initial = False Then
Trace "<GetData Cancelled,Because Dll_Initial has not been called"
Exit Function
End If
If ServerConnected = False Then
Trace "<GetData Cancelled,Because ConnectServer has not been called"
Exit Function
End If
If Configuration_is_Set = False Then
Trace "<GetData Cancelled,Because configuration has not been set"
Exit Function
End If
Dim ItemClientHandle As Long
ItemClientHandle = AllItemsInfo.GetItem_ClientHandle(ItemName)
GetData = ItemData(ItemClientHandle)
Trace "<GetData OK: ItemData= " & GetData
End Function
'写入单个变量数据
Public Function WriteData(ItemName As String, ItemWriteData As Variant)
Trace ">WriteData to Wincc start..."
Trace ">ItemName: " & ItemName & " Value: " & ItemWriteData
If Dll_is_Initial = False Then
Trace "<WriteData Cancelled,Because Dll_Initial has not been called"
Exit Function
End If
If ServerConnected = False Then
Trace "<WriteData Cancelled,Because ConnectServer has not been called"
Exit Function
End If
If Configuration_is_Set = False Then
Trace "<WriteData Cancelled,Because configuration has not been set"
Exit Function
End If
On Error GoTo ErrorHandler
Set GroupObj = GroupCollection.GetOPCGroup(AllItemsInfo.GetItem_Group(ItemName))
Set ItemObj = GroupObj.OPCItems.GetOPCItem(AllItemsInfo.GetItem_ServerHandle(ItemName))
ItemObj.Write ItemWriteData
Trace "<WriteData to Wincc OK"
Set GroupObj = Nothing
Set ItemObj = Nothing
Exit Function
ErrorHandler:
Trace "<Write Data to Wincc Error,Please make sure Item's Name and Write-data is correct"
Set GroupObj = Nothing
Set ItemObj = Nothing
End Function
'列举某个变量的属性
Private Function GetItemProperty(ItemID As String)
Dim Count As Long, i As Long
Dim PropertyIDs() As Long
Dim Descriptions() As String
Dim DataTypes() As Integer
Dim PropertyValues() As Variant
Dim Errors() As Long
ServerObj.QueryAvailableProperties ItemID, Count, PropertyIDs, Descriptions, DataTypes
ServerObj.GetItemProperties ItemID, Count, PropertyIDs, PropertyValues, Errors
Trace "=====Get ItemID Property Start======"
For i = 1 To Count
Trace "=" & PropertyIDs(i) & " " & Descriptions(i) & " " & PropertyValues(i)
Next
Trace "=====Get ItemID Property End======"
End Function
'获取某个变量的数据类型
Private Function GetItemDataType(ItemID As String) As Long
Dim Count As Long
Dim PropertyIDs(1) As Long
Dim PropertyValues() As Variant
Dim Errors() As Long
Count = 1
PropertyIDs(1) = 1
ServerObj.GetItemProperties ItemID, Count, PropertyIDs, PropertyValues, Errors
GetItemDataType = PropertyValues(1)
End Function
'服务器关闭
Private Sub ServerObj_ServerShutDown(ByVal Reason As String)
Trace "! Dll is shutdown,Following is the Reason:"
Trace "! " & Reason
ServerObj.Disconnect
Configuration_is_Set = False
Dll_is_Initial = False
ServerConnected = False
End Sub
'获取服务器连接状态
Public Property Get Server_Connected() As Boolean
Server_Connected = Configuration_is_Set
End Property
ItemInfo:
Option Explicit
Public ItemName As String
Public GroupName As String
Public ItemServerHandle As Long
Public ItemClientHandle As Long
ItemsInfo:
Option Explicit
Dim Collection_ItemsInfo As New Collection ' 定义OPCItem 信息
Public Function ItemInfo_Add(Name As String, Group As String, ClientHandle As Long, ServerHandle As Long)
Dim Info As New ItemInfo
With Info
.ItemName = Name
.GroupName = Group
.ItemClientHandle = ClientHandle
.ItemServerHandle = ServerHandle
End With
Collection_ItemsInfo.Add Info
End Function
'获取Item属于的组名
Public Function GetItem_Group(ItemID As String) As String
Dim Info As ItemInfo
For Each Info In Collection_ItemsInfo
If Info.ItemName = ItemID Then
GetItem_Group = Info.GroupName
Exit Function
End If
Next
End Function
'获取Item的ServerHandle
Public Function GetItem_ServerHandle(ItemID As String) As Long
Dim Info As ItemInfo
For Each Info In Collection_ItemsInfo
If Info.ItemName = ItemID Then
GetItem_ServerHandle = Info.ItemServerHandle
Exit Function
End If
Next
End Function
'获取Item的ClientHandle
Public Function GetItem_ClientHandle(ItemID As String)
Dim Info As ItemInfo
For Each Info In Collection_ItemsInfo
If Info.ItemName = ItemID Then
GetItem_ClientHandle = Info.ItemClientHandle
Exit Function
End If
Next
End Function
'获取Item的名称
Public Function GetItem_Name(ItemClientHandle As Long)
Dim Info As ItemInfo
For Each Info In Collection_ItemsInfo
If Info.ItemClientHandle = ItemClientHandle Then
GetItem_Name = Info.ItemName
Exit Function
End If
Next
End Function
将以上代码输入VB并编译生成OPC_DLL.dll文件，完成后注册。OPC调用函数请参阅opcdataaccessautov2-02_76文件。
四、应用介绍
1、 新建ini配置文件（保存于系统目录下），如wincc.ini。注意组中定义的变量名称必须存在于OPCServer中！右边//后的内容仅为注释，不应在文件中存在！内容如下：
[TRACE]
TraceOn=1 //=1:打开调试开关
TraceFile="D:\OPCTrace.log" //输出的调试文件
[SERVER]
Server= OPCServer.WinCC //OPCServer名称
[GROUP] //定义组别
TEMP
PRESS
FLOW
[TEMP]//组别：TEMP中的变量定义UpdateRate=100
//更新速率（毫秒）
IsSubscribed=1 //标记，总是=1
JUNRE_Q_T1
JUNRE_Q_T2
JUNRE_H_T1
JUNRE_H_T2
JIA2_Q_T
JIA2_H_T
JIA1_Q_T
JIA1_H_T
YURE_T
HUANRE_YAN_Q_T
HUANRE_YAN_H_T
REFENG_T
[PRESS]
UpdateRate=100
IsSubscribed=1
LU_P.Value
MEIQI_P
KONGQI_P
YS_KONGQI_P
[FLOW]
UpdateRate=100
IsSubscribed=1
JUNRE_CO_F1
JUNRE_CO_F2
JIA2_CO_F1
JIA2_CO_F2
JIA1_CO_F1
JIA1_CO_F2
JUNRE_AIR_F1
JUNRE_AIR_F2
JIA2_AIR_F1
JIA2_AIR_F2
JIA1_AIR_F1
JIA1_AIR_F2
CO_F_ACC
2、在VB工程中引用OPC_DLL：
3、创建BCA_OPC全局对象:
Public MyOPC As New BCA_OPC
4、创建5秒定时器，事件如下：
Private Sub Timer1_Timer()
If MyOPC.Server_Connected = False Then
MyOPC.Dll_Initial(wincc.ini)
MyOPC.ConnectServer
MyOPC.SetConfiguration
StatusBar1.Panels(7).Text = "通讯: 断开 "
Else
StatusBar1.Panels(7).Text = "通讯: 连接 "
End If
End Sub
5、当连接上后读取数据：
Dim real_Junre_q_t1 as double
If MyOPC.Server_Connected = True Then
real_Junre_q_t1=GetData(“JUNRE_Q_T1”)
end if
6、写数据：
Private Sub Command_write_Click()
WriteData(“JUNRE_Q_T1”,1234.0)
End Sub
五、总结
本动态连接库已在山东九福饲料有限公司的饲料生产线工程上获得很好的应用。系统采用SIEMENS S7400，外挂多个ET200M站，CPU414-2DP通过CP443-1连接两台IPC作为操作员站，采用WINCC作为上位机，分别对系统进行监视和控制；另外配置一台服务器，通过交换机与前两台IPC相连，执行饲料生产管理，管理软件采用VB开发，执行饲料管理、原料管理、配方管理、生产任务管理等功能，本软件通过OPC_DLL动态连接库同时登陆两台操作员站的WINCC OPC服务器，读取现场数据进行数据归档和报表处理；同时将用户配置的生产任务通过WINCC OPC通道写入PLC执行。
当然如果不采用此模式，直接通过WINCC数据库功能实现也是可以的，但要实现本系统复杂的数据管理还是比较困难，另外如果服务器也直接连接到CP443-1，一方面可能带来数据采集的一致性问题，另一方面也增加了CP443-1的通讯负载。因此相比本模式还是较优化的。当然WINCC出现问题或操作员站故障，VB通过OPC采集就会中断，如果在软件中监测OPC连接，一旦WINCC OPC通道中断，则切换采用SIMATIC NET的IE OPCServer直接连接CP443-1采集数据，这样就更加完善了。