////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// DIM Agent library for DimSrv clients. See http://dim.web.cern.ch on DIM.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20230922 - Created by A.K.                                                 //
// 20230925 - 1-st releas (+/-)                                               //
// 20231009 - TDimService.LinkedObjects,LinkedStrings,LinkedParams            //
////////////////////////////////////////////////////////////////////////////////

unit _crw_dima; // DIM Agent for DimSrv clients

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$WARN 5023 off : Unit "$1" not used in $2}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, contnrs, math, process,
 _crw_alloc, _crw_environ, _crw_proc, _crw_fio, _crw_rtc, _crw_str, _crw_base64,
 _crw_hl, _crw_polling, _crw_task, _crw_crypt, _crw_dim;

 ///////////////////////////////////////////////////////////////////////////////
 // Preliminary notes.
 // DimAgent is API to use DIM (see http://dim.web.cern.ch) via server (dimsrv).
 // DIM supports subscribe/update services which can be dis/dim_info/cmnd type:
 // dis_info - DIM information server, data producer and transmitter.
 // dic_info - DIM information client, data consumer and receiver.
 // dis_cmnd - DIM command     server, command receiver and executor.
 // dic_cmnd - DIM command     client, command source and transmitter.
 // Each DIM services has Data Format description like I:2;F:3;D:4;C with format
 //  SPEC1IFIER:REPEATER;SPECIFIER:REPEATER;SPECIFIER[:REPEATER]
 // where SPECIFIER - data type specifier char: [CDFILSX] which means data type:
 //  C:Char,D:Double,F:Float,I:Integer,L:LongInt,S:SmallInt,X:eXtralong=Inp64 of
 //  size C:1,D:8,F:4,I:4,L:4,S:2,X:8 byte; REPEATER: number of specified items.
 // The last (tail) element in list may have no repeater (open format), its mean
 // his real number of items defined by incoming data size. Each SPEC:REPTR pair
 // we call "Items" -> group of data elements with the same data type specifier.
 // TDimAccess class - uses to manupulate data items when reading incoming data.
 // TDimService class - uses to mainpulate DIM services: create,send,receive it.
 // TDimAgent - contains all services with all data items and uses to transmit &
 // receive data to & from DIM server. See code examples DimAgentDemoTesterXXXX.
 ///////////////////////////////////////////////////////////////////////////////

const                                                 // Service kind:
 dis_info    = 1;                                     // Information server
 dis_cmnd    = 2;                                     // Command     server
 dic_info    = 3;                                     // Information client
 dic_cmnd    = 4;                                     // Command     client

const                                                 // Monitor type:
 timed       = _crw_dim.TIMED;     {2}                // Update by timer
 monitored   = _crw_dim.MONITORED; {4}                // Update by monitor

const
 DimMoniList = 'timed,monitored';                     // Monitor types
 DimGoodMoni = [timed,monitored];                     // Monitor types
 DimKindList = 'dis_info,dis_cmnd,dic_info,dic_cmnd'; // Service types
 DimGoodKind = [dis_info,dis_cmnd,dic_info,dic_cmnd]; // Service types

const                                                 // DIM format: I:2;D:3;C
 DimFormSpec = 'CDFILSX';                             // DIM format specifiers
 DimGoodForm = 'CDFILSX:0123456789;';                 // Valid DIM format chars

const                                                 // Format like I:n
 DimMaxFormRepeater = 4096;                           // Max. format repeater n

const                                                 // DimService linked data:
 DimMaxLinkedItems  = 16;                             // Maximal number of items

type
 TDimDataItem=packed record      // Record to access DIM data items
  case Char of                   // Depend on Service.Items.Spec[i]
   'C': ( C : PChar          );  // Uses to access Char     Data 1 byte
   'D': ( D : PDoubleArray   );  // Uses to access Double   Data 8 byte
   'F': ( F : PSingleArray   );  // Uses to access Float    Data 4 byte
   'I': ( I : PIntegerArray  );  // Uses to access Integer  Data 4 byte
   'L': ( L : PLongIntArray  );  // Uses to access LongInt  Data 4 byte
   'S': ( S : PSmallIntArray );  // Uses to access SmallInt Data 2 byte
   'X': ( X : PInt64Array    );  // Uses to access Int64    Data 8 byte
 end;

 ///////////////////////////////////////////////////////////////////////////////
 // TDimService - DIM service object.
 // TDimAccess  - DIM service's data items access.
 // TDimAgent   - Client of DIM server (dimsrv) which contains all DIM services.
 ///////////////////////////////////////////////////////////////////////////////
