uopcdataaccess.pas

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

//******************************************************************************
// sOPC created by ACHAT SOLUTIONS GmbH, http://www.achat-solutions.de/
//******************************************************************************
unit uOPCDataAccess;

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

interface

uses
  Windows, ComObj, ActiveX, Axctrls, SysUtils, Dialogs, Classes, StdVCL,
  OPCtypes, OPCDA, OPCCOMN, OpcError, uGlobals, uOPCNode, uOPCGroup,
  uOPCStringEnumerator, sOPC_TLB, uOPC, uOPCBrowse;

type
  sOPCDataAccess = class(
    TAutoObject,
    IOPCDataAccess20,
    IOPCServer,
    IOPCCommon,
    IOPCServerPublicGroups,
    IOPCBrowseServerAddressSpace,
    IPersist,
    IPersistFile,
    IConnectionPointContainer,
    IOPCItemProperties)

  protected
    // IPersistFile
    function GetClassID(out classID: TCLSID): HResult; stdcall;

    function IsDirty: HResult; stdcall;

    function Load(pszFileName: POleStr; dwMode: Longint): HResult; stdcall;

    function Save(pszFileName: POleStr; fRemember: BOOL): HResult; stdcall;

    function SaveCompleted(pszFileName: POleStr): HResult; stdcall;

    function GetCurFile(out pszFileName: POleStr): HResult; stdcall;

    // IConnectionPointContainer
    function EnumConnectionPoints(out Enum: IEnumConnectionPoints): HResult; stdcall;

    function FindConnectionPoint(const iid: TIID; out cp: IConnectionPoint): HResult; stdcall;

    // IOPCServer
    function AddGroup(szName:POleStr; bActive: BOOL; dwRequestedUpdateRate: DWORD;
      hClientGroup: OPCHANDLE; pTimeBias: PLongint; pPercentDeadband: PSingle;
      dwLCID: DWORD; out phServerGroup: OPCHANDLE; out pRevisedUpdateRate: DWORD;
      const riid: TIID; out ppUnk: IUnknown): HResult; stdcall;

    function GetErrorString(dwError: HResult; dwLocale: TLCID;
      out ppString: POleStr): HResult; overload; stdcall;

    function GetGroupByName(szName: POleStr; const riid: TIID;
      out ppUnk: IUnknown): HResult; stdcall;

    function GetStatus(out ppServerStatus: POPCSERVERSTATUS): HResult; stdcall;

    function RemoveGroup(hServerGroup: OPCHANDLE; bForce: BOOL): HResult; stdcall;

    function CreateGroupEnumerator(dwScope: OPCENUMSCOPE; const riid: TIID;
      out ppUnk: IUnknown): HResult; stdcall;

    // IOPCCommon
    function SetLocaleID(dwLcid: TLCID): HResult; stdcall;

    function GetLocaleID(out pdwLcid: TLCID): HResult; stdcall;

    function QueryAvailableLocaleIDs(out pdwCount: UINT; out pdwLcid: PLCIDARRAY): HResult; stdcall;

    function GetErrorString(dwError: HResult; out ppString: POleStr): HResult; overload; stdcall;

    function SetClientName(szName: POleStr): HResult; stdcall;

    // IOPCServerPublicGroups
    function GetPublicGroupByName(szName: POleStr; const riid: TIID;
      out ppUnk: IUnknown): HResult; stdcall;

    function RemovePublicGroup(hServerGroup: OPCHANDLE; bForce: BOOL): HResult; stdcall;

    // IOPCBrowseServerAddressSpace
    function QueryOrganization(out pNameSpaceType: OPCNAMESPACETYPE): HResult; stdcall;

    function ChangeBrowsePosition(dwBrowseDirection: OPCBROWSEDIRECTION;
      szString: POleStr): HResult; stdcall;

    function BrowseOPCItemIDs(dwBrowseFilterType: OPCBROWSETYPE; szFilterCriteria: POleStr;
      vtDataTypeFilter: TVarType; dwAccessRightsFilter: DWORD;
      out ppIEnumString: IEnumString): HResult; stdcall;

    function GetItemID(szItemDataID: POleStr; out szItemID: POleStr): HResult; stdcall;

    function BrowseAccessPaths(szItemID: POleStr; out ppIEnumString: IEnumString): HResult; stdcall;

    // IOPCItemProperties
    function QueryAvailableProperties(szItemID: POleStr; out pdwCount: DWORD;
      out ppPropertyIDs: PDWORDARRAY; out ppDescriptions: POleStrList;
      out ppvtDataTypes: PVarTypeList): HResult; stdcall;

    function GetItemProperties(szItemID: POleStr; dwCount: DWORD;
      pdwPropertyIDs: PDWORDARRAY; out ppvData: POleVariantArray;
      out ppErrors: PResultList): HResult; stdcall;

    function LookupItemIDs(szItemID: POleStr; dwCount: DWORD; pdwPropertyIDs: PDWORDARRAY;
      out ppszNewItemIDs: POleStrList; out ppErrors: PResultList): HResult; stdcall;

  protected
    FOPCBrowse: sOPCBrowse;
    FOPCGroup: TList;
    FLcid: TLCID;
    FClientName: string;
    FStartTime: TDateTime;
    FLastDataUpdateToClient: TDateTime;

    FConnectionPoints: TConnectionPoints;
    FShutdown: TConnectionPoint;
    FConnectEvent: TConnectEvent;
    FClientIUnknown: IUnknown;

    procedure ConnectEvent(const Sink: IUnknown; Connecting: Boolean);

    procedure RemoveGroupByHandle(hServerGroup: OPCHANDLE);
    // removes the group 'hServerGroup' out of the group list and free's the group

    function CreateGroupNameList(Mode: integer): TStringList; virtual;
    // create a list of group names, the calling method must release the list!
    // Mode: 0 = list of private groups, 1 = list of public groups
    //       2 = list of private and public groups

    function FindGroupByName(Name: string; var ix: integer): sOPCGroup; virtual;
    // returns Group if 'Name' is found in private or public list

    function FindGroupByHandle(hServerGroup: OPCHANDLE; var ix: integer): sOPCGroup; virtual;
    // returns Group if 'hServerGroup' is found in private or public list

  public
    procedure Initialize; override;

    destructor Destroy; override;

    function ShutDown: boolean;

    function GroupCount(PublicFlag: boolean): integer; virtual;

    function GenerateUniqueGroupName(var Name: string): boolean;
    // generates a unique group name ouf of 'Name'
    // True -> new name generated

    function ChangeGroupToPublic(Name: string): HResult;

    procedure AddOPCGroup(OPCGroup: sOPCGroup);

    property LastDataUpdateToClient: TDateTime read FLastDataUpdateToClient
      write FLastDataUpdateToClient;
  end;

