OPC-Client-动态连接库开发和应用

一、引言

现在有很多工业控制产品都支持OPCServer，如西门子SIMATICNET、WINCC、WINAC、Protool/pro，亚控公司组态王等，这些产品本身在一些需要实现很复杂的数据模型功能上还显得缺乏，由于支持了OPC，我们就可以在VB或C++上通过OPC获取数据进而实现较复杂的功能〔如强大的数据库管理或数据分析〕。本文讨论了如何在VB中开发一个动态连接库，以方便开发者实现对OPC效劳器的数据采集，将精力更多的放在界面开发和数据处理上。二、功能设计

类型设计为ActiveXDll，名称：OPC_Dll.dll，可以在VB工程[引用]中加载，加载后通过创立类BCA_OPC的实例来实现OPC数据通讯，BCA_OPC的调用功能如下：

1、配置初始化：Dll_Initial(strConfigFileAsString)AsBoolean

其中strConfigFile为连接OPC效劳器对应的配置文件名称〔*.ini〕，用户建立的配置文件应遵循一定的格式〔在下面应用中说明〕，并且应放在系统目录下〔如C:\WINNT下〕。配置文件中包含了要连接的OPC效劳器名称、log文件名称、变量组定义及对应组内的变量定义〔本连接库最多支持1024个变量通讯，对变量组的数目没有限制〕。配置成功返回TRUE。

2、连接OPC效劳器：ConnectServer(OptionalIPAddressAsString)AsBoolean

IPAddress为可选的远程OPC效劳器所属PC的IP地址，如“”，如果不提供IPAddress参数，那么默认为本机OPC效劳器。连接成功返回TRUE。

3、配置通讯变量〔组态OPC客户机〕：SetConfiguration()AsBoolean

根据提供的ini配置文件组态OPC客户机与效劳器的变量通讯，组态成功返回TRUE。

4、读变量数据：GetData(ItemNameAsString)

ItemName为变量名称，必须与ini配置文件中的变量名称一致。本功能返回该变量的实际数据。

5、写变量数据：WriteData(ItemNameAsString,ItemWriteDataAsVariant)

ItemName为变量名称，ItemWriteData为变量数据。

三、实现代码

1、在VB6.0中新建ActiveXDll工程，如下列图：

2、在工程菜单中添加引用，如下列图：

如果系统中没有OPCAutomation，你需要安装注册OPC自动化。一般装了OPC支持的软件，系统都支持OPC自动化。

3、在工程中添加模块，如下列图：

模块API_Function为软件所需的一些API函数。

模块Global_constants为一些系统常量

类模块BCA_OPC为实现主类

类模块ItemInfo和ItemsInfo实现变量信息的封装

4、以下为各模块的程序代码：

API_Function:

OptionExplicit'----------------------------------

'获取一个与给定初始化文件指定域中的一个键相联系的整数值(1)

PublicDeclareFunctionGetPrivateProfileIntLib"kernel32"Alias_

"GetPrivateProfileIntA"(ByVallpApplicationNameAsString,ByVallpKeyNameAsString,_

ByValnDefaultAsLong,ByVallpFileNameAsString)AsLong

'从一个初始化文件中获取指定段的所有键和值(2)

PublicDeclareFunctionGetPrivateProfileSectionLib"kernel32"Alias_

"GetPrivateProfileSectionA"(ByVallpAppNameAsString,ByVallpReturnedStringAsString,_

ByValnSizeAsLong,ByVallpFileNameAsString)AsLong

'获取初始化文件中的制定断下的一个字符串(3)

PublicDeclareFunctionGetPrivateProfileStringLib"kernel32"Alias_

"GetPrivateProfileStringA"(ByVallpApplicationNameAsString,ByVallpKeyNameAsAny,_

ByVallpDefaultAsString,ByVallpReturnedStringAsString,ByValnSizeAsLong,_

ByVallpFileNameAsString)AsLongGlobal_constants:

OptionExplicit

OptionBase1

'Globalconstrants

'------------------------------

GlobalConstEnglish=&H409

GlobalConstOPC_DS_CACHE=1

GlobalConstOPC_DS_DEVICE=2BCA_OPC:

