uopcgroup.pas

delphi 开发OPc工业通讯 delphi 开发OPc工业通讯

//******************************************************************************
// sOPC created by ACHAT SOLUTIONS GmbH, http://www.achat-solutions.de/
//******************************************************************************
unit uOPCGroup;

{$IFDEF VER150}
{$WARN UNSAFE_CAST OFF}
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_TYPE OFF}
{$ENDIF}

interface

uses
  Windows, ActiveX, ComObj, SysUtils, Dialogs, Classes, Axctrls, Forms, SyncObjs,
  uTimer, OPCtypes, OPCDA, OpcError, sOPC_TLB, uGlobals, uOPCNode, uOPCItem;

type
  sOPCGroup = class(
    TTypedComObject,
    IOPCGroup,
    IOPCItemMgt,
    IOPCGroupStateMgt,
    IOPCPublicGroupStateMgt,
    IOPCSyncIO,
    IConnectionPointContainer,
    IOPCAsyncIO2)

  protected
    FCriticalSection: TCriticalSection;
    FName: string;
    FActive: boolean;
    FRequestedUpdateRate: DWORD;
    FClientGroup: OPCHANDLE;
    FTimeBias: longint;
    FPercentDeadband: single;
    FLCID: DWORD;
    FServerGroup: OPCHANDLE;
    FDataAccess: TObject;              // OPC Data Access
    FPublicGroupFlag: boolean;         // True -> group is public
    FOPCLock: boolean;                 // OPC function calls are locked

    FOPCItemList: TList;
    AsyncIOList: TList;
    CallBackEnabled: boolean;

    FConnectionPoints: TConnectionPoints;
    FConnectionPoint: TConnectionPoint;
    FConnectEvent: TConnectEvent;
    FClientIUnknown: IUnknown;
    FDataCallback: pointer;
    FGroupForm: TForm;
    FGroupThread: TThread;
    FTimer: sTimer;
    FEvaluationTimer: sTimer;

    // IOPCItemMgt
    function AddItems(dwCount: DWORD; pItemArray: POPCITEMDEFARRAY;
      out ppAddResults: POPCITEMRESULTARRAY; out ppErrors: PResultList): HResult; stdcall;

    function ValidateItems(dwCount: DWORD; pItemArray: POPCITEMDEFARRAY; bBlobUpdate: BOOL;
      out ppValidationResults: POPCITEMRESULTARRAY; out ppErrors: PResultList): HResult; stdcall;

    function RemoveItems(dwCount: DWORD; phServer: POPCHANDLEARRAY;
      out ppErrors: PResultList): HResult; stdcall;

    function SetActiveState(dwCount: DWORD; phServer: POPCHANDLEARRAY; bActive: BOOL;
      out ppErrors: PResultList): HResult; stdcall;

    function SetClientHandles(dwCount: DWORD; phServer: POPCHANDLEARRAY; phClient: POPCHANDLEARRAY;
      out ppErrors: PResultList): HResult; stdcall;

    function SetDatatypes(dwCount: DWORD; phServer: POPCHANDLEARRAY;
      pRequestedDatatypes: PVarTypeList; out ppErrors: PResultList): HResult; stdcall;

    function CreateEnumerator(const riid: TIID; out ppUnk: IUnknown): HResult; stdcall;

    // IOPCGroupStateMgt
    function GetState(out pUpdateRate: DWORD; out pActive: BOOL; out ppName: POleStr;
      out pTimeBias: Longint; out pPercentDeadband: Single; out pLCID: TLCID;
      out phClientGroup: OPCHANDLE; out phServerGroup: OPCHANDLE): HResult; overload; stdcall;

    function SetState(pRequestedUpdateRate: PDWORD; out pRevisedUpdateRate: DWORD; pActive: PBOOL;
      pTimeBias: PLongint; pPercentDeadband: PSingle; pLCID: PLCID;
      phClientGroup: POPCHANDLE): HResult; stdcall;

    function SetName(szName: POleStr): HResult; stdcall;

    function CloneGroup(szName: POleStr; const riid: TIID; out ppUnk:IUnknown): HResult; stdcall;

    // IOPCPublicGroupStateMgt
    function GetState(out pPublic: BOOL): HResult; overload; stdcall;

    function MoveToPublic: HResult; stdcall;

    // IOPCSyncIO
    function Read(dwSource: OPCDATASOURCE; dwCount: DWORD; phServer: POPCHANDLEARRAY;
      out ppItemValues: POPCITEMSTATEARRAY; out ppErrors: PResultList): HResult; overload; stdcall;

    function Write(dwCount: DWORD; phServer: POPCHANDLEARRAY; pItemValues: POleVariantArray;
      out ppErrors: PResultList): HResult; overload; stdcall;

    // IOPCAsyncIO2
    function Read(dwCount: DWORD; phServer: POPCHANDLEARRAY; dwTransactionID: DWORD;
      out pdwCancelID: DWORD; out ppErrors: PResultList): HResult; overload; stdcall;

    function Write(dwCount: DWORD; phServer: POPCHANDLEARRAY; pItemValues: POleVariantArray;
      dwTransactionID: DWORD; out pdwCancelID: DWORD; out ppErrors: PResultList):
      HResult; overload; stdcall;

    function Refresh2(dwSource: OPCDATASOURCE; dwTransactionID: DWORD;
      out pdwCancelID: DWORD): HResult; stdcall;

    function Cancel2(dwCancelID:DWORD): HResult; stdcall;

    function SetEnable(bEnable: BOOL):HResult; stdcall;

    function GetEnable(out pbEnable: BOOL): HResult; stdcall;

    // IConnectionPointContainer
    function EnumConnectionPoints(out Enum: IEnumConnectionPoints): HResult; stdcall;

    function FindConnectionPoint(const iid: TIID; out cp: IConnectionPoint): HResult; stdcall;

    procedure ConnectEvent(const Sink: IUnknown; Connecting: Boolean);

    procedure SetRequestedUpdateRate(UpdateRate: DWORD);

    procedure EnterCriticalSection;
    procedure LeaveCriticalSection;

  public
    constructor Create(Server: TObject);

    destructor Destroy; override;

    procedure Initialize; override;

    procedure Timer; virtual;

    procedure Init(szName: string; bActive: BOOL; dwRequestedUpdateRate: DWORD;
      hClientGroup: OPCHANDLE; pTimeBias: PLongint; pPercentDeadband: PSingle;
      dwLCID: DWORD); virtual;

    function GetOPCItem(hServer: OPCHANDLE; var ix: integer): sOPCItem;

    property Name: string read FName;
    property ClientIUnknown: IUnknown read FClientIUnknown;
    property ClientGroup: OPCHANDLE read FClientGroup;
    property OPCItemList: TList read FOPCItemList;
    property ServerGroup: OPCHANDLE read FServerGroup;
    property RequestedUpdateRate: DWORD read FRequestedUpdateRate;
    property PublicGroup: boolean read FPublicGroupFlag write FPublicGroupFlag;
    property DataCallback: pointer read FDataCallback;
    property DataAccess: TObject read FDataAccess;
    property OPCLock: boolean read FOPCLock write FOPCLock;

  end;

