⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 opcdefine.pas

📁 OPCserver OPCserver.rar
💻 PAS
字号:
unit opcdefine;

interface

uses Windows,ActiveX;

var

  lpOPCClsID : string= '{75B23DD4-E68C-402f-9E55-16B5EDA0E2A8}';
  lpOPCProgID : string='TLSvrRDK.OPCTOOLKIT.2.D5';
  lpOPCDescr : string='Tuo Lin RDK by Delphi5';
  sOpcExeName:string;
  //最大点数
  const MaxCounts = 1000 ;
type
  Tag =record
	    m_sTagName:string; //tagname
	    m_sDescr :string ; //Description
	    m_hHWND :Thandle; //Handle
	    m_vType :TVarType; //type
	    m_lQuality :WORD ; //Quality
	    m_ft : TFileTime ; // timestamp
	    m_vValue :OleVariant; //value
   End ;

  TagList = array[0..MaxCounts] of Tag;
  PTagList = ^TagList;


type
  OPCSERVERSTATE = TOleEnum;
const
  OPC_STATUS_RUNNING   = 1;
  OPC_STATUS_FAILED    = 2;
  OPC_STATUS_NOCONFIG  = 3;
  OPC_STATUS_SUSPENDED = 4;
  OPC_STATUS_TEST      = 5;

// *********************************************************************//
// OPC Quality flags                                                    //
// *********************************************************************//
// Masks for extracting quality subfields
// (note 'status' mask also includes 'Quality' bits)
  OPC_QUALITY_MASK           = $C0;
  OPC_STATUS_MASK            = $FC;
  OPC_LIMIT_MASK             = $03;

// Values for QUALITY_MASK bit field
  OPC_QUALITY_BAD            = $00;
  OPC_QUALITY_UNCERTAIN      = $40;
  OPC_QUALITY_GOOD           = $C0;

// STATUS_MASK Values for Quality = BAD
  OPC_QUALITY_CONFIG_ERROR   = $04;
  OPC_QUALITY_NOT_CONNECTED  = $08;
  OPC_QUALITY_DEVICE_FAILURE = $0C;
  OPC_QUALITY_SENSOR_FAILURE = $10;
  OPC_QUALITY_LAST_KNOWN     = $14;
  OPC_QUALITY_COMM_FAILURE   = $18;
  OPC_QUALITY_OUT_OF_SERVICE = $1C;

// STATUS_MASK Values for Quality = UNCERTAIN
  OPC_QUALITY_LAST_USABLE    = $44;
  OPC_QUALITY_SENSOR_CAL     = $50;
  OPC_QUALITY_EGU_EXCEEDED   = $54;
  OPC_QUALITY_SUB_NORMAL     = $58;

// STATUS_MASK Values for Quality = GOOD
  OPC_QUALITY_LOCAL_OVERRIDE = $D8;

type
  WRITENOTIFYPROC = procedure( hTagHandle :THandle; pNewValue: PVARIANT;pDeviceError: PDWORD); stdcall;
  DISCONNECTPROC = procedure(dwNum: DWORD); stdcall;
  DEVICEREADPROC=  procedure( hTagHandle :THandle; lpValue :PVARIANT; lpQuality :PDWORD; lpTimeStamp :PFileTime);stdcall;

  //Init

//初始化OPC Server
//static const GUID pCLSID =
//{ 0x90ca4f34, 0xb61a, 0x4e29, { 0x8d, 0xc6, 0xb6, 0xde, 0xf4, 0x1b, 0x25, 0xbd } }
 
function TL_InitOpcServer ( pCLSID :LPCSTR; uServerRate :UINT):BOOL;stdcall;external 'TLSvrRdk.dll';

//const LPSTR lpCLSID = "{90CA4F34-B61A-4e29-8DC6-B6DEF41B25BD}"
function TL_InitOpcServerS ( lpCLSID :LPCSTR;  uServerRate :UINT) :BOOL;stdcall;external 'TLSvrRdk.dll';

//请求断开所有的客户端程序 
procedure TL_RequestAllDisconnect();stdcall;external 'TLSvrRdk.dll';
//结束
  procedure TL_UnInitOpcServer ();stdcall;external 'TLSvrRdk.dll';

//Tag

//添加点,如不成功返值为0
  function TL_CreateTag   ( lpName :LPCSTR;  Value :VARIANT;  wInitialQuality :WORD;
              isWrite :BOOL) :THandle;stdcall;external 'TLSvrRdk.dll';

