uopcdataaccess.pas

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

  Result := S_OK;
end;

//******************************************************************************
// IOPCServerPublicGroupsIMPL
//******************************************************************************
function sOPCDataAccess.GetPublicGroupByName(szName: POleStr; const riid: TIID;
  out ppUnk: IUnknown): HResult; stdcall;
var
  OPCGroup: sOPCGroup;
  ix: integer;
begin
  OPCGroup := FindGroupByName(szName, ix);
  if (addr(ppUnk) = nil) or (OPCGroup = nil) then begin
    Result := E_INVALIDARG;
    exit;
  end;
  Result := IUnknown(OPCGroup).QueryInterface(riid, ppUnk);
end;

function sOPCDataAccess.RemovePublicGroup(hServerGroup: OPCHANDLE; bForce: BOOL): HResult; stdcall;
begin
  RemoveGroupByHandle(hServerGroup);
  Result := S_OK;
end;

//******************************************************************************
// IOPCBrowseServerAddressSpaceIMPL
//******************************************************************************
function sOPCDataAccess.QueryOrganization(out pNameSpaceType: OPCNAMESPACETYPE): HResult; stdcall;
begin
  pNameSpaceType := OPC_NS_HIERARCHIAL;
  Result := S_OK;
end;

function sOPCDataAccess.ChangeBrowsePosition(dwBrowseDirection: OPCBROWSEDIRECTION;
  szString: POleStr): HResult; stdcall;
var
  St: string;
begin
  if not Assigned(szString)
    then St := ''
    else St := szString;
  Result := S_OK;
  case dwBrowseDirection of
    OPC_BROWSE_UP: if not FOPCBrowse.BrowseUp then Result := E_FAIL;
    OPC_BROWSE_DOWN: if not FOPCBrowse.BrowseDown(St) then Result := E_FAIL;
    OPC_BROWSE_TO: if not FOPCBrowse.BrowseTo(St) then Result := E_INVALIDARG;
  end;
end;

function sOPCDataAccess.BrowseOPCItemIDs(dwBrowseFilterType: OPCBROWSETYPE;
  szFilterCriteria: POleStr; vtDataTypeFilter: TVarType; dwAccessRightsFilter: DWORD;
  out ppIEnumString: IEnumString): HResult; stdcall;
var
  List: TStringList;
begin
  Result := S_OK;
  List := FOPCBrowse.BrowseOPCItems(dwBrowseFilterType);
  ppIEnumString := sOPCStringEnumerator.Create(List);
end;

function sOPCDataAccess.GetItemID(szItemDataID: POleStr; out szItemID: POleStr):
  HResult; stdcall;
begin
 szItemID := StringToLPOLESTR(FOPCBrowse.GetItemID(szItemDataID));
 Result := S_OK;
end;

function sOPCDataAccess.BrowseAccessPaths(szItemID: POleStr;
  out ppIEnumString: IEnumString): HResult; stdcall;
var
  OPCNode: sOPCNode;
begin
  Result := S_OK;
  OPCNode := OPC.GetOPCNode(szItemID);
  ppIEnumString := sOPCStringEnumerator.Create(OPCNode.slAddressPathList, False);
end;

//******************************************************************************
// IOPCItemProperties
//******************************************************************************
function sOPCDataAccess.QueryAvailableProperties(
  szItemID: POleStr;
  out pdwCount: DWORD;
  out ppPropertyIDs: PDWORDARRAY;
  out ppDescriptions: POleStrList;
  out ppvtDataTypes: PVarTypeList): HResult; stdcall;
var
  i: integer;
  OPCNode: sOPCNode;
