groupunit.pas

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

unit GroupUnit;

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

interface

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

type
  TOPCGroup = class(TTypedComObject,IOPCGroup,IOPCItemMgt,IOPCGroupStateMgt,
                    IOPCPublicGroupStateMgt,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

//IOPCPublicGroupStateMgt begin
   function GetState(out pPublic:BOOL):HResult;overload;stdcall;
   function MoveToPublic:HResult;stdcall;
//IOPCPublicGroupStateMgt 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;

   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 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;

function IsVariantTypeOK(vType:integer):boolean;
begin
 result:=boolean(vType in [varEmpty..$14]);
end;

//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;

 procedure ClearResultsArray;
 var
  i:integer;
 begin
  for i:= 0 to dwCount -1 do
   begin
    ppAddResults[i].hServer:=0;                 ppAddResults[i].vtCanonicalDataType:=0;
    ppAddResults[i].wReserved:=0;               ppAddResults[i].dwAccessRights:=0;
    ppAddResults[i].dwBlobSize:=0;              ppAddResults[i].pBlob:=nil;
  end;
 end;

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;

 ClearResultsArray;

 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;

 procedure ClearResultsArray;
 var
  i:integer;
 begin
  for i:= 0 to dwCount -1 do
   with ppValidationResults[i] do
    begin
     vtCanonicalDataType:=0;    dwAccessRights:=0;
     dwBlobSize:=0;             hServer:=0;
    end;
 end;
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;
 ClearResultsArray;
 for i:= 0 to dwCount -1 do
  begin
   inItemDef:=@pItemArray[i];

   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
     ppErrors[i]:=OPC_E_BADTYPE
    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
 aList:=nil;
 result:=S_OK;
 if (clItems = nil) or (clItems.count = 0) then
  begin
   result:=S_FALSE;                Exit;
  end;

 try
  aList:=TList.Create;
  if aList = nil then
   begin
    result:=E_OUTOFMEMORY;                Exit;
   end;

  for i:= 0 to clItems.count-1 do
   begin
    aAttr:=TOPCItemAttributes.Create;
    if aAttr = nil then
     begin
      result:=E_OUTOFMEMORY;                Exit;
     end;
    TOPCItem(clItems[i]).FillInOPCItemObject(aAttr);
    aList.Add(aAttr);
   end;

  ppUnk:=TOPCItemAttEnumerator.Create(aList);

 finally
  if (aList <> nil) and (aList.count > 0) then
   for i:= 0 to aList.count-1 do
    TOPCItemAttributes(aList[i]).Free;
  aList.Free;
 end;
end;
//IOPCItemMgt end

//IOPCGroupStateMgt begin
function TOPCGroup.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:=requestedUpdateRate;
 pActive:=groupActive;
 ppName:=StringToLPOLESTR(tagName);
 pTimeBias:=timeBias;
 pPercentDeadband:=percentDeadband;            pLCID:=lang;
 phClientGroup:=clientHandle;                  phServerGroup:=serverHandle;
 result:=S_OK;
end;

function TOPCGroup.SetState(pRequestedUpdateRate:PDWORD; out pRevisedUpdateRate:DWORD;
                   pActive:PBOOL; pTimeBias:PLongint; pPercentDeadband:PSingle; pLCID:PLCID;
                   phClientGroup:POPCHANDLE):HResult; stdcall;
begin
 result:=S_OK;
 if assigned(pRequestedUpdateRate) then
  if ValidateRequestedUpDateRate(pRequestedUpdateRate^) <> pRequestedUpdateRate^ then
   result:=OPC_S_UNSUPPORTEDRATE;


 if assigned(pRequestedUpdateRate) then requestedUpdateRate:=pRequestedUpdateRate^;
 if assigned(pActive) then groupActive:=pActive^;
 if assigned(pTimeBias) then timeBias:=pTimeBias^;
 if assigned(pPercentDeadband) then percentDeadband:=pPercentDeadband^;
 if assigned(pLCID) then lang:=pLCID^;
 if assigned(phClientGroup) then clientHandle:=phClientGroup^;

 if (addr(pRevisedUpdateRate) <> nil) then
  pRevisedUpdateRate:=requestedUpdateRate;
end;

function TOPCGroup.SetName(szName:POleStr):HResult;stdcall;
begin
 result:=S_OK;
 if length(szName) = 0 then
  begin
   result:=E_INVALIDARG;
   Exit;
  end;
 if (servObj.IsGroupNamePresent(servObj.grps,szName) <> -1) then
  begin
   result:=OPC_E_DUPLICATENAME;
   Exit;
  end;
 tagName:=szName;
end;

function TOPCGroup.CloneGroup(szName:POleStr; const riid: TIID; out ppUnk:IUnknown):HResult;stdcall;
var
 s1:string;
 i:integer;
begin
 if not (IsEqualIID(riid,IID_IOPCGroupStateMgt) or IsEqualIID(riid,IID_IUnknown)) then
  begin
   result:=E_NOINTERFACE;
   Exit;
  end;

 s1:=szName;
 if length(s1) <> 0 then
  if servObj.IsNameUsedInAnyGroup(s1) then
   begin
    result:=OPC_E_DUPLICATENAME;
    Exit;
   end;

 i:=0;
 if servObj.IsNameUsedInAnyGroup(s1) then
  repeat
   s1:=s1+IntToStr(GetTickCount);
   i:=succ(i);
  until (not servObj.IsNameUsedInAnyGroup(s1)) or (i > 9);

 if i > 9 then
  begin
   result:=E_FAIL;
   Exit;
  end;

 ppUnk:=servObj.CloneAGroup(s1,self,result);
 if result <> 0 then
  begin
   ppUnk:=nil;
   Exit;
  end;
 result:=S_OK;
end;
//IOPCGroupStateMgt end

//IOPCPublicGroupStateMgt begin
function TOPCGroup.GetState(out pPublic:BOOL):HResult;stdcall;
begin
 pPublic:=servObj.IsThisGroupPublic(ownList);
 result:=S_OK;
end;