type
 TDimAgent=class;
 TDimAccess=class;
 TDimService=class;
 TDimLinkedItem=record Obj:TObject; Str:LongString; Par:Variant; end;
 TDimAgentLineHandler=procedure(Agent:TDimAgent; const Line:LongString);
 TDimAccess=class(TMasterObject)
 private
  myParent  : TDimService;
  myFormat  : LongString;
  myBuffer  : LongString;
  mySpec    : array of Char;
  myCount   : array of Integer;
  myOffset  : array of Integer;
  myStatus  : Integer;
  myErrors  : Integer;
  myIsValid : Boolean;
  procedure Parse;
  procedure Cleanup;
  procedure FixError;
  function  AcceptData:Boolean;
  function  ParseFormat:Integer;
  function  GetSpec(i:Integer):Char;
  function  GetItem(i:Integer):TDimDataItem;
 public
  constructor Create(aParent:TDimService; aFormat:LongString);
  destructor  Destroy; override;
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
 public
  function  Parent:TDimService;             // Parent DIM service
 public
  // Data checking:
  function  IsValid:Boolean;                // Check data buffer
  function  Errors:Integer;                 // Access error counter
 public
  // General data access:
  // x:=Service.Items[i].X[j]; or
  // d:=Service.Items.Item[i].D[j];
  // Index i=[0..Count-1], j=[0..Count(i)-1].
  // NB: Data type depends on Service.Items.Spec[i]
  property  Spec[i:Integer]:Char         read GetSpec;          // Data format
  property  Item[i:Integer]:TDimDataItem read GetItem; default; // Data access
 public
  // Raw data access (FOR ADVANCED USERS)
  function  Buffer:LongString;              // Raw data buffer
  function  DataPtr:PChar;                  // Raw data buffer pointer
  function  DataSize:Integer;               // Raw data buffer byte size
  function  FormSize:Integer;               // Data byte size from format
  function  TailSize:Integer;               // Data tail size over format
  function  TailCount:Integer;              // Counter of tail data items
  function  TailSpec:Char;                  // Data tail format specifier char
  function  FormStatus:Integer;             // 0:Error, 1:Ok, 2:Ok and free size
  function  Count(i:Integer=-1):Integer;    // i=0:ItemsCount, i>0:Repeater
  function  Offset(i:Integer):Integer;      // Data byte offset from DataPtr
 public
  function  Table:LongString;               // Table for debugging
 public
  // Format helpers:
  // Format specifier size:
  // C:1,D:8,F:4,I:4,L:4,S:2,X:8
  class function SpecSize(c:Char):Integer;
 end;
 //
 // TDimService
 //
 TDimService=class(TMasterObject)
 private
  myAgent    : TDimAgent;
  myIdent    : Integer;
  myServKind : Integer;
  myServName : LongString;
  myServForm : LongString;
  myRecvData : LongString;
  myRecvWhen : Int64;
  myMoniType : Integer;
  myMoniTime : Integer;
  myFailMark : LongString;
  myItems    : TDimAccess;
  myLinked   : array[0..DimMaxLinkedItems-1] of TDimLinkedItem;
  function  GetIdent:Integer;
  function  GetAgent:TDimAgent;
  function  GetServKind:Integer;
  function  GetKindName:LongString;
  function  GetServName:LongString;
  function  GetServForm:LongString;
  function  GetRecvData:LongString;
  function  GetRecvWhen:Int64;
  function  GetMoniType:Integer;
  function  GetMoniName:LongString;
  function  GetMoniTime:Integer;
  function  GetFailMark:LongString;
  function  GetCanSend:Boolean;
  function  GetCanRecv:Boolean;
  function  GetItems:TDimAccess;
  function  AcceptData(aWhen:Int64; aWhat:LongString):Boolean;
  procedure InitIdent;
  procedure FreeIdent;
  procedure ClearLinkedData;
  function  GetLinkedObjects(i:Integer):TObject;
  procedure SetLinkedObjects(i:Integer; Obj:TObject);
  function  GetLinkedStrings(i:Integer):LongString;
  procedure SetLinkedStrings(i:Integer; Data:LongString);
  function  GetLinkedParams(i:Integer):Variant;
  procedure SetLinkedParams(i:Integer; Data:Variant);
 public
  constructor Create(aAgent:TDimAgent; aKind:Integer; aName,aForm:LongString;
                     aMoniType,aMoniTime:Integer; aFailMark:LongString);
  destructor  Destroy; override;
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
 public
  property  Agent    : TDimAgent  read GetAgent;     // DimAgent - DIM client
  property  Ident    : Integer    read GetIdent;     // Identifier DimAgent[i+1]
  property  ServKind : Integer    read GetServKind;  // dis_info..dic_cmnd (int)
  property  KindName : LongString read GetKindName;  // dis_info..dic_cmnd (str)
  property  ServName : LongString read GetServName;  // DIM service name
  property  ServForm : LongString read GetServForm;  // Data type format
  property  MoniType : Integer    read GetMoniType;  // Monitor: type 1,2
  property  MoniName : LongString read GetMoniName;  // Monitor: timed,monitored
  property  MoniTime : Integer    read GetMoniTime;  // Monitor time interval, s
  property  FailMark : LongString read GetFailMark;  // Marker on network failed
  property  CanSend  : Boolean    read GetCanSend;   // Service can send    data
  property  CanRecv  : Boolean    read GetCanRecv;   // Service can receive data
 public
  property  Items    : TDimAccess read GetItems;     // General data access
  property  RecvData : LongString read GetRecvData;  // Receiver raw data buffer
  property  RecvWhen : Int64      read GetRecvWhen;  // When data received, ms
 public
  function  FailMarkReceived:Boolean;                // FailMark if disconnected
 public
  function  Send(aData:LongString):Integer; overload;             // Send string
  function  Send(aData:Pointer; aSize:Integer):Integer; overload; // Send buffer
 public // Linked user data for any purpose.
  property  LinkedObjects[i:Integer]:TObject read GetLinkedObjects write SetLinkedObjects;
  property  LinkedStrings[i:Integer]:LongString read GetLinkedStrings write SetLinkedStrings;
  property  LinkedParams[i:Integer]:Variant read GetLinkedParams write SetLinkedParams;
 public // Validation functions
  class function  ValidServKind(aKind:Integer):Boolean;    // Check service kind
  class function  ValidServName(aName:LongString):Boolean; // Check service name
  class function  ValidServForm(aForm:LongString):Boolean; // Check data format
  class function  ValidMoniType(aType:Integer):Boolean;    // Check monitor type
  class function  ValidMoniTime(aTime:Integer):Boolean;    // Check monitor time
 end;
 TDimAgent = class(TLatch)
 private
  myTid         : Integer;
  myList        : TStringList;
  myHash        : THashList;
  myPadding     : Boolean;
  myVerbose     : Boolean;
  myDnsNode     : LongString;
  myTaskName    : LongString;
  myDimSrvExe   : LongString;
  myRxBuffer    : LongString;
  myLostData    : Int64;
  myDnsVerNum   : Integer;
  myLineHandler : TDimAgentLineHandler;
  myLastWdog    : Int64;
  myLastTick    : Int64;
  myWatchdog    : Integer;
  myProcPrio    : TProcessPriority;
  myPipePrio    : TThreadPriority;
  myPipeSize    : Integer;
  mySrvMemory   : Int64;
  mySrvErrors   : Int64;
  mySrvTicks    : Int64;
  function  GetTid:Integer;
  function  GetPid:Integer;
  function  GetCount:Integer;
  function  GetRunning:Boolean;
  function  GetPadding:Boolean;
  procedure SetPadding(aPadding:Boolean);
  function  GetVerbose:Boolean;
  procedure SetVerbose(aVerbose:Boolean);
  function  GetDnsVerNum:Integer;
  function  GetDnsNode:LongString;
  procedure SetDnsNode(aNode:LongString);
  function  GetTaskName:LongString;
  function  GetRunningStr:LongString;
  function  GetServices(i:Integer):TDimService;
  function  InsertService(aService:TDimService):Integer;
  function  DeleteService(aService:TDimService):Boolean;
  function  Task_Readln(tid:Integer; out Line:LongString; var Buff:LongString):Boolean;
  procedure Trouble(aMessage:LongString);
  function  GetLostData:Int64;
  procedure DataLost(aSize:Integer);
  function  GetWatchdog:Integer;
  procedure SetWatchdog(aWatchdog:Integer);
  function  GetProcPrio:TProcessPriority;
  procedure SetProcPrio(aPrio:TProcessPriority);
  function  GetPipePrio:TThreadPriority;
  procedure SetPipePrio(aPrio:TThreadPriority);
  function  GetPipeSize:Integer;
  procedure SetPipeSize(aSize:Integer);
  function  GetSrvMemory:Int64;
  function  GetSrvErrors:Int64;
  function  GetSrvTicks:Int64;
  procedure LineHandler(const Line:LongString);
 public
  constructor Create;
  destructor  Destroy; override;
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
 public
  procedure FreeServices;
  procedure StopServer(aTimeOut:Integer=1000);
  function  StartServer(aDns:LongString=''; aTask:LongString=''):Boolean;
  function  RestartServer(aDns:LongString=''; aTask:LongString=''):Boolean;
  function  PollServer(out aService:TDimService):Boolean;
 public
  function  Find(aServName:LongString):TDimService;
 public
  function  NewService(aKind:Integer; aName,aForm:LongString;
              aMoniType,aMoniTime:Integer; aFailMark:LongString=''):TDimService;
 public
  property  Tid:Integer                     read GetTid;
  property  Pid:Integer                     read GetPid;
  property  Count:Integer                   read GetCount;
  property  Running:Boolean                 read GetRunning;
  property  Padding:Boolean                 read GetPadding  write SetPadding;
  property  DnsVerNum:Integer               read GetDnsVerNum;
  property  DnsVersionNumber:Integer        read GetDnsVerNum;
  property  DnsNode:LongString              read GetDnsNode  write SetDnsNode;
  property  TaskName:LongString             read GetTaskName ;
  property  Services[i:Integer]:TDimService read GetServices; default;
  property  RunningStr:LongString           read GetRunningStr;
  property  LostData:Int64                  read GetLostData;
  property  Verbose:Boolean                 read GetVerbose   write SetVerbose;
  property  Watchdog:Integer                read GetWatchdog  write SetWatchdog;
  property  ProcPrio:TProcessPriority       read GetProcPrio  write SetProcPrio;
  property  PipePrio:TThreadPriority        read GetPipePrio  write SetPipePrio;
  property  PipeSize:Integer                read GetPipeSize  write SetPipeSize;
  property  SrvMemory:Int64                 read GetSrvMemory;
  property  SrvErrors:Int64                 read GetSrvErrors;
  property  SrvTicks:Int64                  read GetSrvTicks;
 public
  function  DimSrvExe(aMode:Integer=1):LongString;
  function  DimSrvArg(aDns,aTask,aPadding:LongString):LongString;
 public // Customization callback: input data line(s) handler
  function SetLineHandler(aHandler:TDimAgentLineHandler):TDimAgentLineHandler;
 private
  class var TheDefProcPrio:TProcessPriority;
  class function GetDefProcPrio:TProcessPriority; static;
  class procedure SetDefProcPrio(aPrio:TProcessPriority); static;
  class var TheDefPipePrio:TThreadPriority;
  class function GetDefPipePrio:TThreadPriority; static;
  class procedure SetDefPipePrio(aPrio:TThreadPriority); static;
  class var TheDefPipeSize:Integer;
  class function GetDefPipeSize:Integer; static;
  class procedure SetDefPipeSize(aSize:Integer); static;
  class var TheDefWatchdog:Integer;
  class function GetDefWatchdog:Integer; static;
  class procedure SetDefWatchdog(aWatchdog:Integer); static;
  class var TheDefFailMark:LongString;
  class function GetDefFailMark:LongString; static;
  class procedure SetDefFailMark(aFailMark:LongString); static;
 public
  class property DefProcPrio:TProcessPriority read GetDefProcPrio write SetDefProcPrio;
  class property DefPipePrio:TThreadPriority  read GetDefPipePrio write SetDefPipePrio;
  class property DefPipeSize:Integer          read GetDefPipeSize write SetDefPipeSize;
  class property DefWatchdog:Integer          read GetDefWatchdog write SetDefWatchdog;
  class property DefFailMark:LongString       read GetDefFailMark write SetDefFailMark;
 end;