begin
  OPCNode := OPC.GetOPCNode(szItemID);
  if OPCNode = nil then begin
    Result := OPC_E_INVALIDITEMID;
    exit;
  end;

  pdwCount := FOPCBrowse.GetPropertyCount(szItemID);
  if pdwCount = 0 then exit;  // +++ Testen

  ppPropertyIDs := TaskMemAlloc(pdwCount, mkDWORD, Result);
  ppDescriptions := TaskMemAlloc(pdwCount, mkPOleStr, Result);
  ppvtDataTypes := TaskMemAlloc(pdwCount, mkVarType, Result);
  if (ppPropertyIDs = nil) or (ppDescriptions = nil) or (ppvtDataTypes = nil) then begin
    TaskMemFree(ppPropertyIDs);
    TaskMemFree(ppDescriptions);
    TaskMemFree(ppvtDataTypes);
    exit;
  end;

  Result := S_OK;
  for i := 0 to pdwCount - 1 do begin
    OPCNode := FOPCBrowse.GetProperty(szItemID, i);
    ppPropertyIDs[i] := OPCNode.dwPropertyID;
    ppDescriptions[i] := StringToLPOLESTR(OPCNode.stDescription);
    ppvtDataTypes[i] := OPCNode.vtPropertyDataType;
  end;
end;

function sOPCDataAccess.GetItemProperties(szItemID: POleStr; dwCount: DWORD;
  pdwPropertyIDs: PDWORDARRAY; out ppvData: POleVariantArray;
  out ppErrors: PResultList): HResult; stdcall;
var
  i: integer;
  OPCNode: sOPCNode;
begin
  OPCNode := OPC.GetOPCNode(szItemID);
  if OPCNode = nil then begin
    Result := OPC_E_INVALIDITEMID;
    exit;
  end;

  ppvData := TaskMemAlloc(dwCount, mkOleVariant, Result);
  ppErrors := TaskMemAlloc(dwCount, mkHResult, Result);
  if (ppvData = nil) or (ppErrors = nil) then begin
    TaskMemFree(ppvData);
    TaskMemFree(ppErrors);
    exit;
  end;

  Result := S_OK;
  for i := 0 to dwCount - 1 do begin
    ppvData[i] := FOPCBrowse.GetPropertyData(szItemID, PDWORDARRAY(pdwPropertyIDs)[i]);
    ppErrors[i] := S_OK;
  end;
end;

function sOPCDataAccess.LookupItemIDs(szItemID: POleStr; dwCount: DWORD;
  pdwPropertyIDs: PDWORDARRAY; out ppszNewItemIDs: POleStrList;
  out ppErrors: PResultList): HResult; stdcall;
var
  i: integer;
  OPCNode: sOPCNode;
begin
  OPCNode := OPC.GetOPCNode(szItemID);
  if (OPCNode = nil) then begin
    Result := OPC_E_INVALIDITEMID;
    exit;
  end;
  if dwCount = 0 then begin
    Result := E_INVALIDARG;
    exit;
  end;

  ppErrors := TaskMemAlloc(dwCount, mkHResult, Result);
  ppszNewItemIDs := TaskMemAlloc(dwCount, mkPOleStr, Result);
  if (ppErrors = nil) or (ppszNewItemIDs = nil) then begin
    TaskMemFree(ppErrors);
    TaskMemFree(ppszNewItemIDs);
    exit;
  end;

  for i := 0 to dwCount - 1 do begin
    ppszNewItemIDs[i] := nil; // StringToLPOLESTR('...');  // +++ sp鋞er
    ppErrors[i] := S_OK;
  end;
  Result := S_OK;
end;

procedure sOPCDataAccess.Initialize;
begin
  OPCLog('init OPC DataAccess ' + InttoStr(longint(self)));
  // wait until the application is running
  repeat until OPC.CanStart;
  inherited Initialize;

  FStartTime := Now;
  FLastDataUpdateToClient := 0;

  FConnectEvent := ConnectEvent;
  FConnectionPoints := TConnectionPoints.Create(self);
  FShutdown := TConnectionPoint.Create(FConnectionPoints, IID_IOPCShutdown,
    ckSingle, FConnectEvent);

  FOPCGroup := TList.Create;
  OPC.InitAddressSpace;
  FOPCBrowse := sOPCBrowse.Create;

  OPC.AddDataAccessServer(self);
end;

procedure sOPCDataAccess.ConnectEvent(const Sink: IUnknown; Connecting: Boolean);
begin
  if Connecting then FClientIUnknown := Sink;
end;

destructor sOPCDataAccess.Destroy;
var
  i: integer;
begin
  OPCLog('destroy OPC DataAccess ' + InttoStr(longint(self)));
  for i := 0 to FOPCGroup.Count - 1 do sOPCGroup(FOPCGroup.Items[i]).Free;
  FShutdown.Free;
  FConnectionPoints.Free;
  FOPCGroup.Free;
  FOPCBrowse.Free;
  OPC.RemoveDataAccessServer(self);
  inherited;