// 可设定点的各种属性详见DA 2.04 中的 41页 4.4.6 节
  function TL_SetTagProperties   ( hTagHandle :THandle; dwPropertyID :DWORD; lpDescription :LPCSTR; Value :VARIANT) :BOOL;stdcall;external 'TLSvrRdk.dll';


//删除点
  function TL_RemoveTag   ( hTagHandle :THandle) :BOOL;stdcall;external 'TLSvrRdk.dll';

//该函数读取点的值
  function TL_ReadTag   ( hTagHandle :THandle;pValue :PVARIANT ):BOOL;stdcall;external 'TLSvrRdk.dll';

//该函数读取带时标的点的值
  function TL_ReadTagWithTimeStamp   ( hTagHandle :THandle;pValue :PVARIANT;pQuality :PWORD; pTimestamp :TFileTime) :BOOL;stdcall;external 'TLSvrRdk.dll';

// 刷新点
  function TL_UpdateTag   (hTagHandle :THandle;  Value :VARIANT; Quality :WORD) :BOOL;stdcall;external 'TLSvrRdk.dll';

//按名称刷新点
  function TL_UpdateTagByName   ( lpName :LPCSTR; Value :VARIANT; wQuality :WORD) :BOOL;stdcall;external 'TLSvrRdk.dll';

// 带时标刷新点
  function TL_UpdateTagWithTimeStamp   ( hTagHandle :THandle;  Value :Variant;  Quality :Integer;  timestamp :TFileTime) :BOOL;stdcall;external 'TLSvrRdk.dll';

//取当前激活的客户端个数
  function TL_GetClientCounts   () :Integer;stdcall;external 'TLSvrRdk.dll';

//设定hash 表大小,如果大于0则表示内部查找点使用 hash 算法.
 function TL_SetHashSize (ulHashSize: Longword	) :Longword	;stdcall;external 'TLSvrRdk.dll';
 
//当成NT Server 一样运行
  function TL_AsNTService   ( lpSvrName :LPCSTR) :BOOL;stdcall;external 'TLSvrRdk.dll';
  function TL_SetupRegCode  ( lpSetupRegCode :LPCSTR) :BOOL;stdcall;external 'TLSvrRdk.dll';




//注册OPC Server

//static const GUID pCLSID =
//{ 0x90ca4f34, 0xb61a, 0x4e29, { 0x8d, 0xc6, 0xb6, 0xde, 0xf4, 0x1b, 0x25, 0xbd } }

  function TL_Registry   ( pCLSID :LPCSTR;  lpSvrName :LPCSTR;  lpDescr :LPCSTR;  lpExepath :LPCSTR) :BOOL;stdcall;external 'TLSvrRdk.dll';
//const LPSTR lpCLSID = "{90CA4F34-B61A-4e29-8DC6-B6DEF41B25BD}"
  function TL_RegistryS   ( lpCLSID :LPCSTR;  lpSvrName :LPCSTR;  lpDescr :LPCSTR;  lpExepath :LPCSTR) :BOOL;stdcall;external 'TLSvrRdk.dll';

//反注册OPC Server
//static const GUID pCLSID =
//{ 0x90ca4f34, 0xb61a, 0x4e29, { 0x8d, 0xc6, 0xb6, 0xde, 0xf4, 0x1b, 0x25, 0xbd } }
  function TL_Unregister   (pCLSID :LPCSTR;  lpSvrName :LPCSTR) :BOOL;stdcall;external 'TLSvrRdk.dll';

//const LPSTR lpCLSID = "{90CA4F34-B61A-4e29-8DC6-B6DEF41B25BD}"
  function TL_UnregisterS   ( lpCLSID :LPCSTR;  lpSvrName :LPCSTR) :BOOL;stdcall;external 'TLSvrRdk.dll';



//Server State

//区分点名称大小写
  function TL_SetMatchCase   ( bModelFlag :BOOL) :BOOL;stdcall;external 'TLSvrRdk.dll';

//  该函数用来设置服务器的运行状态。默认值为OPC_STATUS_RUNNING
  procedure TL_SetServerState   ( sServerState :OPCSERVERSTATE);stdcall;external 'TLSvrRdk.dll';

//该函数用来设置服务器主版本号。默认为零
  procedure TL_SetMajorVersion   ( wMajorVersion :Integer);stdcall;external 'TLSvrRdk.dll';