OptionExplicit

OptionBase1'InterfaceObjects接口对象

'----------------------------------------------------------------------------

'必须使用WithEvents来申明对象OPCServer和OPCGroup,

'WithEvents指定申明的对象用于处理对象的事件

DimWithEventsServerObjAsOPCServer

'定义OPCServer

DimGroupObjAsOPCGroup

'定义OPCGroup

DimWithEventsGroupCollectionAsOPCGroups'定义OPCGroups

DimItemCollectionAsOPCItems

'定义OPCItems

DimItemObjAsOPCItem

'定义OPCItem

'----------------------------------------------------------------------------

'GlobalVariables全局变量

'----------------------------------------------------------------------------

DimServerNameAsString

'OPC效劳器名称

DimServerConnectedAsBoolean

'OPC效劳器已连接标志

'OPCServer和OPCGroup都有ServerHandle和ClientHandle参数;

'ServerHandle用于OPC效劳器定位;ClientHandle用于OPC客户端定位;

DimServerGroupHandle()AsLong

'效劳器-组句柄(索引)

DimServerItemHandle()AsLong

'效劳器-条目句柄

DimClientGroupHandle()AsLong

'客户机-组句柄

DimClientItemHandle()AsLong

'客户机-条目句柄

DimDll_is_InitialAsBoolean

'DLL初始化

DimConfiguration_is_SetAsBoolean

'是否已组态

DimTraceOnAsBoolean

'跟踪开关

DimTraceFileAsString

'跟踪文件

DimConfigFileAsString

'组态文件

DimItemData(1024)AsVariant

'读取变量数据的储存地址

DimAllItemsInfoAsNewItemsInfo'log文件记录操作

PrivateFunctionTrace(TraceMsgAsString)

IfTraceOn=TrueThen

DimfsAsObject,fAsObject

DimmHour,mMinute,mSecond,mMSecondAsString

Setfs=CreateObject("Scripting.FileSystemObject")

Setf=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

Setfs=Nothing

Setf=Nothing

EndIf

EndFunction'(1).DLL初始化

PublicFunctionDll_Initial(strConfigFileAsString)AsBoolean

DimResultAsString*255,fsAsObject,fAsObject

ConfigFile=strConfigFile

GetPrivateProfileString"TRACE","TraceOn",_

"ERROR",Result,255,ConfigFile

IfResult<>"ERROR"Then

IfResult=1Then

GetPrivateProfileString"TRACE","TraceFile",_

"ERROR",Result,255,ConfigFile

IfResult<>"ERROR"Then

TraceFile=Result

Else

TraceFile=App.Path&"\Trace.log"

EndIf

Setfs=CreateObject("Scripting.FileSystemObject")

Setf=fs.CreateTextFile(TraceFile,True)

f.Writeline("***BCA_OPCTraceStarted,BeiChenAutomation2003/ZhangPeng***")

f.Close

TraceOn=True

Else

TraceOn=False

EndIf

Dll_is_Initial=True

Dll_Initial=True

Trace">Dll_Initial"

Trace"<Dll_InitialOK"

Else

MsgBox"无法找到配置文件:"&strConfigFile,vbOKOnly,"错误"

Dll_is_Initial=False

Dll_Initial=False

EndIf

EndFunction'(2).连接OPC效劳器

PublicFunctionConnectServer(OptionalIPAddressAsString)AsBoolean

Trace">ConnectServer"

IfDll_is_Initial=FalseThen

Trace"<ConnectServerCancelled,BecauseDll_Initialhasnotbeencalled"

ExitFunction

EndIf

IfNotServerConnectedThen

ServerName=GetServerName

OnErrorGoToErrorHandler

SetServerObj=NewOPCServer

ServerObj.ConnectServerName,IPAddress

ServerConnected=True

Trace"<ConnectServerOK"

Else

Trace"<Serverhasbeenconnected,Pleasedonotconnectitagain"

EndIf

ConnectServer=ServerConnected

ExitFunction

ErrorHandler:

Trace"<ConnectServerError,PleasebesurethatServerisrunning"

ConnectServer=False

EndFunction'(3).组态OPC客户机