implementation

uses
  ComServ,
  uRegister;

//******************************************************************************
// IPersistFile
//******************************************************************************
function sOPCDataAccess.GetClassID(out classID: TCLSID): HResult; stdcall;
begin
  Result := S_FALSE;
end;

function sOPCDataAccess.IsDirty: HResult; stdcall;
begin
  Result := S_FALSE;
end;

function sOPCDataAccess.Load(pszFileName: POleStr; dwMode: Longint): HResult; stdcall;
begin
  Result := S_FALSE;
end;

function sOPCDataAccess.Save(pszFileName: POleStr; fRemember: BOOL): HResult; stdcall;
begin
  Result := S_FALSE;
end;

function sOPCDataAccess.SaveCompleted(pszFileName: POleStr): HResult; stdcall;
begin
  Result := S_FALSE;
end;

function sOPCDataAccess.GetCurFile(out pszFileName: POleStr): HResult; stdcall;
begin
  Result := S_FALSE;
end;

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

function sOPCDataAccess.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_IOPCShutdown) then begin
    cp := FShutdown;
    Result := S_OK;
  end else
    Result := E_NOINTERFACE;
end;

//******************************************************************************
// IOPCServerIMPL
//******************************************************************************
function sOPCDataAccess.AddGroup(szName: POleStr; bActive: BOOL;
  dwRequestedUpdateRate: DWORD; hClientGroup: OPCHANDLE; pTimeBias: PLongint;
  pPercentDeadband: PSingle; dwLCID: DWORD; out phServerGroup: OPCHANDLE;
  out pRevisedUpdateRate: DWORD; const riid: TIID; out ppUnk: IUnknown): HResult; stdcall;
var
  newName: string;
  OPCGroup: sOPCGroup;