implementation

uses
  ComServ,
  uOPC, uOPCAsyncIO2, uOPCItemEnumerator, uOPCDataAccess, uGroupForm;

const
  GroupThread: boolean = True;

//******************************************************************************
// sGroupThread
//******************************************************************************
type
  sGroupThread = class(TThread)
    FOPCGroup: sOPCGroup;
    procedure Execute; override;
  end;

procedure sGroupThread.Execute;
begin
  while not Terminated do begin
    Sleep(20);
    FOPCGroup.Timer;
  end;
end;

//******************************************************************************
// IOPCItemMgt
//******************************************************************************
function sOPCGroup.AddItems(dwCount: DWORD; pItemArray: POPCITEMDEFARRAY;
  out ppAddResults: POPCITEMRESULTARRAY; out ppErrors: PResultList): HResult; stdcall;
var
  i: integer;
  OPCItem: sOPCItem;
  OPCNode: sOPCNode;
  ItemDef: POPCITEMDEF;
begin
  ppAddResults := TaskMemAlloc(dwCount, mkItemResult, Result);
  ppErrors := TaskMemAlloc(dwCount, mkHResult, Result);
  if (ppAddResults = nil) or (ppErrors = nil) then begin
    TaskMemFree(ppAddResults);
    TaskMemFree(ppErrors);
    exit;
  end;

  EnterCriticalSection;
  try
    Result := S_OK;
    for i := 0 to dwCount - 1 do begin
      ItemDef := @POPCITEMDEFARRAY(@pItemArray^)[i];

      OPCNode := OPC.GetOPCNode(ItemDef.szItemID);
      if OPCNode = nil then begin
        Result := S_FALSE;
        ppErrors[i] := OPC_E_UNKNOWNITEMID;
        continue;
      end;

      // create and initialize OPCItem
      OPCItem := sOPCItem.Create(OPCNode);
      OPCItem.AccessPath := ItemDef.szAccessPath;
      OPCItem.Active := ItemDef.bActive;
      OPCItem.ClientHandle := ItemDef.hClient;
      if OPCItem.SetRequestedDataType(ItemDef.vtRequestedDataType) then begin
        ppErrors[i] := S_OK;
      end else begin
        ppErrors[i] := OPC_E_BADTYPE;
        Result := S_FALSE;
      end;
      // start FTimer, when first OPCItem is added
      if FOPCItemList.Count = 0 then FTimer.Start;
      FOPCItemList.Add(OPCItem);

      // set Results
      ppAddResults[i].hServer := OPCItem.ServerHandle;
      ppAddResults[i].vtCanonicalDataType := OPCNode.vtCanonicalDataType;
      ppAddResults[i].dwAccessRights := OPCNode.dwAccessRights;
      ppAddResults[i].dwBlobSize := OPCNode.dwBlobSize;
      ppAddResults[i].pBlob := OPCNode.pBlob;
    end;
  finally
    LeaveCriticalSection;
  end;