procedure Kill(var TheObject:TDimAgent); overload;

 ////////////////////////////////////////////////
 // DimAgent is the general instance of TDimAgent
 ////////////////////////////////////////////////
function DimAgent:TDimAgent;

 ///////////////////////////////////////////////////////////////////////
 // Default handler to print messages on receive data lines from dimsrv.
 ///////////////////////////////////////////////////////////////////////
procedure DefaultDimAgentLineHandler(Agent:TDimAgent; const Line:LongString);

 ///////////////////////////////////////////////////////////////////////////////
 // Demo and Tester procedures for DimAgent to illustrate simplified DIM API. //
 // The DimAgent use DIM server (dimsrv.exe) to communicate with DIM network. //
 ///////////////////////////////////////////////////////////////////////////////
 // This demo assume using server DimTree.exe, menu Setup\Tools\Dim Server Test.
 // Run server and call DimAgentDemoTesterStart and poll DimAgentDemoTesterPoll.
 //
 // DimAgentDemoTesterStart - DimAgent tester: Start testing.
 //                           Specify valid DNS & task name to run the test.
 // DimAgentDemoTesterStop  - DimAgent tester: Stop testing.
 // DimAgentDemoTesterPoll  - DimAgent tester: Polling Loop.
 ///////////////////////////////////////////////////////////////////////////////

procedure DimAgentDemoTesterStart(aDns:LongString='localhost';
                                 aTask:LongString='DIMTEST');
procedure DimAgentDemoTesterStop;
procedure DimAgentDemoTesterPoll;

implementation

 /////////////
 // TDimAccess
 /////////////
constructor TDimAccess.Create(aParent:TDimService; aFormat:LongString);
begin
 inherited Create;
 myParent:=aParent;
 mySpec:=nil;
 myCount:=nil;
 myOffset:=nil;
 myFormat:=Trim(UpperCase(aFormat));
 myStatus:=0;
 myBuffer:='';
end;

destructor  TDimAccess.Destroy;
begin
 mySpec:=nil;
 myCount:=nil;
 myOffset:=nil;
 myFormat:='';
 myBuffer:='';
 inherited Destroy;
end;

procedure TDimAccess.AfterConstruction;
begin
 inherited;
 Cleanup;
 Parse;
end;

procedure TDimAccess.BeforeDestruction;
begin
 Cleanup;
 inherited;
end;

procedure TDimAccess.Cleanup;
begin
 if Assigned(Self) then begin
  SetLength(mySpec,0);
  SetLength(myCount,0);
  SetLength(myOffset,0);
 end;
end;

procedure TDimAccess.Parse;
begin
 if Assigned(Self) then myStatus:=ParseFormat;
end;

procedure TDimAccess.FixError;
begin
 if Assigned(Self) then Inc(myErrors);
end;

function TDimAccess.AcceptData:Boolean;
begin
 Result:=false;
 if Assigned(Self) then begin
  myBuffer:=Parent.RecvData;
  Result:=(myBuffer<>'');
  myErrors:=0;
  myIsValid:=(DataSize>0) and (DataSize>=FormSize)
 end;
end;

function TDimAccess.Parent:TDimService;
begin
 if Assigned(Self)
 then Result:=myParent
 else Result:=nil;
end;

function TDimAccess.Buffer:LongString;
begin
 if Assigned(Self)
 then Result:=myBuffer
 else Result:='';
end;

function TDimAccess.DataPtr:PChar;
begin
 if Assigned(Self)
 then Result:=Pointer(myBuffer)
 else Result:='';
end;

function TDimAccess.DataSize:Integer;
begin
 if Assigned(Self)
 then Result:=Length(myBuffer)
 else Result:=0;
end;

function TDimAccess.FormSize:Integer;
begin
 if Assigned(Self)
 then Result:=Offset(Count)
 else Result:=0;
end;

function TDimAccess.TailSize:Integer;
begin
 if Assigned(Self)
 then Result:=(DataSize-FormSize)
 else Result:=0;
end;

function TDimAccess.TailCount:Integer;
begin
 if Assigned(Self) and (SpecSize(TailSpec)>0)
 then Result:=(TailSize div SpecSize(TailSpec))
 else Result:=0;
end;

function TDimAccess.TailSpec:Char;
begin
 if Assigned(Self)
 then Result:=GetSpec(Count-1)
 else Result:='?';
end;

function TDimAccess.IsValid:Boolean;
begin
 if Assigned(Self)
 then Result:=myIsValid
 else Result:=false;
end;

function  TDimAccess.FormStatus:Integer;
begin
 if Assigned(Self)
 then Result:=myStatus
 else Result:=0;
end;

function TDimAccess.GetSpec(i:Integer):Char;
begin
 Result:='?';
 if Assigned(Self) then begin
  if InRange(i,0,High(mySpec)) then Result:=mySpec[i];
  if (SpecSize(Result)<=0) then Result:='?';
  if (Result='?') then FixError;
 end;
end;

function TDimAccess.Count(i:Integer=-1):Integer;
begin
 Result:=0;
 if Assigned(Self) then
 if (i=-1) then Result:=Length(myCount) else
 if InRange(i,0,High(myCount))
 then Result:=myCount[i]
 else FixError;
end;

function TDimAccess.Offset(i:Integer):Integer;
begin
 Result:=0;
 if Assigned(Self) then
 if InRange(i,0,High(myOffset))
 then Result:=myOffset[i]
 else FixError;
end;

function TDimAccess.GetItem(i:Integer):TDimDataItem;
begin
 Result.C:=nil;
 if Assigned(Self) then
 if IsValid and InRange(i,0,High(myCount))
 then Result.C:=PChar(myBuffer)+myOffset[i]
 else FixError;
end;

function  TDimAccess.ParseFormat:Integer;
var List:TStringList; sn,sv:LongString;
var i,p,n,offs:Integer; last:Boolean;
begin
 Result:=0;
 if Assigned(Self) then
 try
  Cleanup;
  if IsEmptyStr(myFormat) then Exit;                // Empty format is invalid
  List:=TStringList.Create;
  try
   List.Delimiter:=';';                             // Format has ; delimiter
   List.DelimitedText:=myFormat;                    // Parse ; delimited text
   for i:=List.Count-1 downto 0 do                  // Preliminary Loop:
   if IsEmptyStr(List[i]) then List.Delete(i);      // Delete empty items
   SetLength(mySpec,List.Count);                    // List of specifiers
   SetLength(myCount,List.Count);                   // List of counts
   SetLength(myOffset,List.Count+1);                // List of offsets
   for i:=0 to List.Count-1 do begin                // Loop:
    p:=ExtractNameValuePair(List[i],sn,sv,':',0);   // Parse sn:sv token
    if (sn='') or (p>2) then Break;                 // Pos of : in [0,2]
    mySpec[i]:=StrFetch(sn,1);                      // Format specifier char
    if (SpecSize(mySpec[i])<=0) then Break;         // Format char is valid?
    if (p>0) then n:=StrToIntDef(sv,0) else n:=1;   // Repeater number
    if (n<1) or (n>DimMaxFormRepeater) then Break;  // Repeater invalid
    myCount[i]:=n; last:=(i=List.Count-1);          // It's last list item?
    if last and (p=0) then Inc(Result);             // Mark format as opened
    if last then Inc(Result);                       // Mark format is valid
   end;
   if (Result=0) then Cleanup;                      // 0:bad,1:closed,2:opened
   if (Length(mySpec)<>Count) then Cleanup;         // Check length - offset
   if (Length(myOffset)<>Count+1) then Cleanup;     // Check length - offset
   offs:=0;                                         // Calculate data offset
   for i:=0 to Count-1 do begin                     // For all items:
    myOffset[i]:=offs;                              // Data item offset
    n:=SpecSize(mySpec[i]);                         // Specifier size
    n:=n*myCount[i];                                // Apply repeater
    Inc(offs,n);                                    // Save offset
   end;
   myOffset[Count]:=offs;                           // Data size by format
  finally
   List.Free;
  end;
 except
  on E:Exception do BugReport(E,nil,'ParseFormat');
 end;
end;

