基于VB的OPC Client开发

1、一、引言现在有很多工业控制产品都支持OPC Server，如西门子SIMATIC NET、WINCC、WINAC、Protool/pro，亚控公司组态王等，这些产品本身在一些需要实现很复杂的数据模型功能上还显得不足，由于支持了OPC，我们就可以在VB或C+上通过OPC获取数据进而实现较复杂的功能（如强大的数据库管理或数据分析）。本文讨论了如何在VB中开发一个动态连接库，以方便开发者实现对OPC服务器的数据采集，将精力更多的放在界面开发和数据处理上。二、功能设计类型设计为ActiveX Dll，名称：OPC_Dll.dll，可以在VB工程引用中加载，加载后通过创建类BCA_OPC的实例来实现OP

2、C数据通讯，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

3、 String) As BooleanIPAddress为可选的远程OPC服务器所属PC的IP地址，如“”，如果不提供IPAddress参数，则默认为本机OPC服务器。连接成功返回TRUE。3、配置通讯变量（组态OPC客户机）：SetConfiguration() As Boolean根据提供的ini配置文件组态OPC客户机与服务器的变量通讯，组态成功返回TRUE。4、读变量数据：GetData(ItemName As String)ItemName为变量名称，必须与ini配置文件中的变量名称一致。本功能返回该变量的实际数据。5、写变量数据：WriteData(ItemN

4、ame 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

5、、以下为各模块的程序代码：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 从一个初始化文件中获取指定段

6、的所有键和值(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

7、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 LongGlobal_constants:Option ExplicitOption Base 1Global constrants-Global Const E

8、nglish = &H409Global Const OPC_DS_CACHE = 1Global Const OPC_DS_DEVICE = 2BCA_OPC:Option ExplicitOption Base 1 Interface Objects 接口对象- 必须使用WithEvents来申明对象OPCServer和OPCGroup, WithEvents指定申明的对象用于处理对象的事件Dim WithEvents ServerObj As OPCServer 定义OPCServerDim GroupObj As OPCGroup 定义OPCGroupDim WithEvents Gr

9、oupCollection As OPCGroups 定义OPCGroupsDim ItemCollection As OPCItems 定义OPCItemsDim ItemObj As OPCItem 定义OPCItem- Global Variables 全局变量-Dim ServerName As String OPC服务器名称Dim ServerConnected As Boolean OPC服务器已连接标志 OPCServer和OPCGroup都有ServerHandle和ClientHandle参数; ServerHandle用于OPC服务器定位;ClientHandle用于OPC

10、客户端定位;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 跟踪文件Di

11、m ConfigFile As String 组态文件Dim ItemData(1024) As Variant 读取变量数据的储存地址Dim AllItemsInfo As New ItemsInfolog文件记录操作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.FileSystemObje

12、ct) 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 & : & mSec

13、ond & . & mMSecond & & TraceMsg f.Close Set fs = Nothing Set f = Nothing End IfEnd 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, Resul

14、t, 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(Trace

15、File, 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 ConnectServer If Dll_is_Initial = False Then Trace ConnectServer Cancelled,Because Dll_Initia

16、l 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

17、it again End If ConnectServer = ServerConnected Exit FunctionErrorHandler: 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,Becau

18、se 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 ReturnedStr

19、ing1 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 Returned

20、String = 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_ReturnedS

21、tring, 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.OPCIte

22、ms 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 Or InStr(ItemName, IsSubscribed) 0 Then GoTo nxt1 End If ItemCollection.Defa

23、ultRequestedDataType = 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

24、Add Item: & ItemName & OKnxt1: Valid_ReturnedString1 = Mid(Valid_ReturnedString1, Space_pos1 + 1) Loopnxt2: f_ret = GetPrivateProfileInt(GroupName, UpdateRate, 0, ConfigFile) GroupObj.UpdateRate = f_ret Trace Set group: & GroupName & UpdateRate= & f_ret & OK f_ret = GetPrivateProfileInt(GroupName, I

25、sSubscribed, 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 Loopnxt3: Trace SetCo

26、nfiguration end Configuration_is_Set = True SetConfiguration = True Exit FunctionErrorHandler: Trace SetConfiguration Error,Please be sure that config file is correct Configuration_is_Set = FalseEnd Function获取服务器名称Private Function GetServerName() As String Dim Result As String * 255 GetPrivateProfil

27、eString SERVER, Server, _ ERROR, Result, 255, ConfigFile GetServerName = RemoveSpaces(Result)End Function获取服务器连接状态Private Function GetConnectStatus() As Boolean GetConnectStatus = ServerConnectedEnd Function 功能块:移除空格Private Function RemoveSpaces(Item As String) As String Dim Result As String Dim i A

28、s Integer i = 1 While (Mid$(Item, i, 1) Chr(0) Result = Result & Mid$(Item, i, 1) i = i + 1 Wend RemoveSpaces = ResultEnd FunctionPrivate Sub Class_Initialize() Configuration_is_Set = False Dll_is_Initial = False ServerConnected = FalseEnd SubDLL终止Private Sub Class_Terminate() Set ServerObj = Nothin

29、g 释放ServerObj Set GroupCollection = Nothing 释放GroupCollection Set ItemCollection = Nothing 释放ItemCollection ServerConnected = False Dll_is_Initial = False Configuration_is_Set = False Trace Dll is terminateEnd Sub全局数据改变Private Sub GroupCollection_GlobalDataChange(ByVal TransactionID As Long, ByVal G

30、roupHandle 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

31、 Trace = GroupName: & GroupName & Number of Items: & NumItems For i = 1 To NumItems ItemData(ClientHandles(i) = ItemValues(i) Trace = Items Name: & AllItemsInfo.GetItem_Name(ClientHandles(i) & Values: & ItemValues(i) & Changed Data: & TimeStamps(i) Next Trace GetData start:ItemName= & ItemName If Dl

32、l_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 c

33、onfiguration has not been set Exit Function End If Dim ItemClientHandle As Long ItemClientHandle = AllItemsInfo.GetItem_ClientHandle(ItemName) GetData = ItemData(ItemClientHandle) Trace WriteData to Wincc start. Trace ItemName: & ItemName & Value: & ItemWriteData If Dll_is_Initial = False Then Trace

34、 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

35、 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 S

36、et ItemObj = Nothing Exit FunctionErrorHandler: Trace Write Data to Wincc Error,Please make sure Items Name and Write-data is correct Set GroupObj = Nothing Set ItemObj = NothingEnd Function列举某个变量的属性Private Function GetItemProperty(ItemID As String) Dim Count As Long, i As Long Dim PropertyIDs() As

37、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 Pr

38、operty 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 E

39、rrors() 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 ! & Reas

40、on ServerObj.Disconnect Configuration_is_Set = False Dll_is_Initial = False ServerConnected = FalseEnd Sub获取服务器连接状态Public Property Get Server_Connected() As Boolean Server_Connected = Configuration_is_SetEnd PropertyItemInfo:Option ExplicitPublic ItemName As StringPublic GroupName As StringPublic It

41、emServerHandle As LongPublic ItemClientHandle As LongItemsInfo:Option ExplicitDim 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 .GroupNam

42、e = Group .ItemClientHandle = ClientHandle .ItemServerHandle = ServerHandle End With Collection_ItemsInfo.Add InfoEnd 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 =

43、 Info.GroupName Exit Function End If NextEnd Function获取Item的ServerHandlePublic 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 NextEnd F

44、unction获取Item的ClientHandlePublic 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 NextEnd Function获取Item的名称Public Function GetItem_Name(ItemClien

45、tHandle 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 NextEnd Function将以上代码输入VB并编译生成OPC_DLL.dll文件，完成后注册。OPC调用函数请参阅opcdataaccessautov2-02_76文件。四、应用介绍1、新建ini配置文件（保存于系统目录下），如wincc.ini。注意组中定义的变量名称必须存在于OPCServer中！右边/后的内容仅为注释，不应在文件中存在！内容如下：TRACETraceOn=1/=1:打开调试开关TraceFile=D:OPCTrace.log/输出的调试文件SERVER