uglobals.pas

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

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

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

interface

uses
  Windows, ActiveX, SysUtils, ComObj,
  uLogging,
  OPCDA;

//******************************************************************************
const
 IID_IUnknown: TIID = '{00000000-0000-0000-C000-000000000046}';

//******************************************************************************
const
  ThreadingModel: TThreadingModel = tmFree;

type
  sMemoryKind = (mkHResult, mkItemState, mkItemResult, mkServerStatus,
    mkDWORD, mkPOleStr, mkVarType, mkOleVariant, mkWord, mkFileTime);

  sCreateHandles = class
  private
    GroupIndex: DWORD;
    ItemIndex: DWORD;
    CancelIndex: DWORD;

  public
    constructor Create;
    function Group: DWORD;
    function Item: DWORD;
    function CancelID: DWORD;
  end;

//******************************************************************************
var
  CreateHandles: sCreateHandles;
  Logging: TLogging;

//******************************************************************************
function ConvertToFileTime(DateTime: TDateTime): TFileTime;
// converts time format TDateTime in TFileTime

function TaskMemAlloc(dwCount: DWORD; mk: sMemoryKind; var aResult: HResult): pointer;
// allocates Task Memory

procedure TaskMemFree(Memory: pointer);
// releases Task Memory

procedure OPCLog(Text: string);
// logging function

procedure OPCLogException(Text: string; E: Exception);
// OPC Exception log

//******************************************************************************
implementation

//******************************************************************************
function ConvertToFileTime(DateTime: TDateTime): TFileTime;
var
  sTime: TSystemTime;
begin
  DateTimeToSystemTime(DateTime, sTime);
  SystemTimeToFileTime(sTime, Result);
  LocalFileTimeToFileTime(Result, Result);
end;

//******************************************************************************
// Allocate Task Memory
//******************************************************************************
function TaskMemAlloc(dwCount: DWORD; mk: sMemoryKind; var aResult: HResult): pointer;
// Result = nil -> no memory allocated
var
  Size: integer;
begin
  try
    Size := 0;
    case mk of
      mkHResult:         Size := dwCount * sizeof(HRESULT);
      mkItemState:       Size := dwCount * sizeof(OPCITEMSTATE);
      mkItemResult:      Size := dwCount * sizeof(OPCITEMRESULT);
      mkServerStatus:    Size := sizeof(OPCSERVERSTATUS);
      mkDWORD:           Size := dwCount * sizeof(DWORD);
      mkPOleStr:         Size := dwCount * sizeof(POleStr);
      mkVarType:         Size := dwCount * sizeof(TVarType);
      mkOleVariant:      Size := dwCount * sizeof(OleVariant);
      mkWord:            Size := dwCount * sizeof(word);
      mkFileTime:        Size := dwCount * sizeof(TFileTime);
    end;
    Result := CoTaskMemAlloc(Size);
    if Result = nil
      then aResult := E_OUTOFMEMORY
      else FillChar(Result^, Size, 0);
  except
    on E: Exception do begin
      Result := nil;
      OPCLogException('TaskMemAlloc', E);
    end;
  end;
end;

procedure TaskMemFree(Memory: pointer);
begin
  if Memory <> nil then CoTaskMemFree(Memory);
end;

//******************************************************************************
// sCreateHandles
//******************************************************************************

// switch set off, to avoid overflow exception
{$OVERFLOWCHECKS OFF}

constructor sCreateHandles.Create;
begin
  GroupIndex := 1;
  ItemIndex := 1;
  CancelIndex := 1;
end;

function sCreateHandles.Group: DWORD;
begin
  inc(GroupIndex);
  if GroupIndex = 0 then GroupIndex := 2;
  Result := GroupIndex;
end;

function sCreateHandles.Item: DWORD;
begin
  inc(ItemIndex);
  if ItemIndex = 0 then ItemIndex := 2;
  Result := ItemIndex;
end;

function sCreateHandles.CancelID: DWORD;
begin
  inc(CancelIndex);
  if CancelIndex = 0 then CancelIndex := 2;
  Result := CancelIndex;
end;

procedure OPCLog(Text: string);
begin
  if (Logging <> nil) then Logging.WriteIntoFile(Text);
end;

procedure OPCLogException(Text: string; E: Exception);
begin
  if Logging = nil then exit;
  Logging.WriteIntoFile(Format('%s %p %s - %s', [DateTimeToStr(Now), ExceptAddr, Text, E.Message]));
end;

initialization
  CreateHandles := sCreateHandles.Create;
  Logging := nil;

finalization

end.