commu.pas

omroln OPC 用delphi描述了同OMROLnOPC通讯的过程

unit CommU;

interface
uses
  Windows, Messages, SysUtils, Classes, Controls, ComObj, ActiveX, ComCtrls,
  Variants, EventLogU, OPCCallback, OPCCOMN, OPCDA, OPCError;
  
const
  Const_RETURNCODE_SUCCESS = 0; //函数调用返回码－成功
  Const_RETURNCODE_FAILED = -1; //函数调用返回码－失败

  //设备操作状态
  Const_STATUS_DISCONNECT = $01; //未连接
  Const_STATUS_CONNECTED = $02; //已连接

  Const_ITEMSTATE_NORMAL = $00; //采集点正常
  Const_ITEMSTATE_ERROR = $FF; //采集点故障
  Const_ITEMSTATE_READ = $01; //采集点读取
  Const_ITEMSTATE_WRITE = $02; //采集点下发

type
  //存放OPC--Item数据项的记录
  TOPCItemInfo = record
    hOPCItem: OPCHANDLE; //OPC的数据项
    szOPCID: PWideChar; //OPC的名称
    vrRValue: Variant; //采集读取数据的内容
    vrWValue: Variant; //采集点下发数据的内容
    dtRTime: TDateTime; //采集数据的读取时间
    wStatus: Byte; //操作状态
  end;
  TOPCItemInfoArray = array of TOPCItemInfo;

  TOPCComm = class
  private
    FOPCServer: IOPCServer; //Interface IOPCServer
    FOPCItemMgt: IOPCItemMgt; //Interface IOPCItemMgt
    FOPCSyncIO: IOPCSyncIO; //Interface IOPCSyncIO
    FOPCAsyncIO: IOPCAsyncIO2; //Interface IOPCAsyncIO2
    FOPCGroup: OPCHANDLE; //Server Handle Group
    FOPCItemInfos: TOPCItemInfoArray; //存放OPC Item的各个数据项
    FOPCDataCallback: TOPCDataCallback; //Callback Object
    FConnectionPoint: IConnectionPoint; //Connection Point for Callback
    FCookie: Longint; //Cookie for Advise/Unadvise
    procedure DataRecv(Sender: TObject; ItemHandle: OPCHANDLE;
      ItemValue: Variant; ItemTime: TDateTime);
    //打开OPC的函数
    function Connect: Boolean;
    function AddGroup: Boolean;
    function AddItems: Boolean;
    function AdviseCallback: Boolean;

    //关闭OPC的函数
    procedure Disconnect;
    procedure RemoveGroup;
    procedure RemoveItems;
    procedure UnadviseCallback;
  private
    FLock: TRTLCriticalSection;
    FReadEvent: THandle;
    FMachineName: string; //OPC服务器的机器名称或IP地址
    FServerName: string; //OPC服务的名称
    FGroupName: string; //添加的组的名称
    FItemNum: Longint; //OPC数据项的数量
    FStatus: DWord; //端口操作状态
    function HaveItemState(const CurrState, ItemState: Byte): Boolean;
    function SetItemState(const CurrState, ItemState: Byte): Byte;
    function ClrItemState(const CurrState, ItemState: Byte): Byte;
  public
    constructor Create;
    destructor Destroy; override;
    function SetItems(const ItemNames: array of string): Boolean;
    function StartComm: Boolean;
    procedure StopComm;
    procedure QueryData(const ItemNames: array of string);
    procedure RefershData;
    function SendData(const ItemName: string; const Value: Variant): Boolean;
    function ReadData(var ItemName: string; var Value: Variant; var ReadTime: TDateTime): Boolean;
  published
    property MachineName: string read FMachineName write FMachineName;
    property ServerName: string read FServerName write FServerName;
    property GroupName: string read FGroupName write FGroupName;
    property ReadEvent: THandle read FReadEvent;
    property CommStatus: DWord read FStatus;
  end;
  
implementation

{*
 *                函数名称：DataRecv
 *                函数功能：数据到达通知处理函数
 *                入口参数：1、Sender: TObject
 *                          2、ItemHandle: OPCHANDLE
 *                          3、ItemValue: Variant
 *                          4、ItemTime: TDateTime;
 *                出口参数：无
 *                  返回值：无
 *}