function TDimAccess.Errors:Integer;
begin
 if Assigned(Self)
 then Result:=myErrors
 else Result:=0;
end;

function  TDimAccess.Table:LongString;
var List:TStringList; i:Integer; Line:LongString;
begin
 Result:='';
 try
  List:=TStringList.Create;
  try
   for i:=0 to Count-1 do begin
    Line:=Format('%s : %-5d %-5d',[Spec[i],Count(i),Offset(i)]);
    List.Add(Line);
   end;
   if (Count>0) then List.Add('Size: '+IntToStr(FormSize));
   Result:=List.Text;
  finally
   List.Free;
  end;
 except
  on E:Exception do BugReport(E,nil,'ParseFormat');
 end;
end;

class function TDimAccess.SpecSize(c:Char):Integer;
begin
 case UpCase(c) of
  'C' : Result:=SizeOf(Char);
  'D' : Result:=SizeOf(Double);
  'F' : Result:=SizeOf(Single);
  'I' : Result:=SizeOf(Integer);
  'L' : Result:=SizeOf(LongInt);
  'S' : Result:=SizeOf(SmallInt);
  'X' : Result:=SizeOf(Int64);
  else  Result:=0;
 end;
end;

 //////////////
 // TDimService
 //////////////

constructor TDimService.Create(aAgent:TDimAgent; aKind:Integer; aName,aForm:LongString;
                               aMoniType,aMoniTime:Integer; aFailMark:LongString);
begin
 inherited Create;
 myAgent:=aAgent;
 myServKind:=aKind;
 myServName:=Trim(aName);
 myServForm:=Trim(UpperCase(aForm));
 myMoniType:=aMoniType;
 myMoniTime:=aMoniTime;
 if (aFailMark<>'')
 then myFailMark:=aFailMark
 else myFailMark:=TDimAgent.DefFailMark;
 myRecvData:='';
 myItems:=TDimAccess.Create(Self,ServForm);
 myItems.Master:=@myItems;
 ClearLinkedData;
end;

destructor TDimService.Destroy;
begin
 myItems.Free;
 myServName:='';
 myServForm:='';
 myRecvData:='';
 myFailMark:='';
 ClearLinkedData;
 inherited Destroy;
end;

procedure TDimService.AfterConstruction;
begin
 inherited;
 InitIdent;
end;

procedure TDimService.BeforeDestruction;
begin
 FreeIdent;
 inherited;
end;

function  TDimService.GetItems:TDimAccess;
begin
 if Assigned(Self)
 then Result:=myItems
 else Result:=nil;
end;

function  TDimService.GetIdent:Integer;
begin
 if Assigned(Self)
 then Result:=myIdent
 else Result:=0;
end;

function  TDimService.GetAgent:TDimAgent;
begin
 if Assigned(Self)
 then Result:=myAgent
 else Result:=nil;
end;

function  TDimService.GetServKind:Integer;
begin
 if Assigned(Self)
 then Result:=myServKind
 else Result:=0;
end;

function  TDimService.GetKindName:LongString;
begin
 if Assigned(Self)
 then Result:=ExtractWord(myServKind,DimKindList,ScanSpaces)
 else Result:='';
end;

function  TDimService.GetServName:LongString;
begin
 if Assigned(Self)
 then Result:=myServName
 else Result:='';
end;

function  TDimService.GetServForm:LongString;
begin
 if Assigned(Self)
 then Result:=myServForm
 else Result:='';
end;

function  TDimService.GetRecvData:LongString;
begin
 if Assigned(Self)
 then Result:=myRecvData
 else Result:='';
end;

function  TDimService.GetRecvWhen:Int64;
begin
 if Assigned(Self)
 then Result:=myRecvWhen
 else Result:=0;
end;

function  TDimService.GetMoniType:Integer;
begin
 if Assigned(Self)
 then Result:=myMoniType
 else Result:=0;
end;

function  TDimService.GetMoniName:LongString;
begin
 Result:='';
 if Assigned(Self) then
 case MoniType of
  timed     : Result:=ExtractWord(1,DimMoniList,ScanSpaces);
  monitored : Result:=ExtractWord(2,DimMoniList,ScanSpaces);
 end;
end;

function  TDimService.GetMoniTime:Integer;
begin
 if Assigned(Self)
 then Result:=myMoniTime
 else Result:=0;
end;

function  TDimService.GetFailMark:LongString;
begin
 if Assigned(Self)
 then Result:=myFailMark
 else Result:='';
end;

function TDimService.GetCanSend:Boolean;
begin
 if Assigned(Self)
 then Result:=(myServKind in [dis_info,dic_cmnd])
 else Result:=false;
end;

function TDimService.GetCanRecv:Boolean;
begin
 if Assigned(Self)
 then Result:=(myServKind in [dic_info,dis_cmnd])
 else Result:=false;
end;

function TDimService.AcceptData(aWhen:Int64; aWhat:LongString):Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 if CanRecv then begin
  myRecvWhen:=aWhen;
  myRecvData:=aWhat;
  Result:=myItems.AcceptData;
 end else begin
  Agent.DataLost(Length(aWhat));
 end;
end;

procedure  TDimService.InitIdent;
begin
 if Assigned(Self) then myIdent:=Agent.InsertService(Self);
end;

procedure  TDimService.FreeIdent;
begin
 if Assigned(Self) then begin
  if Agent.DeleteService(Self)
  then myIdent:=0;
 end;
end;

procedure TDimService.ClearLinkedData;
var i:Integer;
begin
 if Assigned(Self) then
 for i:=Low(myLinked) to High(myLinked) do begin
  myLinked[i].Par:=Unassigned;
  myLinked[i].Obj:=nil;
  myLinked[i].Str:='';
 end;
end;

function  TDimService.GetLinkedObjects(i:Integer):TObject;
begin
 if Assigned(Self) and InRange(i,Low(myLinked),High(myLinked))
 then Result:=myLinked[i].Obj
 else Result:=nil;
end;

procedure TDimService.SetLinkedObjects(i:Integer; Obj:TObject);
begin
 if Assigned(Self) and InRange(i,Low(myLinked),High(myLinked))
 then myLinked[i].Obj:=Obj;
end;

function  TDimService.GetLinkedStrings(i:Integer):LongString;
begin
 begin
  if Assigned(Self) and InRange(i,Low(myLinked),High(myLinked))
  then Result:=myLinked[i].Str
  else Result:='';
 end;
end;

procedure TDimService.SetLinkedStrings(i:Integer; Data:LongString);
begin
 if Assigned(Self) and InRange(i,Low(myLinked),High(myLinked))
 then myLinked[i].Str:=Data;
end;

function  TDimService.GetLinkedParams(i:Integer):Variant;
begin
 begin
  if Assigned(Self) and InRange(i,Low(myLinked),High(myLinked))
  then Result:=myLinked[i].Par
  else Result:=Unassigned;
 end;
end;

procedure TDimService.SetLinkedParams(i:Integer; Data:Variant);
begin
 if Assigned(Self) and InRange(i,Low(myLinked),High(myLinked))
 then myLinked[i].Par:=Data;
end;

function  TDimService.Send(aData:LongString):Integer;
begin
 if Assigned(Self)
 then Result:=Send(Pointer(aData),Length(aData))
 else Result:=0;
end;

function TDimService.Send(aData:Pointer; aSize:Integer):Integer;
var Buff,Line:LongString;
begin
 Result:=0;
 if Assigned(Self) then
 if Assigned(aData) and (aSize>0) then
 try
  if (Agent.Tid<>0) and CanSend then begin
   Buff:=StringBuffer(aData,aSize);
   Line:=Format('#%d=%s',[Ident,base64_encode(Buff)]);
   Result:=Task_Send(Agent.Tid,Line+EOL);
   if (Result=0) then Agent.DataLost(Length(Buff));
  end;
 except
  on E:Exception do BugReport(E,Self,'Send');
 end;
end;

function TDimService.FailMarkReceived:Boolean;
begin
 if Assigned(Self)
 then Result:=CanRecv and (RecvData<>'') and (RecvData=FailMark)
 else Result:=false;
end;

class function TDimService.ValidServKind(aKind:Integer):Boolean;
begin
 Result:=(aKind in DimGoodKind);
end;

