uopcgroup.pas

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

    Result := E_NOINTERFACE;
    exit;
  end;

  newName := szName;
  if not sOPCDataAccess(FDataAccess).GenerateUniqueGroupName(newName) then begin
    Result := OPC_E_DUPLICATENAME;
    exit;
  end;

  // create group
  OPCGroup := sOPCGroup.Create(FDataAccess);
  sOPCDataAccess(FDataAccess).AddOPCGroup(OPCGroup);
  ppUnk := OPCGroup;
  // clone fields
  OPCGroup.FName := newName;
  OPCGroup.FActive := False;
  OPCGroup.FRequestedUpdateRate := FRequestedUpdateRate;
  OPCGroup.FClientGroup := FClientGroup;
  OPCGroup.FTimeBias := FTimeBias;
  OPCGroup.FPercentDeadband := FPercentDeadband;
  OPCGroup.FLCID := FLCID;
  OPCGroup.FPublicGroupFlag := False;
  OPCGroup.CallBackEnabled := CallBackEnabled;
  // clone OPCItem's
  for i := 0 to FOPCItemList.Count - 1 do begin
    coi := sOPCItem(FOPCItemList[i]);
    OPCItem := sOPCItem.Create(coi.OPCNode);
    coi.Copy(OPCItem);
    OPCGroup.FOPCItemList.Add(OPCItem);
  end;

  Result := S_OK;
end;

//******************************************************************************
// IOPCPublicGroupStateMgt
//******************************************************************************
function sOPCGroup.GetState(out pPublic: BOOL): HResult; stdcall;
begin
  pPublic := FPublicGroupFlag;
  Result := S_OK;
end;

function sOPCGroup.MoveToPublic: HResult; stdcall;
begin
  Result := E_FAIL;
  if FPublicGroupFlag then exit;
  Result := sOPCDataAccess(FDataAccess).ChangeGroupToPublic(FName);
  if Result = S_OK then FPublicGroupFlag := True;
end;

//******************************************************************************
// IOPCSyncIO
//******************************************************************************
function sOPCGroup.Read(dwSource: OPCDATASOURCE; dwCount: DWORD; phServer: POPCHANDLEARRAY;
  out ppItemValues: POPCITEMSTATEARRAY; out ppErrors: PResultList): HResult; stdcall;
var
  i, x: integer;
  OPCItem: sOPCItem;
begin
  ppItemValues := TaskMemAlloc(dwCount, mkItemState, Result);
  ppErrors := TaskMemAlloc(dwCount, mkHResult, Result);
  if (ppItemValues = nil) or (ppErrors = nil) then begin
    TaskMemFree(ppItemValues);
    TaskMemFree(ppErrors);
    exit;
  end;

  Result := S_OK;
  for i := 0 to dwCount - 1 do begin
    OPCItem := GetOPCItem(PDWORDARRAY(@phServer^)[i], x);
    if OPCItem <> nil then begin
      if OPCItem.ReadAble then begin
        if (dwSource = OPC_DS_DEVICE) or FActive then begin
          OPCItem.GetOPCItemState(dwSource, ppItemValues[i]);
          sOPCDataAccess(FDataAccess).LastDataUpdateToClient := Now;
        end else begin
          ppItemValues[i].wQuality := OPC_QUALITY_OUT_OF_SERVICE;
        end;
        ppErrors[i] := S_OK
      end else begin
        ppItemValues[i].wQuality := OPC_QUALITY_BAD;
        ppErrors[i] := OPC_E_BADRIGHTS;
        Result := S_FALSE;
      end;
    end else begin
      Result := S_FALSE;
      ppErrors[i] := OPC_E_INVALIDHANDLE;
    end;
  end;
end;

function sOPCGroup.Write(dwCount: DWORD; phServer: POPCHANDLEARRAY;
  pItemValues: POleVariantArray; out ppErrors: PResultList): HResult; stdcall;
var
  i, x: 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(PDWORDARRAY(@phServer^)[i], x);
    if OPCItem <> nil then begin
      if not OPCItem.WriteAble then begin
        ppErrors[i] := OPC_E_BADRIGHTS
      end else begin
        OPCItem.Write(POleVariantArray(@pItemValues^)[i]);
        ppErrors[i] := S_OK
      end;
    end else begin
      Result := S_FALSE;
      ppErrors[i] := OPC_E_INVALIDHANDLE;
    end;
  end;
end;

//******************************************************************************
// IOPCAsyncIO2
//******************************************************************************
function sOPCGroup.Read(dwCount: DWORD; phServer: POPCHANDLEARRAY; dwTransactionID: DWORD;
  out pdwCancelID: DWORD; out ppErrors: PResultList): HResult; stdcall;
// Reads are from Device and are not affected by the ACTIVE state of the group
// or item.
var
 AsyncIO2: sOPCAsyncIO2;