procedure TOPCComm.DataRecv(Sender: TObject; ItemHandle: OPCHANDLE;
      ItemValue: Variant; ItemTime: TDateTime);
var
  I: Integer;
begin
  EnterCriticalSection(FLock);
  try
    for I := 0 to FItemNum - 1 do
    begin
      try
        if DWord(I + 1){FOPCItemInfos[I].hOPCItem} = ItemHandle then
        begin
          FOPCItemInfos[I].vrRValue := ItemValue;
          FOPCItemInfos[I].dtRTime := ItemTime;
          FOPCItemInfos[I].wStatus := SetItemState(FOPCItemInfos[I].wStatus, Const_ITEMSTATE_READ);
          SetEvent(FReadEvent);
          Break;
        end;
      except
        Continue;
      end;
    end;
  finally
    LeaveCriticalSection(FLock);
  end;
end;

{*
 *                函数名称：Connect
 *                函数功能：建立与OPC服务的连接
 *                入口参数：无
 *                出口参数：无
 *                  返回值：无
 *}

function TOPCComm.Connect: Boolean;
begin
  Result := False;
  try
    FOPCServer := CreateRemoteComObject(FMachineName, ProgIDToClassID(FServerName)) as IOPCServer;
  except
    FOPCServer := nil;
  end;
  if not Assigned(FOPCServer) then
  begin
    WriteDebugLog(Format('与OPC服务(%s)连接失败', [FServerName]));
    Exit;
  end;
  Result := True;
end;

{*
 *                函数名称：AddGroup
 *                函数功能：添加组对象
 *                入口参数：无
 *                出口参数：无
 *                  返回值：无
 *}

function TOPCComm.AddGroup: Boolean;
var
  HRes: HRESULT;
  Active: BOOL;
  PercentDeadBand: Single;
  UpdateRate, RevisedUpdateRate: DWORD;
begin
  Result := False;
  Active := TRUE;
  UpdateRate := 500;

  HRes := FOPCServer.AddGroup(
                     PWideChar(WideString(FGroupName)),   // Group Name from Edit Box
                     Active,               // Active State
                     UpdateRate,           // Requested Update Rate
                     0,                    // Client Handle Group
                     nil,                  // Time Bias
                     @PercentDeadBand,     // Percent Deadband
                     0,                    // Local ID
                     FOPCGroup,            // Server Handle Group
                     RevisedUpdateRate,    // Revised Update Rate
                     IOPCItemMgt,          // Requested Interface
                     IUnknown(FOPCItemMgt));  // Interface Pointer
  if Failed(HRes) then
  begin
    WriteDebugLog(Format('添加组对象(%s)失败', [FGroupName]));
    Exit;
  end;

  FOPCSyncIO := FOPCItemMgt as IOPCSyncIO;
  FOPCAsyncIO := FOPCItemMgt as IOPCAsyncIO2;
  Result := True;
end;

{*
 *                函数名称：AdviseCallback
 *                函数功能：建立回调连接电
 *                入口参数：无
 *                出口参数：无
 *                  返回值：无
 *}

function TOPCComm.AdviseCallback: Boolean;
var
  HRes: HRESULT;
  pIConnectionPointContainer: IConnectionPointContainer;
begin
  Result := False;
  
  try
    pIConnectionPointContainer := FOPCItemMgt as IConnectionPointContainer;
  except
    pIConnectionPointContainer := nil;
    Exit;
  end;

  //创建回调对象
  FOPCDataCallback := TOPCDataCallback.Create;
  FOPCDataCallback.OnDataRecvEvent := DataRecv;

  //获得回调接口的连接点接口
  HRes := pIConnectionPointContainer.FindConnectionPoint(
             IID_IOPCDataCallback, FConnectionPoint);

  if Failed(HRes) then
  begin
    WriteDebugLog('查找IOPCDataCallback接口的连接点失败');
    FOPCDataCallback := nil;
    Exit;
  end;

  HRes := FConnectionPoint.Advise(FOPCDataCallback as IUnknown, FCookie);
  if Failed(HRes) then
  begin
    WriteDebugLog('申请回调的连接失败');
    FOPCDataCallback := nil;
    FConnectionPoint := nil;
    Exit;
  end;
  Result := True;
end;

