groupunit.pas

delphi2007 opcserver

unit GroupUnit;

interface

uses Windows,ActiveX,ComObj,FirstServ_TLB,SysUtils,Dialogs,Classes,ServIMPL,OPCDA,axctrls,
     Globals,OpcError,OPCTypes, StdVcl;

type
  TOPCGroup = class(TTypedComObject,IOPCGroup,IOPCItemMgt,IOPCGroupStateMgt,
                    IOPCSyncIO,IConnectionPointContainer,IOPCAsyncIO2)
  private
   FIConnectionPoints:TConnectionPoints;
  protected
   property iFIConnectionPoints:TConnectionPoints read FIConnectionPoints
                          write FIConnectionPoints implements IConnectionPointContainer;
//IOPCItemMgt begin
   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;
//IOPCItemMgt end

//IOPCGroupStateMgt begin
   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;
//IOPCGroupStateMgt end

//IOPCSyncIO begin
   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;
//IOPCSyncIO end

//IOPCAsyncIO2 begin
   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;
//IOPCAsyncIO2 end
  public
   servObj:TDA2;                         //the owner
   tagName:string;                       //the name of this group
   clientHandle:longword;                //the client generates we pass to client
   serverHandle:longword;                //we generate the client will passes to us
   requestedUpdateRate:longword;         //update rate in mills
   lang:longword;                        //lanugage id
   nextUpdate:longword;

   ownList,clItems,asyncList:TList;
   groupActive,groupPublic,onDataChangeEnabled:longbool;
   timeBias:longint;
   percentDeadband:single;
   FOnCallBackConnect:TConnectEvent;
   ClientIUnknown:IUnknown;
   lastMSecUpdate:Comp;
   upStream:TMemoryStream;
   groupRemovedRequest:boolean;

   procedure Initialize; override;
   constructor Create(serv:TDA2;oList:TList);
   destructor Destroy;override;
   function ValidateRequestedUpDateRate(dwRequestedUpdateRate:DWORD):DWORD;
   procedure ValidateTimeBias(pTimeBias:PLongint);
   procedure SetUp(szName:string;bActive:BOOL; dwRequestedUpdateRate:DWORD;
                  hClientGroup:OPCHANDLE; pTimeBias:longint; pPercentDeadband:single;
                  dwLCID:DWORD;phServerGroup:longword);
   procedure CallBackOnConnect(const Sink: IUnknown; Connecting: Boolean);
   function GetItemIndexFromServerHandle(servHand:longword;var index:integer):boolean;
   function GetItemIndexFromClientHandle(clHand:longword;var index:integer):boolean;
   function GenerateAsyncCancelID:longword;
   procedure GroupActiveFromInactive;
   procedure TimeSlice(cTime:TDateTime);
   procedure CloneYourSelf(dGrp:TOPCGroup);
   procedure DoAChangeOccured(aStream:TMemoryStream; cTime:TDateTime);
   procedure AsyncTimeSlice(cTime:TDateTime);
  end;

implementation

uses ComServ,ItemsUnit,AsyncUnit,ItemAttributesOPC,EnumItemAtt,Main,Variants;

//IOPCItemMgt begin
function TOPCGroup.AddItems(dwCount:DWORD; pItemArray:POPCITEMDEFARRAY;
                     out ppAddResults:POPCITEMRESULTARRAY;
                     out ppErrors:PResultList):HResult;stdcall;
var
 i:integer;
 wItem:TOPCItem;
 propID:longword;
 memErr:boolean;
 inItemDef:POPCITEMDEF;