class function TDimService.ValidServName(aName:LongString):Boolean;
begin
 Result:=true;
 if IsEmptyStr(aName) then Exit(false);
 if HasChars(aName,[#0..' ',#128..#255]) then Exit(false);
 if HasChars(Copy(aName,1,1),['+','-','!','@']) then Exit(false);
end;

class function TDimService.ValidServForm(aForm:LongString):Boolean;
var TestItems:TDimAccess;
begin
 Result:=true;
 try
  aForm:=Trim(UpperCase(aForm));
  if IsEmptyStr(aForm) then Exit(false);
  if HasChars(aForm,[#0..#255]-StringToSetOfChars(DimGoodForm)) then Exit(false);
  TestItems:=TDimAccess.Create(nil,aForm);
  Result:=(TestItems.FormStatus>0);
  TestItems.Free;
 except
  on E:Exception do BugReport(E,nil,'ValidServForm');
 end;
end;

class function TDimService.ValidMoniType(aType:Integer):Boolean;
begin
 Result:=(aType in DimGoodMoni);
end;

class function TDimService.ValidMoniTime(aTime:Integer):Boolean;
begin
 Result:=(aTime>0);
end;

procedure Kill(var TheObject:TDimService); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

 ////////////
 // TDimAgent
 ////////////

constructor TDimAgent.Create;
begin
 inherited Create;
 myList:=TStringList.Create;
 myHash:=NewHashList(false,HashList_DefaultHasher);
 myHash.Master:=@myHash;
 myTid:=0;
 myDnsNode:='';
 myRxBuffer:='';
 myTaskName:='';
 myDimSrvExe:='';
 myLastWdog:=0;
 Watchdog:=DefWatchdog;
 SetLineHandler(DefaultDimAgentLineHandler);
 myProcPrio:=DefProcPrio;
 myPipePrio:=DefPipePrio;
 myPipeSize:=DefPipeSize;
end;

destructor TDimAgent.Destroy;
begin
 FreeServices;
 Kill(myList);
 Kill(myHash);
 myDnsNode:='';
 myRxBuffer:='';
 myTaskName:='';
 myDimSrvExe:='';
 inherited Destroy;
end;

procedure TDimAgent.AfterConstruction;
begin
 inherited;
end;

procedure TDimAgent.BeforeDestruction;
begin
 StopServer;
 inherited;
end;

function TDimAgent.GetTid:Integer;
begin
 if Assigned(Self)
 then Result:=myTid
 else Result:=0;
end;

function TDimAgent.GetPid:Integer;
begin
 if Assigned(Self)
 then Result:=task_pid(myTid)
 else Result:=0;
end;

function TDimAgent.GetCount:Integer;
begin
 if Assigned(Self)
 then Result:=myList.Count
 else Result:=0;
end;

function TDimAgent.GetRunning:Boolean;
begin
 if Assigned(Self)
 then Result:=task_wait(myTid,0)
 else Result:=false;
end;

function TDimAgent.GetRunningStr:LongString;
begin
 if Assigned(Self)
 then Result:=ExtractWord(1+Ord(Running),'stopped,running',ScanSpaces)
 else Result:='';
end;

function TDimAgent.GetPadding:Boolean;
begin
 if Assigned(Self)
 then Result:=myPadding
 else Result:=false;
end;

procedure TDimAgent.SetPadding(aPadding:Boolean);
begin
 if Assigned(Self) then myPadding:=aPadding;
end;

function TDimAgent.GetVerbose:Boolean;
begin
 if Assigned(Self)
 then Result:=myVerbose
 else Result:=false;
end;

procedure TDimAgent.SetVerbose(aVerbose:Boolean);
begin
 if Assigned(Self) then myVerbose:=aVerbose;
end;

function TDimAgent.GetDnsVerNum:Integer;
begin
 if Assigned(Self)
 then Result:=myDnsVerNum
 else Result:=0;
end;

function TDimAgent.GetServices(i:Integer):TDimService;
var Obj:TObject;
begin
 if Assigned(Self) and InRange(i,0,myList.Count-1)
 then Obj:=myList.Objects[i]
 else Obj:=nil;
 if (Obj is TDimService)
 then Result:=TDimService(Obj)
 else Result:=nil;
end;

function TDimAgent.GetDnsNode:LongString;
begin
 if Assigned(Self)
 then Result:=myDnsNode
 else Result:='';
 if Assigned(Self) and (Result='')
 then Result:=GetEnv('DIM_DNS_NODE');
end;

procedure TDimAgent.SetDnsNode(aNode:LongString);
begin
 if Assigned(Self) then begin
  aNode:=Trim(aNode);
  if (aNode='.') then aNode:='localhost';
  myDnsNode:=aNode;
 end;
end;

function TDimAgent.GetTaskName:LongString;
begin
 if Assigned(Self)
 then Result:=myTaskName
 else Result:='';
end;

function task_lost(tid:Integer):Int64;
begin
 Result:=StrToInt64Def(task_ctrl(tid,'TxLost'),0)
        +StrToInt64Def(task_ctrl(tid,'RxLost'),0)
        +StrToInt64Def(task_ctrl(tid,'ExLost'),0);
end;

function  TDimAgent.GetLostData:Int64;
begin
 if Assigned(Self)
 then Result:=myLostData+task_lost(tid)
 else Result:=0;
end;

procedure  TDimAgent.DataLost(aSize:Integer);
begin
 if Assigned(Self) then Inc(myLostData,aSize);
end;

function  TDimAgent.GetWatchdog:Integer;
begin
 if Assigned(Self)
 then Result:=myWatchdog
 else Result:=0;
end;

procedure  TDimAgent.SetWatchdog(aWatchdog:Integer);
begin
 if Assigned(Self) then begin
  aWatchdog:=EnsureRange(aWatchdog,0,300);
  myWatchdog:=aWatchdog;
 end;
end;

function  TDimAgent.GetProcPrio:TProcessPriority;
begin
 if Assigned(Self)
 then Result:=myProcPrio
 else Result:=ppNormal;
end;

procedure  TDimAgent.SetProcPrio(aPrio:TProcessPriority);
begin
 if Assigned(Self) then myProcPrio:=aPrio;
end;

function  TDimAgent.GetPipePrio:TThreadPriority;
begin
 if Assigned(Self)
 then Result:=myPipePrio
 else Result:=tpNormal;
end;

procedure  TDimAgent.SetPipePrio(aPrio:TThreadPriority);
begin
 if Assigned(Self) then myPipePrio:=aPrio;
end;

function  TDimAgent.GetPipeSize:Integer;
begin
 if Assigned(Self)
 then Result:=myPipeSize
 else Result:=0;
end;

procedure  TDimAgent.SetPipeSize(aSize:Integer);
begin
 if Assigned(Self) then begin
  aSize:=EnsureRange(aSize,OS_PIPE_BUF,OS_PIPE_BUF*KiloByte);
  aSize:=AdjustBufferSize(aSize,KiloByte);
  myPipeSize:=aSize;
 end;
end;

function  TDimAgent.GetSrvMemory:Int64;
begin
 if Assigned(Self)
 then Result:=mySrvMemory
 else Result:=0;
end;

function  TDimAgent.GetSrvErrors:Int64;
begin
 if Assigned(Self)
 then Result:=mySrvErrors
 else Result:=0;
end;

function  TDimAgent.GetSrvTicks:Int64;
begin
 if Assigned(Self)
 then Result:=mySrvTicks
 else Result:=0;
end;

function TDimAgent.Find(aServName:LongString):TDimService;
var I:Integer; Obj:TObject;
begin
 if Assigned(Self)
 then I:=myHash.KeyedLinks[aServName]-1
 else I:=-1;
 if (I<0) then
 if Assigned(Self)
 then I:=myList.IndexOf(aServName)
 else I:=-1;
 if (I>=0)
 then Obj:=myList.Objects[I]
 else Obj:=nil;
 if (Obj is TDimService)
 then Result:=TDimService(Obj)
 else Result:=nil;
end;

function TDimAgent.NewService(aKind:Integer; aName,aForm:LongString;
              aMoniType,aMoniTime:Integer; aFailMark:LongString=''):TDimService;
begin
 Result:=nil;
 try
  if not Assigned(Find(aName)) then
  if TDimService.ValidServKind(aKind) then
  if TDimService.ValidServName(aName) then
  if TDimService.ValidServForm(aForm) then
  if TDimService.ValidMoniType(aMoniType) then
  if TDimService.ValidMoniTime(aMoniTime) then
  Result:=TDimService.Create(Self,aKind,aName,aForm,aMoniType,aMoniTime,aFailMark);
  if Assigned(Result) and (Result.Ident<=0) then Kill(Result);
 except
  on E:Exception do BugReport(E,nil,'NewService');
 end;
end;

function TDimAgent.InsertService(aService:TDimService):Integer;
var i:Integer;
begin
 Result:=0;
 if Assigned(Self) then
 if Assigned(aService) then
 try
  if (myList.IndexOf(aService.ServName)<0) then begin
   i:=myList.IndexOf('');
   if (i>=0) and (myList.Objects[i]=nil) then begin
    myList.Strings[i]:=aService.ServName;
    myList.Objects[i]:=aService;
    Result:=i+1;
   end else begin
    i:=myList.AddObject(aService.ServName,aService);
    Result:=i+1;
   end;
   if (Result>0) then myHash.KeyedLinks[aService.ServName]:=Result;
  end;
 except
  on E:Exception do BugReport(E,Self,'InsertService');
 end;
end;

function  TDimAgent.DeleteService(aService:TDimService):Boolean;
var i:Integer;
begin
 Result:=false;
 if Assigned(Self) then
 if Assigned(aService) then
 try
  i:=aService.Ident-1;
  if InRange(i,0,myList.Count-1) then
  if (myList.Objects[i]=aService) then begin
   myList.Objects[i]:=nil;
   myList.Strings[i]:='';
   Result:=true;
  end;
  if Result then myHash.Delete(aService.ServName);
 except
  on E:Exception do BugReport(E,Self,'DeleteService');
 end;
end;

procedure TDimAgent.StopServer(aTimeOut:Integer=1000);
begin
 if Assigned(Self) then
 try
  if (tid<>0) then begin
   if task_wait(tid,0) then begin
    task_send(tid,'@exit'+EOL); task_wait(tid,aTimeOut);  // Try normal @Exit
    if task_wait(tid,0) then task_kill(tid,1,0,aTimeOut); // Try apply  Close
    if task_wait(tid,0) then task_kill(tid,0,0,aTimeOut); // Try terminate
   end;
   task_free(tid);
   myTid:=0;
  end;
 except
  on E:Exception do BugReport(E,Self,'StopServer');
 end;
end;

procedure TDimAgent.FreeServices;
var i:Integer;
begin
 if Assigned(Self) then
 try
  StopServer;
  for i:=myList.Count-1 downto 0 do
  if Assigned(myList.Objects[i]) then begin
   TObject(myList.Objects[i]).Free;
   myList.Objects[i]:=nil;
   myList.Strings[i]:='';
  end;
 except
  on E:Exception do BugReport(E,Self,'FreeServices');
 end;
end;

function TDimAgent.DimSrvArg(aDns,aTask,aPadding:LongString):LongString;
begin
 Result:='';
 if Assigned(Self) then
 try
  if SameText(aPadding,'0') then aPadding:='';
  if IsNonEmptyStr(aDns) then Result:=Result+' -dns '+Trim(aDns);
  if IsNonEmptyStr(aTask) then Result:=Result+' -task '+Trim(aTask);
  if IsNonEmptyStr(aPadding) then Result:=Result+' -padding '+Trim(aPadding);
  if (Result<>'') then Result:=Trim(Result);
 except
  on E:Exception do BugReport(E,Self,'DimSrvArgs');
 end;
end;

function TDimAgent.StartServer(aDns:LongString=''; aTask:LongString=''):Boolean;
var exe,arg,cmd,msg:LongString; i:Integer; serv:TDimService;
begin
 Result:=false;
 if Assigned(Self) then
 try
  mySrvTicks:=0; // Reset ticks
  aDns:=Trim(aDns); aTask:=Trim(aTask);
  if IsEmptyStr(aDns) then aDns:=DnsNode;
  if IsEmptyStr(aTask) then aTask:=TaskName;
  if IsEmptyStr(DnsNode) then myDnsNode:=aDns;
  if IsEmptyStr(TaskName) then myTaskName:=aTask;
  // Same task is already running?
  if SameText(aDns,DnsNode) then
  if SameText(aTask,TaskName) then
  if task_wait(myTid,0) then Exit(true);
  StopServer; // If server is running - restart.
  if not SameText(DnsNode,aDns) then myDnsNode:=aDns;
  if not SameText(TaskName,aTask) then myTaskName:=aTask;
  exe:=DimSrvExe;
  arg:=DimSrvArg(aDns,aTask,IntToStr(Ord(Padding)));
  cmd:=Trim(exe+' '+arg);
  myTid:=task_init(cmd);
  task_ctrl(myTid,'Display=0');
  task_ctrl(myTid,'StdInpPipeSize='+IntToStr(PipeSize));
  task_ctrl(myTid,'StdOutPipeSize='+IntToStr(PipeSize));
  task_ctrl(myTid,'StdInpPriority='+ThreadPriorityToString(PipePrio));
  task_ctrl(myTid,'StdOutPriority='+ThreadPriorityToString(PipePrio));
  task_ctrl(myTid,'ProcessPriority='+ProcessPriorityToString(ProcPrio));
  if task_run(myTid) then begin
   if IsWindows then begin // On Win cmdline not work yet
    task_send(tid,'@padding='+IntToStr(Ord(Padding))+EOL);
    task_send(tid,'@dnsnode='+DnsNode+EOL);
   end;
   for i:=0 to myList.Count-1 do begin
    Serv:=Services[i];
    if Assigned(Serv) then with Serv do begin
     msg:=Format('+%d=%s,%s,%s,%s,%d,%s',
                [Ident,KindName,ServName,ServForm,MoniName,MoniTime,
                 base64_encode(FailMark)]);
     task_send(myTid,msg+EOL);
    end;
   end;
   task_send(tid,'@start='+TaskName+EOL);
  end;
  Result:=task_wait(myTid,0);
 except
  on E:Exception do BugReport(E,Self,'StartServer');
 end;
end;

function TDimAgent.RestartServer(aDns:LongString=''; aTask:LongString=''):Boolean;
begin
 Result:=false;
 if Assigned(Self) then begin
  StopServer; // Stop if running
  Result:=StartServer(aDns,aTask);
 end;
end;

function TDimAgent.DimSrvExe(aMode:Integer):LongString;
const AllDrives='C: D: E: F: G: H: I: J: K: L: M: N: O: P: Q: R: S: T: U: V: W: X: Y: Z:';
var exe,dir,list,dimdir:LongString; i:Integer;
begin
 Result:='';
 if Assigned(Self) then
 try
  if IsUnix    then Result:='dimsrv';
  if IsWindows then Result:='DimSrv.exe';
  if (Result<>'') and (aMode>0) then begin
   if (myDimSrvExe<>'') and FileExists(ExtractFirstParam(myDimSrvExe))
   then begin Result:=myDimSrvExe; Exit; end;
   if IsUnix then begin
    if RunCommand('unix which dimsrv',exe) then
    if IsNonEmptyStr(exe) and FileExists(Trim(exe))
    then Result:=Trim(exe);
   end;
   if IsWindows then begin
    if IsEmptyStr(file_which('dim.dll')) then begin
     dimdir:=ExpEnv('%CommonProgramFiles%\CRW-DAQ\Resource\DimSite\dim\bin');
     if DirectoryExists(dimdir)
     then SetEnv('PATH',GetEnv('PATH')+PathSep+dimdir);
    end;
    dir:=GetEnv('CRW_DAQ_SYS_HOME_DIR');
    list:=ExpEnv('%SystemDrive% '+AllDrives);
    for i:=1 to WordCount(list,ScanSpaces) do begin
     if IsNonEmptyStr(dir) and DirectoryExists(dir) then Break;
     dir:=AddPathDelim(ExtractWord(i,list,ScanSpaces))+'Crw32exe';
     if not DirectoryExists(dir) then dir:='';
    end;
    if IsNonEmptyStr(dir) and DirectoryExists(dir) then begin
     Result:=AddPathDelim(dir)+'Resource\DaqSite\DimServer\DimSrv.exe';
     if IsEmptyStr(file_which('dim.dll')) then begin
      dimdir:=dir+'\Resource\DimSite\dim\bin';
      if DirectoryExists(dimdir) then SetEnv('PATH',GetEnv('PATH')+PathSep+dimdir);
     end;
    end;
   end;
   if IsWindows then Result:=AnsiQuotedIfNeed(Result);
   myDimSrvExe:=Result;
  end;
 except
  on E:Exception do BugReport(E,Self,'DimSrvExe');
 end;
end;

procedure TDimAgent.Trouble(aMessage:LongString);
begin
 LineHandler('@Trouble='+aMessage);
end;

 {
 Read line (Line) from task (tid) stdout pipe with CR or LF line terminator (EOL).
 Temporary buffer (Buff) should be global lifetime variable with startup initialization.
 }
function TDimAgent.Task_Readln(tid:Integer; out Line:LongString; var Buff:LongString):Boolean;
const MaxLeng=KiloByte*16;
var p:Integer;
begin
 Line:='';
 Task_Readln:=False;
 if (Task_Pid(tid)<>0) then begin
  if (Length(Buff)<MaxLeng) and (Task_RxCount(tid)>0)
  then Buff:=Buff+Task_Recv(tid,MaxLeng-Length(Buff));
  p:=PosEol(Buff,1,0);
  if (p>0) then begin
   Task_Readln:=True;
   if (p>1) then Line:=Copy(Buff,1,p-1);
   Buff:=Copy(Buff,PosEol(Buff,p,1),MaxInt);
  end else begin
   if (Length(Buff)>=MaxLeng) then begin
    Trouble('Received line is too long!');
    DataLost(Length(Buff));
    Buff:='';
   end;
  end;
 end;
end;

function TDimAgent.PollServer(out aService:TDimService):Boolean;
var Line,sn,sv:LongString; p,id:Integer; tm,wdt:Int64;
const CmdDnsVerNum='@DIS_DNS/VERSION_NUMBER';
begin
 Result:=false;
 aService:=nil;
 if Assigned(Self) then
 try
  // Receive data from server...
  if Task_Readln(Tid,Line,myRxBuffer) then      // Read line till EOL
  if (Line<>'') then                            // If has data, parse it
  case Line[1] of                               // Handle #,@ and others
   '#': begin                                   // Parse #n=base64(data)
    p:=ExtractNameValuePair(Line,sn,sv);        // Parse expression sn=sv
    if (p>2) then begin                         // If the '=' sign found
     id:=StrToIntDef(Copy(sn,2,p-2),0);         // Extract service ident
     if InRange(id,1,Count) then begin          // If ident looks valid
      aService:=Services[id-1];                 // fetch service object
      if Assigned(aService) then begin          // if object is valid
       sv:=base64_decode(sv);                   // decode base64 data
       tm:=intmsecnow;                          // get current time
       Result:=aService.AcceptData(tm,sv);      // try to accept data
       if not Result then DataLost(Length(sv)); // failed, data lost
      end;                                      // Done.
     end;
    end;
   end;
   '@': begin                                   // Handle @Commands:
    p:=ExtractNameValuePair(Line,sn,sv);        // Parse token sn=sv
    if SameText(sn,CmdDnsVerNum) then begin     // If it's DNS version
     myDnsVerNum:=StrToIntDef(sv,0);            // Save it for future
    end else
    if SameText(sn,'@Memory') then begin        // @Memory=m
     mySrvMemory:=StrToInt64Def(sv,0);          // Read value m
    end else
    if SameText(sn,'@Errors') then begin        // @Errors=n
     mySrvErrors:=StrToInt64Def(sv,0);          // Read value n
     Inc(mySrvTicks);                           // To notify "I'm still alive"
    end;
    LineHandler(Line);                          // Call line handler
   end;
   else LineHandler(Line);                      // Handle other lines
  end;
  // Watchdog timer: check
  // & restart if server die
  if (Watchdog>0) then begin                    // If Watchdog is active
   wdt:=GetTickCount64-myLastWdog;              // Get time since last check, ms
   if (wdt>=Int64(Watchdog)*1000) then begin    // If watchdog check time comes
    if (Pid<>0) and not Running then begin      // If started but not running
     StopServer; // Restart server              // then server died and we have
     StartServer(DnsNode,TaskName);             // to restart it again.
    end;
    myLastWdog:=GetTickCount64;                 // And save time of last check
   end;
  end;
  // Every second Ticks:
  // Notify server is still run
  tm:=GetTickCount64-myLastTick;                // Get time since last tick, ms
  if (tm>=1000) then begin                      // Ticks take place each second
   task_send(tid,'@Memory'+EOL+'@Errors'+EOL);  // Ask memory and error counter
   myLastTick:=GetTickCount64;                  // Remember last tick time
  end;
 except
  on E:Exception do BugReport(E,Self,'PollServer');
 end;
end;

procedure TDimAgent.LineHandler(const Line:LongString);
begin
 if Assigned(Self) then
 if Assigned(myLineHandler) then
 try
  myLineHandler(Self,Line);
 except
  on E:Exception do BugReport(E,Self,'LineHandler');
 end;
end;

function TDimAgent.SetLineHandler(aHandler:TDimAgentLineHandler):TDimAgentLineHandler;
begin
 Result:=nil;
 if Assigned(Self) then begin
  Result:=myLineHandler;
  myLineHandler:=aHandler;
 end;
end;

class function TDimAgent.GetDefProcPrio:TProcessPriority;
begin
 Result:=TheDefProcPrio;
end;

class procedure TDimAgent.SetDefProcPrio(aPrio:TProcessPriority);
begin
 TheDefProcPrio:=aPrio;
end;

class function TDimAgent.GetDefPipePrio:TThreadPriority;
begin
 Result:=TheDefPipePrio;
end;

class procedure TDimAgent.SetDefPipePrio(aPrio:TThreadPriority);
begin
 TheDefPipePrio:=aPrio;
end;

class function TDimAgent.GetDefPipeSize:Integer;
begin
 Result:=TheDefPipeSize;
end;

class procedure TDimAgent.SetDefPipeSize(aSize:Integer);
begin
 aSize:=EnsureRange(aSize,OS_PIPE_BUF,OS_PIPE_BUF*KiloByte);
 aSize:=AdjustBufferSize(aSize,KiloByte);
 TheDefPipeSize:=aSize;
end;

class function TDimAgent.GetDefWatchdog:Integer;
begin
 Result:=TheDefWatchdog;
end;

class procedure TDimAgent.SetDefWatchdog(aWatchdog:Integer);
begin
 aWatchdog:=EnsureRange(aWatchdog,0,300);
 TheDefWatchdog:=aWatchdog;
end;

class function TDimAgent.GetDefFailMark:LongString;
begin
 Result:=TheDefFailMark;
end;

class procedure TDimAgent.SetDefFailMark(aFailMark:LongString);
begin
 if (aFailMark='') then aFailMark:=Dump(LongInt(-1));
 TheDefFailMark:=aFailMark;
end;

procedure DefaultDimAgentLineHandler(Agent:TDimAgent; const Line:LongString);
begin
 if Agent.Verbose then Echo(Line);
end;

procedure Kill(var TheObject:TDimAgent); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

 ///////////////////////////////////////////////////////////////////////////////
 // DimAgent tester. That is sample code which show how to work with DIM server.
 ///////////////////////////////////////////////////////////////////////////////

procedure DimAgentDemoTesterStart(aDns:LongString='localhost'; aTask:LongString='DIMTEST');
var i:Integer;
begin
 // Stop services
 DimAgent.StopServer;
 DimAgent.FreeServices;
 // Set some options
 DimAgent.Verbose:=true;
 DimAgent.Padding:=true;
 // Note: You should initialize all services BEFORE START SERVER !!!
 // Initialize services (DimTree.exe test server uses same services)
 DimAgent.NewService(dic_info,'DEMO/SIMPLE/INFO/C','C',monitored,5);
 DimAgent.NewService(dic_info,'DEMO/SIMPLE/INFO/D','D',monitored,5);
 DimAgent.NewService(dic_info,'DEMO/SIMPLE/INFO/F','F',monitored,5);
 DimAgent.NewService(dic_info,'DEMO/SIMPLE/INFO/I','I',monitored,5);
 DimAgent.NewService(dic_info,'DEMO/SIMPLE/INFO/L','L',monitored,5);
 DimAgent.NewService(dic_info,'DEMO/SIMPLE/INFO/S','S',monitored,5);
 DimAgent.NewService(dic_info,'DEMO/SIMPLE/INFO/X','X',monitored,5);
 DimAgent.NewService(dic_cmnd,'DEMO/SIMPLE/CMND/C','C',monitored,5);
 DimAgent.NewService(dic_cmnd,'DEMO/SIMPLE/CMND/D','D',monitored,5);
 DimAgent.NewService(dic_cmnd,'DEMO/SIMPLE/CMND/F','F',monitored,5);
 DimAgent.NewService(dic_cmnd,'DEMO/SIMPLE/CMND/I','I',monitored,5);
 DimAgent.NewService(dic_cmnd,'DEMO/SIMPLE/CMND/L','L',monitored,5);
 DimAgent.NewService(dic_cmnd,'DEMO/SIMPLE/CMND/S','S',monitored,5);
 DimAgent.NewService(dic_cmnd,'DEMO/SIMPLE/CMND/X','X',monitored,5);
 // Test server
 aTask:=Trim(UpperCase(aTask)); // Task name expected upper case
 DimAgent.NewService(dis_info,aTask+'/SIMPLE/INFO/C','C',timed,5);
 DimAgent.NewService(dis_info,aTask+'/SIMPLE/INFO/D','D',timed,5);
 DimAgent.NewService(dis_info,aTask+'/SIMPLE/INFO/F','F',timed,5);
 DimAgent.NewService(dis_info,aTask+'/SIMPLE/INFO/I','I',timed,5);
 DimAgent.NewService(dis_info,aTask+'/SIMPLE/INFO/L','L',timed,5);
 DimAgent.NewService(dis_info,aTask+'/SIMPLE/INFO/S','S',timed,5);
 DimAgent.NewService(dis_info,aTask+'/SIMPLE/INFO/X','X',timed,5);
 DimAgent.NewService(dis_cmnd,aTask+'/SIMPLE/CMND/C','C',timed,5);
 DimAgent.NewService(dis_cmnd,aTask+'/SIMPLE/CMND/D','D',timed,5);
 DimAgent.NewService(dis_cmnd,aTask+'/SIMPLE/CMND/F','F',timed,5);
 DimAgent.NewService(dis_cmnd,aTask+'/SIMPLE/CMND/I','I',timed,5);
 DimAgent.NewService(dis_cmnd,aTask+'/SIMPLE/CMND/L','L',timed,5);
 DimAgent.NewService(dis_cmnd,aTask+'/SIMPLE/CMND/S','S',timed,5);
 DimAgent.NewService(dis_cmnd,aTask+'/SIMPLE/CMND/X','X',timed,5);
 // Start server (dimsrv) to read/write DIM data
 if DimAgent.StartServer(aDns,aTask) then begin
  writeln('Started PID ',DimAgent.Pid);
  writeln(task_ctrl(DimAgent.tid,'CmdLine'));
 end else begin
  DimAgent.StopServer;
  DimAgent.FreeServices;
  writeln('Could not start server (dimsrv).');
  Exit;
 end;
 // Print tables, just for information
 for i:=0 to DimAgent.Count-1 do begin
  writeln(DimAgent[i].ServName);
  writeln(DimAgent[i].Items.Table);
 end;
end;

procedure DimAgentDemoTesterStop;
begin
 DimAgent.StopServer;
 DimAgent.FreeServices;
end;

procedure DimAgentDemoTesterPoll;
var Service:TDimService; i,j,Period:Integer; tx:Int64;
var vs:SmallInt; vi:Integer; vd:Double; vf:Single; vl:LongInt;
const LastSend:Int64=0; LastServ:Int64=0; vx:Int64=0;
begin
 //
 // CLIENT POLLING CODE
 //
 // NB: Service is valid only inside polling
 // loop until next DimAgent.PollServer call
 while DimAgent.PollServer(Service) do begin
  // Notify on receive a data
  writeln(StdDateTimeStr(Service.RecvWhen,7),
   ' => Service ',Service.ServName,
   ' received ',Length(Service.RecvData),' bytes');
  //
  // Use Service.Items.IsValid to check data.
  // Use Service.Items.Spec[i] to detect type.
  // Use Service.Items[i].X[j] to extract data.
  //
  for i:=0 to Service.Items.Count-1 do begin
   // Disconnected service receive FailMark
   // This is a way to detect diconnection.
   if Service.FailMarkReceived then begin
    writeln('Disconnected '+Service.ServName);
   end;
   // Please always check data before use.
   if not Service.Items.IsValid then begin
    writeln('Data is not valid ',hex_encode(Service.Items.Buffer));
    continue;
   end;
   write(' Data ',Service.Items.Spec[i],'[',Service.Items.Count(i),']: ');
   for j:=0 to Service.Items.Count(i)-1 do
   case Service.Items.Spec[i] of
    'C': write(Service.Items[i].C[j]);
    'D': write(Service.Items[i].D[j]:7:3,' ');
    'F': write(Service.Items[i].F[j]:7:3,' ');
    'I': write(Service.Items[i].I[j]:5,' ');
    'L': write(Service.Items[i].L[j]:5,' ');
    'S': write(Service.Items[i].S[j]:5,' ');
    'X': write(Service.Items[i].X[j]:5,' ');
   end;
   writeln;
   if (Service.Items.Errors>0)
   then writeln(Service.Items.Errors:1,' error(s) found.');
  end;
  // Send commands to DIM server.
  // Use Dump(.) to compose data.
  Period:=2000; // Each 2 second(s)
  if (GetTickCount64-LastSend>Period) then begin
   vd:=vx; vf:=vx; vi:=vx; vl:=vx; vs:=vx;
   DimAgent.Find('DEMO/SIMPLE/CMND/C').Send(IntToStr(vx)+#0);
   DimAgent.Find('DEMO/SIMPLE/CMND/D').Send(Dump(vd));
   DimAgent.Find('DEMO/SIMPLE/CMND/F').Send(Dump(vf));
   DimAgent.Find('DEMO/SIMPLE/CMND/I').Send(Dump(vi));
   DimAgent.Find('DEMO/SIMPLE/CMND/L').Send(Dump(vl));
   DimAgent.Find('DEMO/SIMPLE/CMND/S').Send(Dump(vs));
   DimAgent.Find('DEMO/SIMPLE/CMND/X').Send(Dump(vx));
   LastSend:=GetTickCount64;
   Inc(vx); // Simulation
  end;
  //
  // SERVER POLLING CODE
  //
  // Publish server data.
  // Use Dump(.) to compose data.
  Period:=1000; // Each 1 second(s)
  if (GetTickCount64-LastServ>Period) then begin
   tx:=GetTickCount64 mod 10000;
   vd:=tx; vf:=tx; vi:=tx; vl:=tx; vs:=tx;
   DimAgent.Find(DimAgent.TaskName+'/SIMPLE/INFO/C').Send(IntToStr(tx)+#0);
   DimAgent.Find(DimAgent.TaskName+'/SIMPLE/INFO/D').Send(Dump(vd));
   DimAgent.Find(DimAgent.TaskName+'/SIMPLE/INFO/F').Send(Dump(vf));
   DimAgent.Find(DimAgent.TaskName+'/SIMPLE/INFO/I').Send(Dump(vi));
   DimAgent.Find(DimAgent.TaskName+'/SIMPLE/INFO/L').Send(Dump(vl));
   DimAgent.Find(DimAgent.TaskName+'/SIMPLE/INFO/S').Send(Dump(vs));
   DimAgent.Find(DimAgent.TaskName+'/SIMPLE/INFO/X').Send(Dump(tx));
   LastServ:=GetTickCount64;
   Inc(vx); // Simulation
  end;
 end;
end;

////////////////////////////
// DimAgent general instance
////////////////////////////

var
 TheDimAgent : TDimAgent = nil;

function DimAgent:TDimAgent;
begin
 if not Assigned(TheDimAgent) then begin
  TheDimAgent:=TDimAgent.Create;
  TheDimAgent.Master:=@TheDimAgent;
 end;
 Result:=TheDimAgent;
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_dima;
begin
 TDimAgent.DefFailMark:=#255#255#255;
 TDimAgent.DefPipeSize:=OS_PIPE_BUF*16;
 TDimAgent.DefProcPrio:=ppAboveNormal;
 TDimAgent.DefPipePrio:=tpHigher;
 TDimAgent.DefWatchdog:=5;
 DimAgent.Ok;
end;

procedure Free_crw_dima;
begin
 Kill(TheDimAgent);
end;

initialization

 Init_crw_dima;

finalization

 Free_crw_dima;

end.

//////////////
// END OF FILE
//////////////