end;

function sOPCGroup.ValidateItems(dwCount: DWORD; pItemArray: POPCITEMDEFARRAY;
  bBlobUpdate: BOOL; out ppValidationResults: POPCITEMRESULTARRAY;
  out ppErrors: PResultList): HResult; stdcall;
var
  i: integer;
  OPCNode: sOPCNode;
  ItemDef: POPCITEMDEF;
begin
  ppValidationResults := TaskMemAlloc(dwCount, mkItemResult, Result);
  ppErrors := TaskMemAlloc(dwCount, mkHResult, Result);
  if (ppValidationResults = nil) or (ppErrors = nil) then begin
    TaskMemFree(ppValidationResults);
    TaskMemFree(ppErrors);
    exit;
  end;

  Result := S_OK;
  for i := 0 to dwCount - 1 do begin
    ItemDef := @POPCITEMDEFARRAY(@pItemArray^)[i];

    OPCNode := OPC.GetOPCNode(ItemDef.szItemID);
    if OPCNode = nil then begin
      Result := S_FALSE;
      ppErrors[i] := OPC_E_UNKNOWNITEMID;
      continue;
    end;

    ppValidationResults[i].vtCanonicalDataType := OPCNode.vtCanonicalDataType;
    ppValidationResults[i].dwAccessRights := OPCNode.dwAccessRights;
    if bBlobUpdate then begin
      ppValidationResults[i].dwBlobSize := OPCNode.dwBlobSize;
      ppValidationResults[i].pBlob := OPCNode.pBlob;
    end;
    ppErrors[i] := S_OK;
  end;
end;

function sOPCGroup.RemoveItems(dwCount: DWORD; phServer: POPCHANDLEARRAY;
  out ppErrors: PResultList): HResult; stdcall;
var
  i, ix: integer;
  OPCItem: sOPCItem;
begin
  ppErrors := TaskMemAlloc(dwCount, mkHResult, Result);
  if ppErrors = nil then exit;
  EnterCriticalSection;
  try
    Result := S_OK;
    for i := 0 to dwCount - 1 do begin
      OPCItem := GetOPCItem(POPCHANDLEARRAY(@phServer^)[i], ix);
      if OPCItem <> nil then begin
        FOPCItemList.Delete(ix);
        // stop FTimer, when last OPCItem is removed
        if FOPCItemList.Count = 0 then FTimer.Stop;
        OPCItem.Free;
        ppErrors[i] := S_OK;
      end else begin
        Result := S_FALSE;
        ppErrors[i] := OPC_E_INVALIDHANDLE;
      end;
    end;
  finally
    LeaveCriticalSection;
  end;
end;

function sOPCGroup.SetActiveState(dwCount: DWORD; phServer: POPCHANDLEARRAY;
  bActive: BOOL; out ppErrors: PResultList): HResult; stdcall;
var
  i, ix: integer;
  OPCItem: sOPCItem;
begin
  ppErrors := TaskMemAlloc(dwCount, mkHResult, Result);
  if ppErrors = nil then exit;
  Result := S_OK;
  for i := 0 to dwCount - 1 do begin
    OPCItem := GetOPCItem(POPCHANDLEARRAY(@phServer^)[i], ix);
    if OPCItem <> nil then begin
      OPCItem.Active := bActive;
      ppErrors[i] := S_OK;
    end else begin
      Result := S_FALSE;
      ppErrors[i] := OPC_E_INVALIDHANDLE;
    end;
  end;
end;

function sOPCGroup.SetClientHandles(dwCount: DWORD; phServer: POPCHANDLEARRAY;
  phClient: POPCHANDLEARRAY; out ppErrors: PResultList): HResult; stdcall;
var
  i, ix: integer;
  OPCItem: sOPCItem;
begin
  ppErrors := TaskMemAlloc(dwCount, mkHResult, Result);
  if ppErrors = nil then exit;
  Result := S_OK;
  for i := 0 to dwCount - 1 do begin
    OPCItem := GetOPCItem(POPCHANDLEARRAY(@phServer^)[i], ix);
    if OPCItem <> nil then begin
      OPCItem.ClientHandle := POPCHANDLEARRAY(@phClient^)[i];
      ppErrors[i] := S_OK;
    end else begin
      Result := S_FALSE;
      ppErrors[i] := OPC_E_INVALIDHANDLE;
    end;
  end;
end;

function sOPCGroup.SetDatatypes(dwCount: DWORD; phServer: POPCHANDLEARRAY;
  pRequestedDatatypes: PVarTypeList; out ppErrors: PResultList): HResult; stdcall;
var
  i, ix: integer;
  OPCItem: sOPCItem;
begin
  ppErrors := TaskMemAlloc(dwCount, mkHResult, Result);
  if ppErrors = nil then exit;
  Result := S_OK;
  for i := 0 to dwCount - 1 do begin
    OPCItem := GetOPCItem(POPCHANDLEARRAY(@phServer^)[i], ix);
    if OPCItem <> nil then begin
      if OPCItem.SetRequestedDataType(PVarTypeList(@pRequestedDatatypes^)[i])
        then ppErrors[i] := S_OK
        else ppErrors[i] := OPC_E_BADTYPE;
    end else begin
      Result := S_FALSE;
      ppErrors[i] := OPC_E_INVALIDHANDLE;
    end;
  end;
end;

function sOPCGroup.CreateEnumerator(const riid: TIID; out ppUnk: IUnknown): HResult; stdcall;
begin
  Result := S_OK;
  if (FOPCItemList = nil) or (FOPCItemList.Count = 0) then begin
    Result := S_FALSE;
    exit;
  end;
  ppUnk := sOPCItemEnumerator.Create(FOPCItemList);
end;

//******************************************************************************
// IOPCGroupStateMgt
//******************************************************************************
function sOPCGroup.GetState(out pUpdateRate: DWORD; out pActive: BOOL;
  out ppName: POleStr; out pTimeBias: Longint; out pPercentDeadband: Single;
  out pLCID: TLCID; out phClientGroup: OPCHANDLE; out phServerGroup: OPCHANDLE)
  :HResult; stdcall;
begin
  pUpdateRate := FRequestedUpdateRate;
  pActive := FActive;
  ppName := StringToLPOLESTR(FName);
  pTimeBias := FTimeBias;
  pPercentDeadband := FPercentDeadband;
  pLCID := FLCID;
  phClientGroup := FClientGroup;
  phServerGroup := FServerGroup;
  Result := S_OK;
end;

function sOPCGroup.SetState(pRequestedUpdateRate: PDWORD; out pRevisedUpdateRate: DWORD;
  pActive: PBOOL; pTimeBias: PLongint; pPercentDeadband: PSingle; pLCID: PLCID;
  phClientGroup: POPCHANDLE): HResult; stdcall;
begin
  if Assigned(pRequestedUpdateRate) then SetRequestedUpdateRate(pRequestedUpdateRate^);
  if Assigned(pActive)              then FActive := pActive^;
  if Assigned(pTimeBias)            then FTimeBias := pTimeBias^;
  if Assigned(pPercentDeadband)     then FPercentDeadband := pPercentDeadband^;
  if Assigned(pLCID)                then FLCID := pLCID^;
  if Assigned(phClientGroup)        then FClientGroup := phClientGroup^;
  // return the closest update rate the server is able to provide for this group
  if (@pRevisedUpdateRate <> nil)   then pRevisedUpdateRate := FRequestedUpdateRate;
  Result := S_OK;
end;

function sOPCGroup.SetName(szName: POleStr): HResult; stdcall;
begin
  FName := szName;
  Result := S_OK;
end;

function sOPCGroup.CloneGroup(szName: POleStr; const riid: TIID;
  out ppUnk: IUnknown): HResult; stdcall;
var
  newName: string;
  i: integer;
  OPCGroup: sOPCGroup;
  coi, OPCItem: sOPCItem;
begin
  if not (IsEqualIID(riid, IID_IOPCItemMgt) or IsEqualIID(riid, IID_IUnknown))
  then begin