//该函数用来设置服务器副版本号。默认为零
  procedure TL_SetMinorVersion   ( wMinorVersion :Integer);stdcall;external 'TLSvrRdk.dll';

//该函数用来设置服务器版本创建号。默认为零。
  procedure TL_SetBuildNumber   ( wBuildNumber :Integer);stdcall;external 'TLSvrRdk.dll';

//该函数用来设置服务器厂商信息。默认为TL SoftWare
  procedure TL_SetVendorInfo   ( lpVendorInfo :LPCSTR);stdcall;external 'TLSvrRdk.dll';
//该函数用来设置服务器的带宽。默认值为0x0
  procedure TL_SetBandWidth   ( dwBandWidth :DWORD);stdcall;external 'TLSvrRdk.dll';  
  function TL_SetQualifier ( cQualifier:char) :char;stdcall;external 'TLSvrRdk.dll';
//CALL BACK
//该函数注册客户端断开回调函数,当有客户端从设备断开时,调用
//EnableDisconnectNotification注册的函数

  function TL_EnableDisconnectNotification   ( lpCallback :DISCONNECTPROC) :BOOL;stdcall;external 'TLSvrRdk.dll';

//注册该函数后,当有客户端从服务器断开,通过注册的函数通知
//用户。当dwNum为零时,服务器程序可以退出

// procedure DisconnectProc  (dwNum:DWORD);stdcall;


//该函数用来注册读设备回调函数
  function TL_EnableDeviceRead   ( lpCallback :DEVICEREADPROC) :BOOL;stdcall;external 'TLSvrRdk.dll';

//如果不注册该函数,服务器将把所有的读设备请求转换为读缓存
//请求。注册的DEVICEREADPROC函数应该支持多线程。
// procedure DeviceReadProc   (hTagHandle :THandle;  lpValue:PVARIANT;
  //            lpQuality:PWORD ,  lpTimeStamp:PFILETIME);stdcall;




//该函数用来注册写回调函数。如果添加了可写标签,则应该注册写回调函数。
 function TL_EnableWriteNotification   ( lpCallback :WRITENOTIFYPROC ) :BOOL;stdcall;external 'TLSvrRdk.dll';

//如果不注册该函数,OPC服务器将对所有的客户端写请求返回
//错误。OPC 运行库保证向WRITENOTIFYPROC传递的新值能
//够转换为用户指定的标准数据类型,如果用户指定了一个模拟量
//标签的上下限(详见OPC DA 2.04规范4.4.6),OPC 运行库保
//证向WRITENOTIFYPROC传递的新值在上下限范围之内。注册
//的WRITENOTIFYPROC函数应该支持多线程。

procedure DisconnectProcCallback( dwNum :DWORD);stdcall;

procedure DeviceReadProcCallback(hTagHandle :THandle; lpValue :PVARIANT; lpQuality :PDWORD;
      lpTimeStamp :PFileTime);stdcall;

procedure WriteNotifyCallback( hTagHandle :THandle; pNewValue :PVARIANT;
      pDeviceError :PDWORD);stdcall;


implementation

//如果不注册该函数,服务器将把所有的读设备请求转换为读缓存
//请求。注册的DEVICEREADPROC函数应该支持多线程。

procedure DeviceReadProcCallback(hTagHandle :THandle; lpValue :PVARIANT; lpQuality :PDWORD;
      lpTimeStamp :PFileTime);stdcall;
begin

end;


//注册该函数后,当有客户端从服务器断开,通过注册的函数通知
//用户。当dwNum为零时,服务器程序可以退出
procedure DisconnectProcCallback( dwNum :DWORD);stdcall;
begin
//    If dwNum = 0 Then

//    End If
end;

//如果不注册该函数,OPC服务器将对所有的客户端写请求返回
//错误。OPC 运行库保证向WRITENOTIFYPROC传递的新值能
//够转换为用户指定的标准数据类型,如果用户指定了一个模拟量
//标签的上下限(详见OPC DA 2.04规范4.4.6),OPC 运行库保
//证向WRITENOTIFYPROC传递的新值在上下限范围之内。注册
//的WRITENOTIFYPROC函数应该支持多线程。


procedure WriteNotifyCallback( hTagHandle :THandle; pNewValue :PVARIANT; pDeviceError :PDWORD);stdcall;
begin
   //用于把客户端写入的数据通知Server

end; 
end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -