groupunit.pas

基本功能高效的CAN通讯应用.同样,CAN232 不仅适应基本CAN-bus产品,也满足基于高层协议如ModBUS、DeviceNet...之间可选 3. RS232接口,波特率在1200bps

function TOPCGroup.MoveToPublic:HResult;stdcall;
var
 i:integer;
begin
 i:=servObj.IsGroupNamePresent(servObj.pubGrps,tagName);
 if i = -1 then
  begin
   result:=E_FAIL;                    Exit;
  end;
 with servObj do
  begin
   pubGrps.Add(grps[i]);
   GroupRemovingSelf(grps,serverHandle);
   ownList:=pubGrps;
  end;
 result:=S_OK;
end;
//IOPCPublicGroupStateMgt end

//IOPCSyncIO begin
function TOPCGroup.Read(dwSource:OPCDATASOURCE; dwCount:DWORD; phServer:POPCHANDLEARRAY;
                        out ppItemValues:POPCITEMSTATEARRAY; out ppErrors:PResultList):HResult;stdcall;
var
 i,x:integer;
 memErr:boolean;
 ppServer:PDWORDARRAY;

 procedure ClearResultsArray;
 var
  i:integer;
 begin
  for i:= 0 to dwCount -1 do
   begin
    ppItemValues[i].hClient:=0;                 ppItemValues[i].wReserved:=0;
    ppItemValues[i].vDataValue:=0;              ppItemValues[i].wQuality:=0;
  end;
 end;

begin
 if dwCount < 1 then
  begin
   result:=E_INVALIDARG;
   Exit;
  end;

 ppItemValues:=POPCITEMSTATEARRAY(CoTaskMemAlloc(dwCount * sizeof(OPCITEMSTATE)));
 memErr:=boolean(ppItemValues = nil);

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

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

 result:=S_OK;
 ppServer:=@phServer^;
 ClearResultsArray;
 for i:= 0 to dwCount -1 do
  if GetItemIndexFromServerHandle(ppServer[i],x) then
   begin
    TOPCItem(clItems[x]).ReadItemValueStateTime(dwSource,ppItemValues[i]);
    if (dwSource <> OPC_DS_DEVICE) and not groupActive then
     ppItemValues[i].wQuality:=OPC_QUALITY_OUT_OF_SERVICE;
    ppErrors[i]:=S_OK;
   end
  else
   begin
    result:=S_FALSE;
    ppErrors[i]:=OPC_E_INVALIDHANDLE;
   end;
end;

function TOPCGroup.Write(dwCount:DWORD; phServer:POPCHANDLEARRAY;
                         pItemValues:POleVariantArray; out ppErrors:PResultList):HResult;stdcall;
var
 i,x:integer;
 ppServer:PDWORDARRAY;
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;
 ppServer:=@phServer^;
 for i:= 0 to dwCount -1 do
  if GetItemIndexFromServerHandle(ppServer[i],x) then
   begin
    if not TOPCItem(clItems[x]).isWriteAble then
     begin
      ppErrors[i]:=OPC_E_BADRIGHTS;
      result:=S_FALSE;
     end
    else
     begin
      TOPCItem(clItems[x]).WriteItemValue(pItemValues[i]);
      ppErrors[i]:=S_OK
     end;
   end
  else
   begin
    result:=S_FALSE;
    ppErrors[i]:=OPC_E_INVALIDHANDLE;
   end;
end;
//IOPCSyncIO end

//IOPCAsyncIO2 begin
function TOPCGroup.Read(dwCount:DWORD; phServer: POPCHANDLEARRAY; dwTransactionID:DWORD;
              out pdwCancelID:DWORD; out ppErrors:PResultList):HResult;stdcall;
var
 memErr:boolean;
 i,itemIndex:integer;
 aAsyncObj:TAsyncIO2;
begin
 if ClientIUnknown = nil then
  begin
   result:=CONNECT_E_NOCONNECTION;
   Exit;
  end;

 if (dwCount < 1) then
  begin
   result:=E_INVALIDARG;
   Exit;
  end;

 ppErrors:=PResultList(CoTaskMemAlloc(dwCount * sizeof(HRESULT)));
 memErr:=boolean(ppErrors = nil);

 if not memErr then
  begin
   aAsyncObj:=TAsyncIO2.Create(self,io2Read,dwTransactionID,
                               dwCount,OPC_DS_DEVICE);
   memErr:=boolean(aAsyncObj = nil);
  end;

 if not memErr then
  try
   GetMem(aAsyncObj.ppServer,dwCount * sizeof(longword));
  except
   result:=E_OUTOFMEMORY;
   Exit;
  end;

 if not memErr then
  begin
   pdwCancelID:=aAsyncObj.cancelID;        //was generated in TAsyncIO2.Create
   aAsyncObj.itemCount:=0;
   for i:= 0 to dwCount-1 do
    begin
     if GetItemIndexFromServerHandle(phServer[i],itemIndex) then
      begin
       aAsyncObj.ppServer[aAsyncObj.itemCount]:=itemIndex;
       aAsyncObj.itemCount:=succ(aAsyncObj.itemCount);
       ppErrors[i]:=S_OK;
      end
     else
      ppErrors[i]:=OPC_E_INVALIDHANDLE;
    end;
  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.Write(dwCount:DWORD; phServer:POPCHANDLEARRAY; pItemValues:POleVariantArray;
               dwTransactionID:DWORD; out pdwCancelID:DWORD; out ppErrors:PResultList):HResult;stdcall;