PublicFunctionSetConfiguration()AsBoolean

Trace">SetConfigurationstart..."

IfDll_is_Initial=FalseThen

Trace"<SetConfigurationCancelled,BecauseDll_Initialhasnotbeencalled"

ExitFunction

EndIf

IfServerConnected=FalseThen

Trace"<SetConfigurationCancelled,BecauseConnectServerhasnotbeencalled"

ExitFunction

EndIf

IfConfiguration_is_Set=TrueThen

Trace"<SetConfigurationCancelled,Becauseconfigurationhasbeenset"

ExitFunction

EndIf

'Begintoconfigure

Dimf_retAsLong,ReturnedStringAsString*1024,Valid_ReturnedStringAsString

DimReturnedString1AsString*1024,Valid_ReturnedString1AsString

DimSpace_posAsInteger,GroupNameAsString

DimSpace_pos1,Equal_posAsInteger,ItemNameAsString,ItemIndexAsLong

DimNumItemsAsLong,ItemIDs(1)AsString,ClientHandles(1)AsLong,Serverhandles()AsLong

DimErrors()AsLong

ReturnedString=""

ReturnedString1=""

OnErrorGoToErrorHandler

SetGroupCollection=ServerObj.OPCGroups

GroupCollection.DefaultGroupIsActive=False

f_ret=GetPrivateProfileSection("GROUP",ReturnedString,1024,ConfigFile)

Valid_ReturnedString=Left(ReturnedString,f_ret+1)

DoUntilInStr(Valid_ReturnedString,Chr(0))<0

Space_pos=InStr(Valid_ReturnedString,Chr(0))

GroupName=Left(Valid_ReturnedString,Space_pos-1)

IfGroupName=""Then

GoTonxt3

EndIf

SetGroupObj=GroupCollection.Add(GroupName)

GroupObj.IsSubscribed=False

Trace"<Addgroup:"&GroupName&"OK"

SetItemCollection=GroupObj.OPCItems

ItemCollection.DefaultIsActive=True

f_ret=GetPrivateProfileSection(GroupName,ReturnedString1,1024,ConfigFile)

Valid_ReturnedString1=Left(ReturnedString1,f_ret+1)

DoUntilInStr(Valid_ReturnedString1,Chr(0))<0

Space_pos1=InStr(Valid_ReturnedString1,Chr(0))

ItemName=Left(Valid_ReturnedString1,Space_pos1-1)

IfItemName=""Then

GoTonxt2

EndIf

IfInStr(ItemName,"UpdateRate")>0OrInStr(ItemName,"IsSubscribed")>0Then

GoTonxt1

EndIf

ItemCollection.DefaultRequestedDataType=GetItemDataType(ItemName)

ItemIndex=ItemIndex+1

NumItems=1

ItemIDs(1)=ItemName

ClientHandles(1)=ItemIndex

ItemCollection.AddItemsNumItems,ItemIDs,ClientHandles,Serverhandles,Errors

AllItemsInfo.ItemInfo_AddItemName,GroupName,ItemIndex,Serverhandles(1)

Trace"<AddItem:"&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"<Setgroup:"&GroupName&"UpdateRate="&f_ret&"OK"

f_ret=GetPrivateProfileInt(GroupName,"IsSubscribed",0,ConfigFile)

GroupObj.IsSubscribed=IIf(f_ret=1,True,False)

GroupObj.IsActive=True

Trace"<Setgroup:"&GroupName&"IsSubscribed="&f_ret&"OK"

Valid_ReturnedString=Mid(Valid_ReturnedString,Space_pos+1)

SetGroupObj=Nothing

SetItemCollection=Nothing

Loop

nxt3:

Trace"<SetConfigurationend"

Configuration_is_Set=True

SetConfiguration=True

ExitFunction

ErrorHandler:

Trace"<SetConfigurationError,Pleasebesurethatconfigfileiscorrect"

Configuration_is_Set=False

EndFunction'获取效劳器名称

PrivateFunctionGetServerName()AsString

DimResultAsString*255

GetPrivateProfileString"SERVER","Server",_

"ERROR",Result,255,ConfigFile