begin
  newName := szName;
  if not GenerateUniqueGroupName(newName) then begin
    Result := OPC_E_DUPLICATENAME;
    exit;
  end;

  OPCGroup := sOPCGroup.Create(self);
  if OPCGroup = nil then begin
    Result := E_OUTOFMEMORY;
    phServerGroup := 0;
    exit;
  end;

  FOPCGroup.Add(OPCGroup);
  OPCGroup.Init(newName, bActive, dwRequestedUpdateRate, hClientGroup, pTimeBias, pPercentDeadband, dwLCID);
  phServerGroup := OPCGroup.ServerGroup;
  pRevisedUpdateRate := OPCGroup.RequestedUpdateRate;

  ppUnk := OPCGroup;
  Result := S_OK;
end;

function sOPCDataAccess.GetErrorString(dwError: HResult; dwLocale: TLCID;
  out ppString: POleStr): HResult; stdcall;
begin
  ppString := StringToLPOLESTR('Unknown Error Code: ' + IntToStr(dwError));
  Result := S_OK;
end;

function sOPCDataAccess.GetGroupByName(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.GetStatus(out ppServerStatus: POPCSERVERSTATUS): HResult; stdcall;
begin
  if (addr(ppServerStatus) = nil) then begin
    Result := E_INVALIDARG;
    exit;
  end;

  ppServerStatus := TaskMemAlloc(0, mkServerStatus, Result);
  if ppServerStatus = nil then exit;

  Result := S_OK;
  ppServerStatus.ftStartTime      := ConvertToFileTime(FStartTime);
  ppServerStatus.ftCurrentTime    := ConvertToFileTime(Now);
  ppServerStatus.ftLastUpdateTime := ConvertToFileTime(FLastDataUpdateToClient);
  ppServerStatus.dwServerState    := OPC_STATUS_RUNNING;
  ppServerStatus.dwGroupCount     := GroupCount(False) + GroupCount(True);
  ppServerStatus.dwBandWidth      := $FFFFFFFF;
  ppServerStatus.wMajorVersion    := 1;
  ppServerStatus.wMinorVersion    := 1;
  ppServerStatus.wBuildNumber     := 1;
  ppServerStatus.szVendorInfo     := 'sOPC created by ACHAT SOLUTIONS GmbH, http://www.achat-solutions.de/';
end;

function sOPCDataAccess.RemoveGroup(hServerGroup: OPCHANDLE; bForce: BOOL): HResult; stdcall;
// This function should not be called for Public Groups!
begin
  RemoveGroupByHandle(hServerGroup);
  Result := S_OK;
end;

function sOPCDataAccess.CreateGroupEnumerator(dwScope: OPCENUMSCOPE;
  const riid: TIID; out ppUnk: IUnknown): HResult; stdcall;
var
  Mode: integer;
begin
  Result := S_OK;
  Mode := 0;
  case dwScope of
    OPC_ENUM_PRIVATE_CONNECTIONS, OPC_ENUM_PRIVATE: Mode := 0;
    OPC_ENUM_PUBLIC_CONNECTIONS, OPC_ENUM_PUBLIC:   Mode := 1;
    OPC_ENUM_ALL_CONNECTIONS, OPC_ENUM_ALL:         Mode := 2;
  end;
  ppUnk := sOPCStringEnumerator.Create(CreateGroupNameList(Mode));
end;

//******************************************************************************
// IOPCCommonIMPL
//******************************************************************************
function sOPCDataAccess.SetLocaleID(dwLcid: TLCID): HResult; stdcall;
begin
  FLcid := dwLcid;
  Result := S_OK;
end;

function sOPCDataAccess.GetLocaleID(out pdwLcid: TLCID): HResult; stdcall;
begin
  pdwLcid := FLcid;
  Result := S_OK;
end;

function sOPCDataAccess.QueryAvailableLocaleIDs(out pdwCount: UINT;
  out pdwLcid: PLCIDARRAY): HResult; stdcall;
begin
  Result := S_FALSE;
end;

function sOPCDataAccess.GetErrorString(dwError: HResult; out ppString: POleStr): HResult; stdcall;
begin
  ppString := StringToLPOLESTR('Unknown Data Access error code: ' + IntToStr(dwError));
  Result := S_OK;
end;

function sOPCDataAccess.SetClientName(szName: POleStr): HResult; stdcall;
begin
  if (addr(szName) = nil) then begin
    Result := E_INVALIDARG;
    exit;
  end;
  FClientName := szName;