begin
  if FClientIUnknown = nil then begin
    Result := CONNECT_E_NOCONNECTION;
    exit;
  end;

  if (dwCount = 0) or (dwTransactionID = 0) then begin
    Result := E_INVALIDARG;
    exit;
  end;

  ppErrors := TaskMemAlloc(dwCount, mkHResult, Result);
  if ppErrors = nil then exit;

  AsyncIO2 := sOPCAsyncIO2.Create(self, omRead, dwTransactionID, dwCount, OPC_DS_DEVICE);
  pdwCancelID := AsyncIO2.CancelID;
  AsyncIO2.Copy_phServer(phServer);
  AsyncIOList.Add(AsyncIO2);

  Result := S_OK;
end;

function sOPCGroup.Write(dwCount: DWORD; phServer: POPCHANDLEARRAY; pItemValues: POleVariantArray;
  dwTransactionID: DWORD; out pdwCancelID: DWORD; out ppErrors: PResultList): HResult; stdcall;
var
 AsyncIO2: sOPCAsyncIO2;
begin
  if FClientIUnknown = nil then begin
    Result := CONNECT_E_NOCONNECTION;
    exit;
  end;
  if (dwCount = 0) or (dwTransactionID = 0) then begin
    Result := E_INVALIDARG;
    exit;
  end;

  ppErrors := TaskMemAlloc(dwCount, mkHResult, Result);
  if ppErrors = nil then exit;

  AsyncIO2 := sOPCAsyncIO2.Create(self, omWrite, dwTransactionID, dwCount, OPC_DS_DEVICE);
  pdwCancelID := AsyncIO2.CancelID;
  AsyncIO2.Copy_phServer(phServer);
  AsyncIO2.Copy_pItemValues(pItemValues);
  AsyncIOList.Add(AsyncIO2);

  Result := S_OK;
end;

function sOPCGroup.Refresh2(dwSource: OPCDATASOURCE; dwTransactionID: DWORD;
  out pdwCancelID: DWORD): HResult; stdcall;
var
  i: integer;
  AsyncIO2: sOPCAsyncIO2;
  OneActive: boolean;
begin
  if FClientIUnknown = nil then begin
    Result := CONNECT_E_NOCONNECTION;
    exit;
  end;
  if (dwTransactionID = 0) then begin
    Result := E_INVALIDARG;
    exit;
  end;

  OneActive := False;
  for i := 0 to FOPCItemList.Count - 1 do begin
    if sOPCItem(FOPCItemList[i]).Active then begin
      OneActive := True;
      break;
    end;
  end;
  if (not FActive) or (not OneActive) then begin
    Result := E_FAIL;
    exit;
  end;

  AsyncIO2 := sOPCAsyncIO2.Create(self, omRefresh, dwTransactionID, 0, dwSource);
  pdwCancelID := AsyncIO2.CancelID;
  AsyncIOList.Add(AsyncIO2);
  Result := S_OK;
end;

function sOPCGroup.Cancel2(dwCancelID: DWORD): HResult; stdcall;
var
  i: integer;
begin
  Result := E_FAIL;
  if (AsyncIOList = nil) or (AsyncIOList.Count = 0) then exit;
  for i := 0 to AsyncIOList.Count - 1 do begin
    if sOPCAsyncIO2(AsyncIOList[i]).CancelID = dwCancelID then begin
      Result := S_OK;
      sOPCAsyncIO2(AsyncIOList[i]).CancelFlag := True;
      break;
    end
  end;
end;

function sOPCGroup.SetEnable(bEnable: BOOL): HResult; stdcall;
begin
  CallBackEnabled := bEnable;
  Result := S_OK;
end;

function sOPCGroup.GetEnable(out pbEnable: BOOL): HResult; stdcall;
begin
  pbEnable := CallBackEnabled;
  Result := S_OK;
end;


//******************************************************************************
// IConnectionPointContainer
//******************************************************************************
function sOPCGroup.EnumConnectionPoints(out Enum: IEnumConnectionPoints): HResult; stdcall;
begin
  Result := E_NOTIMPL;
end;

function sOPCGroup.FindConnectionPoint(const iid: TIID; out cp: IConnectionPoint): HResult; stdcall;
begin
  if (addr(cp) = nil) then begin
    Result := E_INVALIDARG;
    exit;
  end;

  if IsEqualGuid(iid, IID_IOPCDataCallback) then begin
    cp := FConnectionPoint;
    Result := S_OK;
  end else begin
    Result := E_NOINTERFACE;
  end;
end;

procedure sOPCGroup.Initialize;
begin
  inherited Initialize;
  FConnectionPoints := TConnectionPoints.Create(self);
  FConnectionPoint := TConnectionPoint.Create(FConnectionPoints, IID_IOPCDataCallback,
    ckSingle, FConnectEvent);
end;