{*
 *                函数名称：AddItems
 *                函数功能：向组对象中添加采集点
 *                入口参数：无
 *                出口参数：无
 *                  返回值：无
 *}

function TOPCComm.AddItems: Boolean;
var
  I: Integer;
  HRes: HRESULT;
  ItemDef: array of OPCITEMDEF;
  Results: POPCITEMRESULTARRAY;
  Errors: PResultList;
begin
  Result := False;
  
  SetLength(ItemDef, FItemNum);
  for I := 0 to FItemNum - 1 do
  begin
    with ItemDef[I] do
    begin
      szAccessPath := '';
      szItemID := FOPCItemInfos[I].szOPCID; //ItemID
      bActive := True; // Active -> TRUE to get DataChange Callbacks
      hClient := I + 1;  // Item Client Handle to identify the items at the DataChange Callback
      dwBlobSize := 0;
      pBlob := nil;
      vtRequestedDataType := VT_BSTR;  // VT_BSTR  -> Requested Data Type = String (BSTR)
                                       // VT_EMPTY -> Requested Data Type = Canonical Data Type
    end;
  end;

  //添加采集点
  HRes := FOPCItemMgt.AddItems(FItemNum, @ItemDef[0], Results, Errors);
  if Failed(HRes) then
  begin
    WriteDebugLog('不能向OPC组对象添加采集点');
    Exit;
  end;

  for I := 0 to FItemNum - 1 do
  begin
    if Failed(Errors[I]) then
    begin
      FOPCItemInfos[I].hOPCItem := 0;
      FOPCItemInfos[I].wStatus := Const_ITEMSTATE_ERROR;
      WriteDebugLog('添加一个采集点对象失败');
    end
    else begin
      FOPCItemInfos[I].wStatus := Const_ITEMSTATE_NORMAL;
      FOPCItemInfos[I].hOPCItem := Results[I].hServer;
    end;
    FOPCItemInfos[I].vrRValue := UnAssigned;
    FOPCItemInfos[I].vrWValue := UnAssigned;
    FOPCItemInfos[I].dtRTime := 0;
  end;

  CoTaskMemFree(Results);
  CoTaskMemFree(Errors);
  ItemDef := nil;
  Result := True;
end;

{*
 *                函数名称：RemoveGroup
 *                函数功能：删除所有添加的组
 *                入口参数：无
 *                出口参数：无
 *                  返回值：无
 *}

procedure TOPCComm.RemoveGroup;
var
  HRes: HRESULT;
begin
  if Assigned(FConnectionPoint) then
    UnadviseCallback;

  FOPCItemMgt := nil;
  FOPCSyncIO := nil;

  HRes := FOPCServer.RemoveGroup(FOPCGroup, TRUE);
  if Failed(HRes) then
  begin
    WriteDebugLog(Format('不能从OPC服务(%s)连接中删除采集点组对象(%s)', [FServerName, FGroupName]));
    Exit;
  end;
end;

{*
 *                函数名称：RemoveItems
 *                函数功能：删除所有已连接的采集点
 *                入口参数：无
 *                出口参数：无
 *                  返回值：无
 *}

procedure TOPCComm.RemoveItems;
var
  I: Integer;
  HRes: HRESULT;
  Errors: PResultList;
  Items: array of OPCHANDLE;
begin
  SetLength(Items, FItemNum);
  for I := 0 to FItemNum - 1 do
    Items[I] := FOPCItemInfos[I].hOPCItem;

  HRes := FOPCItemMgt.RemoveItems(FItemNum, @Items[0], Errors);
  if Failed(HRes) then
  begin
    WriteDebugLog(Format('不能从OPC组(%s)中删除采集点', [FGroupName]));
    Exit;
  end;
  CoTaskMemFree(Errors);
end;

{*
 *                函数名称：UnadviseCallback
 *                函数功能：解除回调连接
 *                入口参数：无
 *                出口参数：无
 *                  返回值：无
 *}

procedure TOPCComm.UnadviseCallback;
var
  HRes: HRESULT;
begin
  if Assigned(FConnectionPoint) then
  begin
    HRes := FConnectionPoint.Unadvise(FCookie);
    if Failed(HRes) then
      WriteDebugLog('解除回调连接失败');
  end;

  FOPCDataCallback := nil;
  FConnectionPoint := nil;
end;

{*