groupunit.pas

delphi2007 opcserver

        ppErrors[i]:=E_FAIL;
       end;

       aAsyncObj.itemCount:=succ(aAsyncObj.itemCount);
      end
     else
      ppErrors[i]:=OPC_E_INVALIDHANDLE;
    end;
  end;

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

 if (aAsyncObj.itemCount < 1) then
  begin
   if Assigned(aAsyncObj) then
    FreeAndNil(aAsyncObj);
   result:=S_FALSE;
  end
 else
  begin
   asyncList.Add(aAsyncObj);
   result:=S_OK;
  end;
end;

function TOPCGroup.Refresh2(dwSource:OPCDATASOURCE; dwTransactionID:DWORD;
                  out pdwCancelID:DWORD):HResult;stdcall;
var
 i:integer;
 aAsyncObj:TAsyncIO2;
begin
 result:=S_OK;
 if (ClientIUnknown = nil) then
  begin
   result:=CONNECT_E_NOCONNECTION;
   Exit;
  end;

 if not (dwSource in [OPC_DS_CACHE,OPC_DS_DEVICE]) then
  begin
   result:=E_INVALIDARG;
   Exit;
  end;

 if not groupActive then
  begin
   result:=E_FAIL;
   Exit;
  end;

 if (clItems.count < 1) then
  begin
   result:=E_FAIL;
   Exit;
  end;

 for i:= 0 to clItems.count - 1 do
  if not TOPCItem(clItems[i]).GetActiveState then
   begin
    result:=E_FAIL;
    break;
   end;

 if (result <> S_OK) then
  Exit;

 aAsyncObj:=TAsyncIO2.Create(self,io2Refresh,dwTransactionID,0,dwSource);
 if (aAsyncObj = nil) then
  begin
   result:=E_OUTOFMEMORY;
   Exit;
  end;

 pdwCancelID:=aAsyncObj.cancelID;
 asyncList.Add(aAsyncObj);
end;

function TOPCGroup.Cancel2(dwCancelID:DWORD):HResult;stdcall;
var
 i:integer;
begin
 result:=E_FAIL;
 if Assigned(asyncList) then
  for i:= 0 to asyncList.count - 1 do
   if Assigned(asyncList[i]) then
    if TAsyncIO2(asyncList[i]).cancelID = dwCancelID then
     begin
      TAsyncIO2(asyncList[i]).isCancelled:=true;
      TAsyncIO2(asyncList[i]).DoCancelCallBack;
      result:=S_OK;
      Break;
     end
end;

function TOPCGroup.SetEnable(bEnable:BOOL):HResult;stdcall;
begin
 if (ClientIUnknown = nil) then
  begin
   result:=CONNECT_E_NOCONNECTION;
   Exit;
  end;
 onDataChangeEnabled:=bEnable;
 result:=S_OK;
end;

function TOPCGroup.GetEnable(out pbEnable:BOOL):HResult;stdcall;
begin
 if (ClientIUnknown = nil) then
  begin
   result:=CONNECT_E_NOCONNECTION;
   Exit;
  end;
 pbEnable:=onDataChangeEnabled;
 result:=S_OK;
end;
//IOPCAsyncIO2 end

procedure TOPCGroup.Initialize;
begin
 inherited Initialize;
 FIConnectionPoints.CreateConnectionPoint(IID_IOPCDataCallback,ckMulti,CallBackOnConnect);
end;

constructor TOPCGroup.Create(serv:TDA2;oList:TList);
begin
 FIConnectionPoints:=TConnectionPoints.Create(self);
 Inherited Create;
 servObj:=serv;
 ownList:=oList;
 clItems:=TList.Create;
 asyncList:=TList.Create;
 upStream:=TMemoryStream.Create;
 onDataChangeEnabled:=true;
end;

destructor TOPCGroup.Destroy;
var
 i:integer;
begin
 ClientIUnknown:=nil;
 servObj.GroupRemovingSelf(ownList,serverHandle);

 if Assigned(clItems) then
  begin
   for i:= 0 to clItems.count - 1 do
    TOPCItem(clItems[i]).Free;
   FreeAndNil(clItems);
  end;

 for i:= 0 to asyncList.count - 1 do
  TAsyncIO2(asyncList[i]).Free;
 asyncList.Free;

 if Assigned(FIConnectionPoints) then
  FIConnectionPoints.Free;
 if Assigned(upStream) then
  upStream.Free;

end;

function TOPCGroup.ValidateRequestedUpDateRate(dwRequestedUpdateRate:DWORD):DWORD;
begin
 if (dwRequestedUpdateRate < 500) then
  requestedUpdateRate:=1000
 else
  requestedUpdateRate:=dwRequestedUpdateRate;
 nextUpdate:=0;
 result:=requestedUpdateRate;
end;

procedure TOPCGroup.ValidateTimeBias(pTimeBias:PLongint);
var
 timeZoneRec:TTimeZoneInformation;
begin
 if not assigned(pTimeBias) then
  begin
   GetTimeZoneInformation(timeZoneRec);
   timeBias:=timeZoneRec.bias;
  end
 else
 timeBias:=pTimeBias^;
end;


procedure TOPCGroup.SetUp(szName:string;bActive:BOOL;dwRequestedUpdateRate:DWORD;
                hClientGroup:OPCHANDLE; pTimeBias:longint; pPercentDeadband:single;
                dwLCID:DWORD;phServerGroup:longword);
begin
 tagName:=szName;
 groupActive:=bActive;
 ValidateRequestedUpDateRate(dwRequestedUpdateRate);
 clientHandle:=hClientGroup;
 percentDeadband:=pPercentDeadband;
 lang:=dwLCID;
 serverHandle:=phServerGroup;
 groupPublic:=false;
 servObj.lastClientUpdate:=Now;
 onDataChangeEnabled:=true;
 lastMSecUpdate:=TimeStampToMSecs(DateTimeToTimeStamp(Now));
end;

procedure TOPCGroup.CallBackOnConnect(const Sink: IUnknown; Connecting: Boolean);
begin
 if connecting then
  begin
   ClientIUnknown:=Sink;
   if groupActive then
    GroupActiveFromInactive;
  end
 else
  ClientIUnknown:=nil;
end;

function TOPCGroup.GetItemIndexFromServerHandle(servHand:longword;var index:integer):boolean;
var
 i:integer;
begin
 result:=false;
 for i:= 0 to clItems.count-1 do
  if TOPCItem(clItems[i]).serverItemNum = servHand then
   begin
    index:=i;
    result:=true;
    Break;
   end;
end;

function TOPCGroup.GetItemIndexFromClientHandle(clHand:longword;var index:integer):boolean;
var
 i:integer;
begin
 result:=false;
 for i:= 0 to clItems.count-1 do
  if TOPCItem(clItems[i]).clientNum = clHand then
   begin
    index:=i;
    result:=true;
    Break;
   end;
end;

function TOPCGroup.GenerateAsyncCancelID:longword;
const
 cancelIndex:integer = 1;            //Assignable Typed Constants gota lovem
begin
 Inc(cancelIndex);
 result:=cancelIndex;
end;

procedure TOPCGroup.GroupActiveFromInactive;
var
 i:integer;
 x:longword;
begin
//just set the old quality of all the items to something to force an update
 if Assigned(clItems) then
  for i:= 0 to clItems.count - 1 do
   if Assigned(clItems[i]) then
    TOPCItem(clItems[i]).oldQuality:=OPC_QUALITY_UNCERTAIN;

 nextUpdate:=requestedUpdateRate;      //force an update
 try
//one tester would set requestedUpdateRate to max and then an overflow
//would occur in TimeSlice at Inc(nextUpdate)
   x:=(nextUpdate + 100);
   if (x = 0) then
    ;
  except
   Dec(nextUpdate,100);
 end;
end;

procedure TOPCGroup.TimeSlice(cTime:TDateTime);
var
 i:integer;
begin
 if (clItems = nil) then
  Exit;

 if (clItems.count = 0) then
  Exit;

 AsyncTimeSlice(cTime);         //read or write pending

 Inc(nextUpdate,100);                           //pulse time

//if the value changes from a to b and back to a before the update time is elapsed
//the client will miss the change.
 i:=0;
 while i <= (clItems.count - 1) do
  begin
   if Assigned(clItems[i]) then
    if TOPCItem(clItems[i]).bActive then
     TOPCItem(clItems[i]).ChangedCheck;
    Inc(i);
  end;

 if (nextUpdate >= requestedUpdateRate) then
  begin
   upStream.Seek(0,soFromBeginning);


//   OutputDebugString(PChar('Update ' + TimeToStr(cTime)));

   i:=0;
   while i <= (clItems.count - 1) do
    begin
     if Assigned(clItems[i]) then
      if TOPCItem(clItems[i]).bActive then
       if TOPCItem(clItems[i]).OnChangedCheck then
        upStream.Write(i,sizeOf(i));
     Inc(i);
    end;

   if Assigned(ClientIUnknown) and groupActive then
    if onDataChangeEnabled and (upStream.position <> 0) then
     DoAChangeOccured(upStream,cTime);

   AsyncTimeSlice(cTime);
   nextUpdate:=0;
   lastMSecUpdate:=TimeStampToMSecs(DateTimeToTimeStamp(Now));
  end;
end;

procedure TOPCGroup.CloneYourSelf(dGrp:TOPCGroup);
var
 i:integer;
 wItem:TOPCItem;
begin
 dGrp.ClientIUnknown:=nil;
 dGrp.serverHandle:=servObj.GetNewGroupNumber;
 dGrp.servObj:=servObj;

 dGrp.clientHandle:=clientHandle;
 dGrp.requestedUpdateRate:=requestedUpdateRate;
 dGrp.lang:=lang;
 dGrp.groupActive:=false;
 dGrp.timeBias:=timeBias;
 dGrp.percentDeadband:=percentDeadband;
 dGrp.lastMSecUpdate:=lastMSecUpdate;
 if (clItems.count > 0) then
  begin
   for i:=0 to clItems.count-1 do
    begin
     wItem:=TOPCItem.Create;
     TOPCItem(clItems[i]).CopyYourSelf(wItem);
     dGrp.clItems.Add(wItem);
    end;
  end;
end;

procedure TOPCGroup.DoAChangeOccured(aStream:TMemoryStream; cTime:TDateTime);
var
 i:integer;
 aAsyncObj:TAsyncIO2;
begin
 i:=(aStream.position div 4);
 aAsyncObj:=nil;
 try
  aAsyncObj:=TAsyncIO2.Create(self,io2Change,0,i,OPC_DS_CACHE);
  aAsyncObj.aStream:=aStream;
 finally
  if Assigned(aAsyncObj) then
   asyncList.Add(aAsyncObj);
  end;
end;

procedure TOPCGroup.AsyncTimeSlice(cTime:TDateTime);
var
 aAsyncObj:TAsyncIO2;
 i,numberToHandle:integer;
begin
 if not Assigned(asyncList) or (asyncList.count < 1) then
  Exit;

 if (requestedUpdateRate = 0) or
    (clItems.count = 0)       or
    (ClientIUnknown =  nil)   then
  begin
   for i:= asyncList.count - 1 downTo 0 do
    TAsyncIO2(asyncList[i]).Free;
   asyncList.Clear;
   Exit;
  end;

//new async items may get entered while handling the list. delete the ones
//handled and handle the ones present on entry. handle any added in the next pass.
 if Assigned(asyncList) and (asyncList.count > 0) then
  begin
   numberToHandle:=asyncList.count - 1;
   for i:= 0 to numberToHandle do
    if Assigned(asyncList[i]) then
     begin
      try
       aAsyncObj:=TAsyncIO2(asyncList[i]);
       aAsyncObj.HandleThisRequest(cTime);
      finally
       begin
        asyncList[i]:=nil;
        FreeAndNil(aAsyncObj);
       end;
      end;
    end;
   asyncList.Pack;
  end;
end;

initialization
  TTypedComObjectFactory.Create(ComServer, TOPCGroup, Class_OPCGroup,
    ciMultiInstance, tmApartment);
end.