constructor sOPCGroup.Create(Server: TObject);
begin
  OPCLog('init OPC Group');
  FCriticalSection := TCriticalSection.Create;
  FName := '';
  FActive := False;
  FRequestedUpdateRate := 0;
  FClientGroup := 0;
  FTimeBias := 0;
  FPercentDeadband := 0;
  FLCID := 0;
  FServerGroup := CreateHandles.Group;
  FDataAccess := Server;
  FPublicGroupFlag := False;
  FOPCLock := False;
  FOPCItemList := TList.Create;
  AsyncIOList := TList.Create;
  CallBackEnabled := True;
  FConnectionPoints := nil;
  FConnectionPoint := nil;
  FConnectEvent := ConnectEvent;       // inherited create calls initialize!
  FClientIUnknown := nil;
  FDataCallback := nil;
  FTimer := sTimer.Create(False);
  FEvaluationTimer := sTimer.Create;
  inherited Create;
  if GroupThread then begin
    FGroupThread := sGroupThread.Create(True);
    sGroupThread(FGroupThread).FOPCGroup := self;
    FGroupThread.Resume;
  end else begin
    FGroupForm := TFGroupForm.Create(nil);
    TFGroupForm(FGroupForm).OPCGroup := self;
  end;
end;

destructor sOPCGroup.Destroy;
var
 i: integer;
begin
  OPCLog('destroy OPC Group');
  if GroupThread then begin
    FGroupThread.Terminate;
    FGroupThread.WaitFor;
    FGroupThread.Free;
  end else begin
    FGroupForm.Free;
  end;
  FConnectionPoint.Free;
  FConnectionPoints.Free;
  for i := 0 to FOPCItemList.Count - 1 do sOPCItem(FOPCItemList[i]).Free;
  FOPCItemList.Free;
  for i := 0 to AsyncIOList.Count - 1 do sOPCAsyncIO2(AsyncIOList[i]).Free;
  AsyncIOList.Free;
  FEvaluationTimer.Free;
  FTimer.Free;
  FCriticalSection.Free;
end;

procedure sOPCGroup.Init(szName: string; bActive: BOOL; dwRequestedUpdateRate: DWORD;
  hClientGroup: OPCHANDLE; pTimeBias: PLongint; pPercentDeadband: PSingle;
  dwLCID: DWORD);
begin
  FName := szName;
  FActive := bActive;
  SetRequestedUpdateRate(dwRequestedUpdateRate);
  FClientGroup := hClientGroup;
  if Assigned(pTimeBias) then FTimeBias := pTimeBias^;
  if Assigned(pPercentDeadband) then FPercentDeadband := pPercentDeadband^;
  FLCID := dwLCID;
end;

procedure sOPCGroup.ConnectEvent(const Sink: IUnknown; Connecting: Boolean);
begin
  if Connecting then begin
    FClientIUnknown := Sink;
    if not Succeeded(FClientIUnknown.QueryInterface(IOPCDataCallback,
      FDataCallback)) then FDataCallback := nil;
  end;
end;

procedure sOPCGroup.SetRequestedUpdateRate(UpdateRate: DWORD);
begin
  // lowest value for the update rate is 100 ms
  if UpdateRate < 50 then UpdateRate := 100;
  FRequestedUpdateRate := UpdateRate;
  if not GroupThread then TFGroupForm(FGroupForm).Timer.Enabled := True;
end;

function sOPCGroup.GetOPCItem(hServer: OPCHANDLE; var ix: integer): sOPCItem;
var
  i: integer;
begin
  for i := 0 to FOPCItemList.Count - 1 do begin
    Result := sOPCItem(FOPCItemList[i]);
    ix := i;
    if Result.ServerHandle = hServer then exit;
  end;
  Result := nil;
  ix := -1;
end;

procedure sOPCGroup.Timer;
var
  AsyncIO2: sOPCAsyncIO2;
begin
  // asynchronous I/O's
  while (AsyncIOList.Count > 0) do begin
    try
      AsyncIO2 := sOPCAsyncIO2(AsyncIOList[0]);
      AsyncIO2.ProcessRequest(CallBackEnabled);
      AsyncIO2.Free;
    except
      on E: Exception do OPCLogException('sOPCGroup.Timer 1', E);
    end;
    AsyncIOList.Delete(0);
  end;

  // Timer Refresh
  if FTimer.isRunning and (FTimer.msTime > FRequestedUpdateRate) then begin
    FTimer.Start;
    try
      if (not FActive) or (FOPCItemList.Count = 0) then exit;
      AsyncIO2 := sOPCAsyncIO2.Create(self, omTimerRefresh, 0, 0, 0);
      AsyncIO2.ProcessRequest(CallBackEnabled);
      AsyncIO2.Free;
    except
      on E: Exception do OPCLogException('sOPCGroup.Timer 2', E);
    end;
  end;
end;

procedure sOPCGroup.EnterCriticalSection;
begin
  if GroupThread then exit;
  while True do begin
    FCriticalSection.Enter;
    if FOPCLock then begin
      FCriticalSection.Leave;
      Sleep(20);
    end else begin
      break;
    end;
  end;
end;

procedure sOPCGroup.LeaveCriticalSection;
begin
  if GroupThread then exit;
  FCriticalSection.Leave;
end;

initialization

TTypedComObjectFactory.Create(
  ComServer,
  sOPCGroup,
  Class_OPCGroup,
  ciInternal,
  ThreadingModel);

end.