OPC Client 動態連接庫開發和應用

2007/9/5 15:17:57

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

无码中文字幕色专区_91av俱乐部_无码人妻h动漫_26uuu成人_91九色丨porny丨国产jk_青青视频在线播放_国内自拍第二页_国产又粗又长又爽又黄的视频_色哟哟免费网站_久久出品必属精品_a级黄色一级片_99日在线视频

OPC Client 動態連接庫開發和應用