GetServerName=RemoveSpaces(Result)

EndFunction'获取效劳器连接状态

PrivateFunctionGetConnectStatus()AsBoolean

GetConnectStatus=ServerConnected

EndFunction'功能块:移除空格

PrivateFunctionRemoveSpaces(ItemAsString)AsString

DimResultAsString

DimiAsInteger

i=1

While(Mid$(Item,i,1)<>Chr(0))

Result=Result&Mid$(Item,i,1)

i=i+1

Wend

RemoveSpaces=Result

EndFunctionPrivateSubClass_Initialize()

Configuration_is_Set=False

Dll_is_Initial=False

ServerConnected=False

EndSub'DLL终止

PrivateSubClass_Terminate()

SetServerObj=Nothing

'释放ServerObj

SetGroupCollection=Nothing

'释放GroupCollection

SetItemCollection=Nothing

'释放ItemCollection

ServerConnected=False

Dll_is_Initial=False

Configuration_is_Set=False

Trace"<Dllisterminate"

EndSub

'全局数据改变

PrivateSubGroupCollection_GlobalDataChange(ByValTransactionIDAsLong,ByValGroupHandleAsLong,ByValNumItemsAsLong,ClientHandles()AsLong,ItemValues()AsVariant,Qualities()AsLong,TimeStamps()AsDate)

DimiAsInteger,GroupNameAsString,ItemNameAsString

Trace"<==GlobalDataChange!Followingisthedata:"

GroupName=GroupCollection.GetOPCGroup(GroupHandle).Name

Trace"<==GroupName:"&GroupName&"NumberofItems:"&NumItems

Fori=1ToNumItems

ItemData(ClientHandles(i))=ItemValues(i)

Trace"<==Item'sName:"&AllItemsInfo.GetItem_Name(ClientHandles(i))&"Values:"&ItemValues(i)&"ChangedData:"&TimeStamps(i)

Next

Trace"<==GlobalDataChangeEnd"

EndSub

'获取单个变量数据

PublicFunctionGetData(ItemNameAsString)

Trace">GetDatastart:ItemName="&ItemName

IfDll_is_Initial=FalseThen

Trace"<GetDataCancelled,BecauseDll_Initialhasnotbeencalled"

ExitFunction

EndIf

IfServerConnected=FalseThen

Trace"<GetDataCancelled,BecauseConnectServerhasnotbeencalled"

ExitFunction

EndIf

IfConfiguration_is_Set=FalseThen

Trace"<GetDataCancelled,Becauseconfigurationhasnotbeenset"

ExitFunction

EndIf

DimItemClientHandleAsLong

ItemClientHandle=AllItemsInfo.GetItem_ClientHandle(ItemName)

GetData=ItemData(ItemClientHandle)

Trace"<GetDataOK:ItemData="&GetData

EndFunction'写入单个变量数据

PublicFunctionWriteData(ItemNameAsString,ItemWriteDataAsVariant)

Trace">WriteDatatoWinccstart..."

Trace">ItemName:"&ItemName&"Value:"&ItemWriteData

IfDll_is_Initial=FalseThen

Trace"<WriteDataCancelled,BecauseDll_Initialhasnotbeencalled"

ExitFunction

EndIf

IfServerConnected=FalseThen

Trace"<WriteDataCancelled,BecauseConnectServerhasnotbeencalled"

ExitFunction

EndIf

IfConfiguration_is_Set=FalseThen

Trace"<WriteDataCancelled,Becauseconfigurationhasnotbeenset"

ExitFunction

EndIf

OnErrorGoToErrorHandler

SetGroupObj=GroupCollection.GetOPCGroup(AllItemsInfo.GetItem_Group(ItemName))

SetItemObj=GroupObj.OPCItems.GetOPCItem(AllItemsInfo.GetItem_ServerHandle(ItemName))

ItemObj.WriteItemWriteData

Trace"<WriteDatatoWinccOK"

SetGroupObj=Nothing

SetItemObj=Nothing

ExitFunction

ErrorHandler:

Trace"<WriteDatatoWinccError,PleasemakesureItem'sNameandWrite-dataiscorrect"

