gprs_interface.pas

delphi开发的基于 gprsd数据采集程序

unit Gprs_Interface;

interface

uses Windows, Classes, SysUtils, StrUtils;

type
  //record for base tag definity
  PTag = ^TTag;
  TTag = record
    WellID: Integer;   //井号标示
    DataID: Integer;   //数据项标示
    TagID : string;    //OPC标签名称
    Handle : DWORD;    //OPC标签句柄
  end;

  //base class for gprs data convert
  TGPRS_Intf = class
  private
    //服务器标签列表
    FTagList: TList;
    //服务器激活状态
    FActive: BOOL;
  public
    constructor Create;
    destructor Destroy; override;
    //增加服务器标签
    procedure AddTag(WellID: Integer; DataID: Integer); overload;
    procedure AddTag(WellID: Integer; DataID: Integer; tagID: string); overload;
    procedure UpdateTag(WellID: Integer; DataID: Integer; Value : Integer; dt: TDateTime);
    //激活OPC服务器，服务器只能激活一次，而且激活后的服务器不能添加标签
    function  ActiveOPC: BOOL;
    //注册OPC服务器
    function Reg(ExeName: string): BOOL;
    //注销OPC服务器
    procedure Unreg(ExeName: string);
  end;
var
  GPRS_Intf: TGPRS_Intf;

implementation

const
  //const for opc state
  OPC_STATUS_RUNNING    = 1;
  OPC_STATUS_FAILED     = 2;
  OPC_STATUS_NOCONFIG   = 3;
  OPC_STATUS_SUSPENDED  = 4;
  OPC_STATUS_TEST       = 5;
  OPC_STATUS_COMM_FAULT = 6;
  OPCDrv                = 'opcdll.dll';
  SvrClsID              = '{0CC30552-F2CD-4BC9-A050-60CBC46F87E9}';
  SvrName               = 'OPC.GPRS_LHZC.1';
  SvrDesc               = 'OPC Server for GPRS';
  SvrRate               = 1000;
  //dll export procedure
  function  InitOPCSvr(pCLSID_Svr: LPCSTR; ServerRate: UINT): BOOL; stdcall;external OPCDrv;
  procedure UninitOPCSvr; stdcall;external OPCDrv;
  function  RegServer(pCLSID_Svr: LPCSTR; Name: LPCSTR; Descr: LPCSTR; ExePath: LPCSTR): BOOL; stdcall;external OPCDrv;
  function  UnregServer(pCLSID_Svr: LPCSTR; Name: LPCSTR): BOOL; stdcall;external OPCDrv;
  function  RunSvr: BOOL; stdcall;  external OPCDrv;
  function  CreateTag (Name: LPCSTR; Value: VARIANT; InitialQuality: WORD; IsWriteable: BOOL): THandle;stdcall; external OPCDrv;
  function  SetTagProperties(TagHandle: THandle; PropertyID: DWORD; Description: LPCSTR; Value: VARIANT): BOOL; stdcall;external OPCDrv;
  function  UpdateTagWithTimeStamp(TagHandle: THandle; Value: VARIANT; Quality: WORD; timestamp: FILETIME): BOOL; stdcall;external OPCDrv;
  procedure SetServerState(SvrState: Word); stdcall;external OPCDrv;

{ TGPRS_Intf }

function TGPRS_Intf.ActiveOPC: BOOL;
var
  I: Integer;
  Tag: PTag;
begin
  result:= False;
  if FActive then Exit;
  if InitOPCSvr(PChar(SvrClsID),SvrRate) then
  begin
    SetServerState(OPC_STATUS_RUNNING);
    for I:=0 to FTagList.Count-1 do
    begin
      Tag:= PTag(FTagList[I]);
      if Tag.Handle=0 then
      begin
        Tag^.Handle:= CreateTag(PChar(Tag^.TagID),0,192,false);
        if Tag^.Handle>0 then
          SetTagProperties(Tag^.Handle,1,'Datatype',4);
      end;
    end;
    RunSvr;
    FActive:= true;
  end;
end;

procedure TGPRS_Intf.AddTag(WellID: Integer; DataID: Integer);
var
  Tag: PTag;
begin
  if FActive then Exit;

  try
    New(Tag);
    Tag^.WellID:= WellID;
    Tag^.DataID:= DataID;
    Tag^.TagID:= Format('W%d.DATA%d',[WellID,DataID]);
    FTagList.Add(Tag);
  except
  end;
end;

procedure TGPRS_Intf.AddTag(WellID, DataID: Integer; tagID: string);
var
  Tag: PTag;
begin
  if FActive then Exit;

  try
    New(Tag);
    Tag^.WellID:= WellID;
    Tag^.DataID:= DataID;
    Tag^.TagID:= TagID;
    FTagList.Add(Tag);
  except
  end;
end;

constructor TGPRS_Intf.Create;
begin
  Inherited Create;
  FTagList:= TList.Create;
end;

destructor TGPRS_Intf.Destroy;
var
  I: Integer;
begin
  for I:=0 to FTagList.Count-1 do
    Dispose(PTag(FTagList[I]));
  FTagList.Free;
  if FActive then
    UninitOPCSvr;
  inherited;
end;

function TGPRS_Intf.Reg(ExeName: string): BOOL;
begin
  RegServer(PChar(SvrClsID),PChar(SvrName), PChar(SvrDesc),PChar(ExeName));
end;

procedure TGPRS_Intf.Unreg(ExeName: string);
begin
  UnregServer(PChar(SvrClsID),PChar(ExeName));
end;

procedure TGPRS_Intf.UpdateTag(WellID, DataID, Value: Integer; dt: TDateTime);
var
  I: Integer;
  Tag: PTag;
  st: TSYSTEMTIME;
  ft: TFileTime;
begin
  for I:=0 to FTagList.Count-1 do
  begin
    Tag:= PTag(FTagList[I]);
    if (Tag.WellID=WellID) and (Tag.DataID= DataID) then
    begin
      DateTimeToSystemTime(dt,st);
      SystemTimeToFileTime(st,ft);
      LocalFileTimeToFileTime(ft,ft);
      UpdateTagWithTimeStamp(Tag.Handle,Value,192,ft); //192 is quality good 
      break;
    end;
  end;
end;

end.