begin
 result:=S_OK;
 if (dwCount < 1) then
  begin
   result:=E_INVALIDARG;
   Exit;
  end;

 ppAddResults:=POPCITEMRESULTARRAY(CoTaskMemAlloc(dwCount*sizeof(OPCITEMRESULT)));
 memErr:=boolean(ppAddResults = nil);

 if not memErr then
  begin
   ppErrors:=PResultList(CoTaskMemAlloc(dwCount*sizeof(HRESULT)));
   memErr:=boolean(ppErrors = nil);
  end;

 if memErr then
  begin
   if (ppAddResults <> nil) then
    CoTaskMemFree(ppAddResults);
   if (ppErrors <> nil) then
    CoTaskMemFree(ppErrors);
   result:=E_OUTOFMEMORY;
   Exit;
  end;

 FillChar(ppAddResults[0], dwCount * sizeOf(OPCITEMRESULT),#0);

 for i:= 0 to dwCount - 1 do
  begin
   ppErrors[i]:=S_OK;
   inItemDef:=@pItemArray[i];

   if length(inItemDef.szItemID) = 0 then
    begin
     result:=S_FALSE;
     ppErrors[i]:=OPC_E_INVALIDITEMID;
     Continue;
    end;

   propID:=ReturnPropIDFromTagname(inItemDef.szItemID);

   if (propID = 0) then
    begin
     result:=S_FALSE;
     ppErrors[i]:=OPC_E_UNKNOWNITEMID;
     Continue;
    end;

   if not IsVariantTypeOK(inItemDef.vtRequestedDataType) then
    begin
     result:=S_FALSE;
     ppErrors[i]:=OPC_E_BADTYPE;
     Continue;
    end;

   wItem:=TOPCItem.Create;
   wItem.servObj:=servObj;
   clItems.Add(wItem);
   wItem.serverItemNum:=servObj.GetNewItemNumber;

   wItem.SetActiveState(inItemDef.bActive);
   wItem.SetClientHandle(inItemDef.hClient);
   wItem.itemIndex:=propID - posItems[low(posItems)].PropID;

   wItem.isWriteAble:=CanPropIDBeWritten(propID);

   wItem.canonicalDataType:=ReturnDataTypeFromPropID(propID);
   wItem.SetOldValue;

   wItem.SetReqDataType(inItemDef.vtRequestedDataType);
   wItem.strID:=inItemDef.szItemID;
   wItem.pBlob:=inItemDef.pBlob;

   ppAddResults[i].hServer:=wItem.serverItemNum;
   ppAddResults[i].vtCanonicalDataType:=wItem.canonicalDataType;

   if wItem.isWriteAble then
    ppAddResults[i].dwAccessRights:=OPC_READABLE or OPC_WRITEABLE
   else
    ppAddResults[i].dwAccessRights:=OPC_READABLE;

   ppAddResults[i].dwBlobSize:=0;
   ppAddResults[i].pBlob:=wItem.pBlob;
  end;
end;

function TOPCGroup.ValidateItems(dwCount:DWORD; pItemArray:POPCITEMDEFARRAY;bBlobUpdate:BOOL;
                   out ppValidationResults:POPCITEMRESULTARRAY;out ppErrors:PResultList):HResult; stdcall;
var
 i:integer;
 memErr:boolean;
 propID:longword;
 inItemDef:POPCITEMDEF;
begin
 if (dwCount < 1) then
  begin
   result:=E_INVALIDARG;
   Exit;
  end;

 ppValidationResults:=POPCITEMRESULTARRAY(CoTaskMemAlloc(dwCount * sizeof(OPCITEMRESULT)));
 memErr:=boolean(ppValidationResults = nil);

 if not memErr then
  begin
   ppErrors:=PResultList(CoTaskMemAlloc(dwCount*sizeof(HRESULT)));
   memErr:=boolean(ppErrors = nil);
  end;

 if memErr then
  begin
   if (ppValidationResults <> nil) then
    CoTaskMemFree(ppValidationResults);
   if (ppErrors <> nil) then
    CoTaskMemFree(ppErrors);
   result:=E_OUTOFMEMORY;
   Exit;
  end;

 result:=S_OK;
 FillChar(ppValidationResults[0], dwCount * sizeOf(OPCITEMRESULT),#0);

 for i:= 0 to dwCount - 1 do
  begin
   inItemDef:=@pItemArray[i];

   if (length(inItemDef.szItemID) = 0) then
    begin
     result:=S_FALSE;
     ppErrors[i]:=OPC_E_INVALIDITEMID;
     Continue;
    end;

   if not IsVariantTypeOK(inItemDef.vtRequestedDataType) then
    begin
     result:=S_FALSE;
     ppErrors[i]:=OPC_E_BADTYPE;
     Continue;
    end;

   propID:=ReturnPropIDFromTagname(inItemDef.szItemID);  //also cover 0 length
   if (propID = 0) then
    begin
     result:=S_FALSE;
     ppErrors[i]:=OPC_E_INVALIDITEMID;
     Continue;
    end;

   ppValidationResults[i].vtCanonicalDataType:=ReturnDataTypeFromPropID(propID);
   if CanPropIDBeWritten(propID) then
    ppValidationResults[i].dwAccessRights:=OPC_READABLE or OPC_WRITEABLE
   else
    ppValidationResults[i].dwAccessRights:=OPC_READABLE;
   ppValidationResults[i].dwBlobSize:=0;
   ppErrors[i]:=S_OK;
  end;
end;

function TOPCGroup.RemoveItems(dwCount:DWORD; phServer:POPCHANDLEARRAY; out ppErrors:PResultList):HResult; stdcall;
var
 i,x:integer;
 wItem:TOPCItem;
begin
 if dwCount < 1 then
  begin
   result:=E_INVALIDARG;
   Exit;
  end;

 ppErrors:=PResultList(CoTaskMemAlloc(dwCount*sizeof(HRESULT)));
 if ppErrors = nil then
  begin
   result:=E_OUTOFMEMORY;
   Exit;
  end;

 result:=S_OK;
 for i:= 0 to dwCount -1 do
  if GetItemIndexFromServerHandle(phServer[i],x) then
   begin
    wItem:=clItems[x];
    clItems.Delete(x);
    TOPCItem(wItem).Free;
    ppErrors[i]:=S_OK;
   end
  else
   begin
    result:=S_FALSE;
    ppErrors[i]:=OPC_E_INVALIDHANDLE;
   end;
end;


function TOPCGroup.SetActiveState(dwCount:DWORD; phServer:POPCHANDLEARRAY;
                   bActive:BOOL; out ppErrors:PResultList):HResult; stdcall;
var
 i,x:integer;
begin
 if (dwCount < 1) then
  begin
   result:=E_INVALIDARG;
   Exit;
  end;

 ppErrors:=PResultList(CoTaskMemAlloc(dwCount * sizeof(HRESULT)));
 if (ppErrors = nil) then
  begin
   result:=E_OUTOFMEMORY;
   Exit;
  end;

 result:=S_OK;
 for i:= 0 to dwCount - 1 do
  if GetItemIndexFromServerHandle(phServer[i],x) then
   begin
    TOPCItem(clItems[x]).SetActiveState(bActive);
    ppErrors[i]:=S_OK;
   end
  else
   begin
    result:=S_FALSE;
    ppErrors[i]:=OPC_E_INVALIDHANDLE;
   end;
end;

function TOPCGroup.SetClientHandles(dwCount:DWORD; phServer:POPCHANDLEARRAY;
                                    phClient:POPCHANDLEARRAY;
                                    out ppErrors:PResultList):HResult; stdcall;
var
 i,x:integer;
begin
 if dwCount < 1 then
  begin
   result:=E_INVALIDARG;
   Exit;
  end;

 ppErrors:=PResultList(CoTaskMemAlloc(dwCount*sizeof(HRESULT)));
 if ppErrors = nil then
  begin
   result:=E_OUTOFMEMORY;
   Exit;
  end;

 result:=S_OK;
 for i:= 0 to dwCount -1 do
  if GetItemIndexFromServerHandle(phServer[i],x) then
   begin
    TOPCItem(clItems[x]).SetClientHandle(phClient[i]);
    ppErrors[i]:=S_OK;
   end
  else
   begin
    result:=S_FALSE;
    ppErrors[i]:=OPC_E_INVALIDHANDLE;
   end;
end;

function TOPCGroup.SetDatatypes(dwCount:DWORD; phServer:POPCHANDLEARRAY;
                                pRequestedDatatypes:PVarTypeList;
                                out ppErrors:PResultList):HResult; stdcall;
var
 i,x:integer;
begin
 if (dwCount < 1) then
  begin
   result:=E_INVALIDARG;
   Exit;
  end;

 ppErrors:=PResultList(CoTaskMemAlloc(dwCount*sizeof(HRESULT)));
 if (ppErrors = nil) then
  begin
   result:=E_OUTOFMEMORY;
   Exit;
  end;

 result:=S_OK;
 for i:= 0 to dwCount -1 do
  if GetItemIndexFromServerHandle(phServer[i],x) then
   begin
    if not IsVariantTypeOK(pRequestedDatatypes[i]) then
     begin
      ppErrors[i]:=OPC_E_BADTYPE;
      result:=S_FALSE;
     end
    else
     begin
      TOPCItem(clItems[x]).SetReqDataType(pRequestedDatatypes[i]);
      ppErrors[i]:=S_OK;
     end;
   end
  else
   begin
    result:=S_FALSE;
    ppErrors[i]:=OPC_E_INVALIDHANDLE;
   end;
end;

function TOPCGroup.CreateEnumerator(const riid: TIID; out ppUnk: IUnknown): HResult; stdcall;
var
 i:integer;
 aList:TList;
 aAttr:TOPCItemAttributes;
begin
 if not (IsEqualIID(riid,IID_IEnumOPCItemAttributes) or IsEqualIID(riid,IID_IUnknown)) then