SetGroupObj=Nothing

SetItemObj=Nothing

EndFunction

'列举某个变量的属性

PrivateFunctionGetItemProperty(ItemIDAsString)

DimCountAsLong,iAsLong

DimPropertyIDs()AsLong

DimDescriptions()AsString

DimDataTypes()AsInteger

DimPropertyValues()AsVariant

DimErrors()AsLong

ServerObj.QueryAvailablePropertiesItemID,Count,PropertyIDs,Descriptions,DataTypes

ServerObj.GetItemPropertiesItemID,Count,PropertyIDs,PropertyValues,Errors

Trace"=====GetItemIDPropertyStart======"

Fori=1ToCount

Trace"="&PropertyIDs(i)&"

"&Descriptions(i)&"

"&PropertyValues(i)

Next

Trace"=====GetItemIDPropertyEnd======"

EndFunction

'获取某个变量的数据类型

PrivateFunctionGetItemDataType(ItemIDAsString)AsLong

DimCountAsLong

DimPropertyIDs(1)AsLong

DimPropertyValues()AsVariant

DimErrors()AsLong

Count=1

PropertyIDs(1)=1

ServerObj.GetItemPropertiesItemID,Count,PropertyIDs,PropertyValues,Errors

GetItemDataType=PropertyValues(1)

EndFunction

'效劳器关闭

PrivateSubServerObj_ServerShutDown(ByValReasonAsString)

Trace"!Dllisshutdown,FollowingistheReason:"

Trace"!"&Reason

ServerObj.Disconnect

Configuration_is_Set=False

Dll_is_Initial=False

ServerConnected=False

EndSub

'获取效劳器连接状态

PublicPropertyGetServer_Connected()AsBoolean

Server_Connected=Configuration_is_Set

EndPropertyItemInfo:

OptionExplicitPublicItemNameAsString

PublicGroupNameAsString

PublicItemServerHandleAsLong

PublicItemClientHandleAsLongItemsInfo:

OptionExplicitDimCollection_ItemsInfoAsNewCollection

'定义OPCItem信息PublicFunctionItemInfo_Add(NameAsString,GroupAsString,ClientHandleAsLong,ServerHandleAsLong)

DimInfoAsNewItemInfo

WithInfo

.ItemName=Name

.GroupName=Group

.ItemClientHandle=ClientHandle

.ItemServerHandle=ServerHandle

EndWith

Collection_ItemsInfo.AddInfo

EndFunction'获取Item属于的组名

PublicFunctionGetItem_Group(ItemIDAsString)AsString

DimInfoAsItemInfo

ForEachInfoInCollection_ItemsInfo

IfInfo.ItemName=ItemIDThen

GetItem_Group=Info.GroupName

ExitFunction

EndIf

Next

EndFunction'获取Item的ServerHandle

PublicFunctionGetItem_ServerHandle(ItemIDAsString)AsLong

DimInfoAsItemInfo

ForEachInfoInCollection_ItemsInfo

IfInfo.ItemName=ItemIDThen

GetItem_ServerHandle=Info.ItemServerHandle

ExitFunction

EndIf

Next

EndFunction'获取Item的ClientHandle

PublicFunctionGetItem_ClientHandle(ItemIDAsString)

DimInfoAsItemInfo

ForEachInfoInCollection_ItemsInfo

IfInfo.ItemName=ItemIDThen

GetItem_ClientHandle=Info.ItemClientHandle

ExitFunction

EndIf

Next

EndFunction'获取Item的名称

PublicFunctionGetItem_Name(ItemClientHandleAsLong)

DimInfoAsItemInfo

ForEachInfoInCollection_ItemsInfo

IfInfo.ItemClientHandle=ItemClientHandleThen

GetItem_Name=Info.ItemName

ExitFunction

EndIf

Next

EndFunction将以上代码输入VB并编译生成OPC_DLL.dll文件，完成后注册。OPC调用函数请参阅opcdataaccessautov2-02_76文件。四、应用介绍

1、

新建ini配置文件〔保存于系统目录下〕，如wincc.ini。注意组中定义的变量名称必须存在于OPCServer中！右边//后的内容仅