一、引言
現在有很多工業控制產品都支持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采集數據，這樣就更加完善了。