end;

function sOPCDataAccess.ShutDown: boolean;
var
  Obj: pointer;
begin
  Result := False;
  if (FClientIUnknown <> nil) then begin
    if Succeeded(FClientIUnknown.QueryInterface(IOPCShutdown, Obj)) then begin
      IOPCShutdown(Obj).ShutdownRequest('Terminated by User.');
      Result := True;
    end;
  end;
end;

procedure sOPCDataAccess.RemoveGroupByHandle(hServerGroup: OPCHANDLE);
var
  OPCGroup: sOPCGroup;
  ix: integer;
begin
  OPCGroup := FindGroupByHandle(hServerGroup, ix);
  if (OPCGroup <> nil) then begin
    FOPCGroup.Delete(ix);
  end;
end;

function sOPCDataAccess.GroupCount(PublicFlag: boolean): integer;
var
  i: integer;
  OPCGroup: sOPCGroup;
begin
  Result := 0;
  for i := 0 to FOPCGroup.Count - 1 do begin
    OPCGroup := sOPCGroup(FOPCGroup.Items[i]);
    if not (PublicFlag xor OPCGroup.PublicGroup) then inc(Result);
  end;
end;

function sOPCDataAccess.CreateGroupNameList(Mode: integer): TStringList;
var
  i: integer;
  OPCGroup: sOPCGroup;
begin
  Result := TStringList.Create;
  for i := 0 to FOPCGroup.Count - 1 do begin
    OPCGroup := sOPCGroup(FOPCGroup.Items[i]);
    if (Mode = 2) or
      not ((Mode = 0) xor (not OPCGroup.PublicGroup) or
      not ((Mode = 1) xor OPCGroup.PublicGroup))
    then begin
      Result.Add(OPCGroup.Name);
    end;
  end;
end;

function sOPCDataAccess.FindGroupByHandle(hServerGroup: OPCHANDLE; var ix: integer): sOPCGroup;
var
  i: integer;
  OPCGroup: sOPCGroup;
begin
  ix := -1;
  Result := nil;
  for i := 0 to FOPCGroup.Count - 1 do begin
    OPCGroup := sOPCGroup(FOPCGroup.Items[i]);
    if hServerGroup = OPCGroup.ServerGroup then begin
      Result := OPCGroup;
      ix := i;
      exit;
    end;
  end;
end;

function sOPCDataAccess.FindGroupByName(Name: string; var ix: integer): sOPCGroup;
var
  i: integer;
  OPCGroup: sOPCGroup;
begin
  ix := -1;
  Result := nil;
  for i := 0 to FOPCGroup.Count - 1 do begin
    OPCGroup := sOPCGroup(FOPCGroup.Items[i]);
    if Name = OPCGroup.Name then begin
      Result := OPCGroup;
      ix := i;
      exit;
    end;
  end;
end;

function sOPCDataAccess.GenerateUniqueGroupName(var Name: string): boolean;
var
  i, ix: integer;
  newName: string;
begin
  i := 1;
  Result := False;
  newName := Name;
  while (FindGroupByName(Name, ix) <> nil) and (i < 9999) do begin
    newName := Name + '_' + IntToStr(i);
    if (FindGroupByName(Name, ix) = nil) then break;
    inc(i);
  end;
  if i >= 9999 then exit;
  Result := True;
  Name := newName;
end;

function sOPCDataAccess.ChangeGroupToPublic(Name: string): HResult;
var
  OPCGroup: sOPCGroup;
  ix: integer;
begin
  Result := E_FAIL;
  OPCGroup := FindGroupByName(Name, ix);
  if OPCGroup = nil then exit;
  OPCGroup.PublicGroup := True;
  Result := S_OK;
end;

procedure sOPCDataAccess.AddOPCGroup(OPCGroup: sOPCGroup);
begin
  FOPCGroup.Add(OPCGroup);
end;

initialization

TOPCAutoObjectFactory.Create(
  ComServer,
  sOPCDataAccess,
  CLASS_OPCDataAccess20,
  ciMultiInstance,
  ThreadingModel);

end.