var
 i:longword;
 itemIndex:integer;
 memErr:boolean;
 aAsyncObj:TAsyncIO2;
begin
 if ClientIUnknown = nil then
  begin
   result:=CONNECT_E_NOCONNECTION;
   Exit;
  end;

 if (dwCount < 1) then
  begin
   result:=E_INVALIDARG;
   Exit;
  end;

 aAsyncObj:=TAsyncIO2.Create(self,io2Write,dwTransactionID,dwCount,0);
 memErr:=boolean(aAsyncObj = nil);

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

 if not memErr then
  try
   GetMem(aAsyncObj.ppServer,dwCount * sizeof(longword));
   GetMem(aAsyncObj.ppValues,dwCount * sizeof(OleVariant));
  except
   result:=E_OUTOFMEMORY;
   Exit;
  end;

 if not memErr then
  begin
   pdwCancelID:=aAsyncObj.cancelID;        //was generated in TAsyncIO2.Create
   aAsyncObj.itemCount:=0;
   for i:= 0 to dwCount-1 do
    begin
     if GetItemIndexFromServerHandle(phServer[i],itemIndex) then
      begin
       aAsyncObj.ppServer[aAsyncObj.itemCount]:=itemIndex;
       aAsyncObj.ppValues[aAsyncObj.itemCount]:=pItemValues[i];
       aAsyncObj.itemCount:=succ(aAsyncObj.itemCount);
       ppErrors[i]:=S_OK;
      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;
 allInActive:boolean;
begin
 if ClientIUnknown = nil then
  begin
   result:=CONNECT_E_NOCONNECTION;
   Exit;
  end;

 allInActive:=true;
 for i:= 0 to clItems.count-1 do
  if TOPCItem(clItems[i]).GetActiveState then
   begin
    allInActive:=false;
    Break;
   end;

 if (not groupActive) or allInActive then
  begin
   result:=E_FAIL;
   Exit;
  end;

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

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

function TOPCGroup.Cancel2(dwCancelID:DWORD):HResult;stdcall;
var
 i:integer;
begin
 result:=E_FAIL;
 if (asyncList = nil) or (asyncList.count = 0) then
  Exit;
 for i:= 0 to asyncList.count-1 do
  if TAsyncIO2(asyncList[i]).cancelID = dwCancelID then
   begin
    result:=S_OK;
    TAsyncIO2(asyncList[i]).isCancelled:=true;
    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
 for i:= 0 to clItems.count-1 do
  TOPCItem(clItems[i]).Free;
 clItems.Free;

 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;

 servObj.GroupRemovingSelf(ownList,serverHandle);
end;

function TOPCGroup.ValidateRequestedUpDateRate(dwRequestedUpdateRate:DWORD):DWORD;
begin
 if (dwRequestedUpdateRate < 199) 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
  ClientIUnknown:=Sink
 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
 cancelIndex:=succ(cancelIndex);
 result:=cancelIndex;
end;

procedure TOPCGroup.TimeSlice(cTime:TDateTime);
var
 i:longword;
 curComp:comp;
begin
 if clItems = nil then Exit;
 if (clItems.count = 0) then Exit;

 AsyncTimeSlice(cTime);

 curComp:=TimeStampToMSecs(DateTimeToTimeStamp(cTime));
 if curComp >= (lastMSecUpdate + requestedUpdateRate) then
  begin
   nextUpdate:=0;
   upStream.Seek(0,soFromBeginning);
   for i:= 0 to clItems.count-1 do
    if TOPCItem(clItems[i]).bActive then
     if TOPCItem(clItems[i]).UpdateYourSelf then
      upStream.Write(i,sizeOf(i));

   if ClientIUnknown <> nil then
    if onDataChangeEnabled and (upStream.position <> 0) then
     DoAChangeOccured(upStream, cTime);
   lastMSecUpdate:=curComp;
  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;
  aAsyncObj.HandleThisRequest(cTime);
  finally
   if Assigned(aAsyncObj) then
    FreeAndNil(aAsyncObj);
  end;
end;

procedure TOPCGroup.AsyncTimeSlice(cTime:TDateTime);
var
 i:integer;
 aAsyncObj:TAsyncIO2;
begin
 if (requestedUpdateRate = 0) or
    (clItems.count = 0)       or
    (ClientIUnknown =  nil)   then
  begin
   for i:= asyncList.count-1 downTo 0 do
    TAsyncIO2(asyncList[i]).Free;
   Exit;
  end;

 aAsyncObj:=nil;
 if (asyncList <> nil) and (asyncList.count > 0) then
  begin
   for i:= 0 to asyncList.count - 1 do
    begin
     try
      aAsyncObj:=TAsyncIO2(asyncList[i]);
      aAsyncObj.HandleThisRequest(cTime);
     finally
      FreeAndNil(aAsyncObj);
     end;
    end;
   asyncList.Clear;
  end;
end;

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