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

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

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// DIM Client class library. See http://dim.web.cern.ch on DIM.               //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 2019???? - Created by A.K.                                                 //
// 20230605 - Modified for FPC (A.K.)                                         //
////////////////////////////////////////////////////////////////////////////////

unit _crw_dimc; // DIM Client

{$I _crw_sysdef}

{$IFDEF FPC}{$mode Delphi}{$ENDIF}{$H+}

interface

uses
 _crw_sharemem, // NB: THIS UNIT MUST BE FIRST !!!
 {$IFDEF UNIX} cthreads, dl, {$ENDIF}
 {$IFDEF WINDOWS} windows, messages, shellapi, {$ENDIF}
 sysutils, classes, math,
 _crw_alloc, _crw_str, _crw_dim;

 /////////////
 // TDimBuffer - dynamic buffer to store DIM data of any type.
 /////////////
type
 TDimService = class;
 TDimBuffer = class(TMasterObject)
 protected
  FAuto   : LongBool;
  FParent : TDimService;
  FBuffer : array of Byte;
  function  GetAuto:Boolean;
  procedure SetAuto(Auto:Boolean);
  function  GetSize:SizeInt;
  procedure SetSize(Size:SizeInt);
  function  GetParent:TDimService;
 public // Get/Set/Check buffer data.
  function  Addr(Offset:SizeInt=0):Pointer; // Points to buffer's data.
  function  IsValidAddr(Addr:Pointer; Size:SizeInt=1):Boolean; // Check it.
  function  GetData(Target:Pointer; Size:SizeInt; Offset:SizeInt=0):SizeInt;
  function  SetData(Source:Pointer; Size:SizeInt; Offset:SizeInt=0; CanGrow:Boolean=false):SizeInt;
  function  Assign(Source:TDimBuffer):SizeInt; // Copy buffer data from Source to Self.
  procedure Update; // Call Parent's Update.
 public // Get/Set data of different types. Use Offset to map data in complex records.
  function  GetAsChar(Offset:SizeInt=0):Char;
  function  GetAsByte(Offset:SizeInt=0):Byte;
  function  GetAsSmallInt(Offset:SizeInt=0):SmallInt;
  function  GetAsInteger(Offset:SizeInt=0):Integer;
  function  GetAsInt64(Offset:SizeInt=0):Int64;
  function  GetAsFloat(Offset:SizeInt=0):Single;
  function  GetAsDouble(Offset:SizeInt=0):Double;
  function  GetAsPChar(Offset:SizeInt=0):PChar;
  function  GetAsString(Offset:SizeInt=0):LongString;
  procedure SetAsChar(const Value:Char; Offset:SizeInt=0; CanGrow:Boolean=false);
  procedure SetAsByte(const Value:Byte; Offset:SizeInt=0; CanGrow:Boolean=false);
  procedure SetAsSmallInt(const Value:SmallInt; Offset:SizeInt=0; CanGrow:Boolean=false);
  procedure SetAsInteger(const Value:Integer; Offset:SizeInt=0; CanGrow:Boolean=false);
  procedure SetAsInt64(const Value:Int64; Offset:SizeInt=0; CanGrow:Boolean=false);
  procedure SetAsFloat(const Value:Single; Offset:SizeInt=0; CanGrow:Boolean=false);
  procedure SetAsDouble(const Value:Double; Offset:SizeInt=0; CanGrow:Boolean=false);
  procedure SetAsPChar(const Value:PChar; Offset:SizeInt=0; CanGrow:Boolean=false);
  procedure SetAsString(const Value:LongString; Offset:SizeInt=0; CanGrow:Boolean=false);
 public //  Note: Please don't change Buffer.Size while service running (for thread safety).
  property  Auto   : Boolean     read GetAuto   write SetAuto;     // Auto Update on SetData.
  property  Size   : SizeInt     read GetSize   write SetSize;     // Buffer size, bytes.
  property  Parent : TDimService read GetParent;                   // Parent DIM service.
 public // Note: Master property uses to provide "master pointers" with auto-cleaning on Free.
  constructor Create(Parent:TDimService; Size:SizeInt=0);
  destructor  Destroy; override;
 end;
 //////////////
 // TDimService - base class for INFO/CMND client/server DIM services. For internal use only.
 //////////////
 TDimService = class(TMasterObject)
 protected
  FID          : Cardinal;
  FTag         : SizeInt;
  FObj         : TObject;
  FBuffer      : TDimBuffer;
  FFiller      : TDimBuffer;
  FStarted     : Boolean;
  FTimeStamp   : TDateTime;
  FCallBackNow : Boolean;
  FMessageSize : SizeInt;
  FMessageLeng : SizeInt;
  FServiceName : LongString;
  FServiceType : LongString;
  function  GetID:Cardinal;
  function  GetTag:SizeInt;
  procedure SetTag(Value:SizeInt);
  function  GetObj:TObject;
  procedure SetObj(Value:TObject);
  function  GetStarted:Boolean;
  procedure SetStarted(Value:Boolean);
  function  GetTimeStamp:TDateTime;
  function  GetBuffer:TDimBuffer;
  function  GetFiller:TDimBuffer;
  function  GetMessageSize:SizeInt;
  function  GetMessageLeng:SizeInt;
  function  GetServiceName:LongString;
  function  GetServiceType:LongString;
 protected
  procedure OnStop; virtual;
  procedure OnStart; virtual;
  procedure OnUpdate; virtual;
 public
  property  ID          : Cardinal   read GetID;                       // Service ID or 0.
  property  Tag         : SizeInt    read GetTag     write SetTag;     // Linked tag for user.
  property  Obj         : TObject    read GetObj     write SetObj;     // Linked object for user.
  property  Buffer      : TDimBuffer read GetBuffer;                   // Data buffer to send/receive data in.
  property  Filler      : TDimBuffer read GetFiller;                   // Data filler in case of disconnection.
  property  Started     : Boolean    read GetStarted write SetStarted; // Service was registered to serve.
  property  TimeStamp   : TDateTime  read GetTimeStamp;   // Time of data sent/received.
  property  ServiceName : LongString read GetServiceName; // Name of service, like DEMO/SERVICE
  property  ServiceType : LongString read GetServiceType; // Type specification, like I:2;D:1;C
  property  MessageSize : SizeInt    read GetMessageSize; // Message size which was stored to Buffer.
  property  MessageLeng : SizeInt    read GetMessageLeng; // Original message length, may be > Buffer.Size.
 public
  procedure Stop;                                         // Stop serving, unregister service.
  procedure Start;                                        // Start serving, register to serve.
  procedure Update;                                       // Update service (for server only).
 public // Note: Master property uses to provide "master pointers" with auto-cleaning on Free.
  constructor Create(Name:LongString; Size:SizeInt=0);
  procedure   BeforeDestruction; override;
  destructor  Destroy; override;
 end;

 //////////////////
 // TDicBaseService - base class for client INFO/CMND services. For internal use only.
 //////////////////
type
 TDicBaseService = class(TDimService)
 protected
  function  GetServerServices:LongString;
  function  GetServerName:LongString;
  function  GetServerPid:Integer;
  function  GetConnId:Integer;
 public
  property  ServerServices : LongString read GetServerServices; // List of server services
  property  ServerName     : LongString read GetServerName;     // Peer server name as TASK@node
  property  ServerPid      : Integer    read GetServerPid;      // Peer server process PID.
  property  ConnId         : Integer    read GetConnId;         // Connection ID
 end;

 //////////////////
 // TDicInfoService - INFO service DIM client. Uses to receive data from (remote) DIM Server.
 //////////////////
type
 TDicInfoService = class; // DIM INFO Client. Use Buffer to read service data received.
 TOnDicInfoGot = procedure(Service:TDicInfoService); // Notification event on got Info.
 TOnDicInfoTake = procedure(Service:TDicInfoService; Buffer:Pointer; Size:Integer); // Event handler on receiving Info.
 TDicInfoService = class(TDicBaseService)
 protected
  FMode       : Integer;
  FInfoGot    : Cardinal;
  FTimeOut    : Integer;
  FOnInfoGot  : TOnDicInfoGot;
  FOnInfoTake : TOnDicInfoTake;
  function  GetMode:Integer;
  procedure SetMode(Value:Integer);
  function  GetInfoGot:Cardinal;
  procedure SetInfoGot(Value:Cardinal);
  function  GetTimeOut:Integer;
  procedure SetTimeOut(Value:Integer);
  procedure SetOnInfoGot(Value:TOnDicInfoGot);
  procedure SetOnInfoTake(Value:TOnDicInfoTake);
 protected
  procedure OnStop; override;
  procedure OnStart; override;
 public
  property  Mode       : Integer        read GetMode       write SetMode;        // Update mode: TIMED,MONITORED
  property  InfoGot    : Cardinal       read GetInfoGot    write SetInfoGot;     // Counter of services received.
  property  TimeOut    : Integer        read GetTimeOut    write SetTimeOut;     // Update timeout.
  property  OnInfoGot  : TOnDicInfoGot  read FOnInfoGot    write SetOnInfoGot;   // Event handler on got Info.
  property  OnInfoTake : TOnDicInfoTake read FOnInfoTake   write SetOnInfoTake;  // Event handler on receiving Info.
 public
  constructor Create(Name:LongString; Size:SizeInt=0; Mode:Integer=MONITORED; TimeOut:Integer=10);
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
  destructor  Destroy; override;
 end;

const                                       // DicInfo can use callback routine and/or static buffer.
 DicInfoUsesStaticBuffer : Boolean = false; // By default DicInfo uses callback and not uses static buffer.

const                              // Default filler uses to assign initial data content of Filler.
 DefaultFiller : TDimBuffer = nil; // Filler is data marker to sent/receive in case of TimeOut detected.

 //////////////
 // DicCmndSend - send client command to DIM server. Uses synchronous mode (may cause delay).
 //////////////

function DicCmndSend(ServiceName:LongString; Cmnd:Pointer; Size:SizeInt):SizeInt; overload;
function DicCmndSend(ServiceName:LongString; Cmnd:Byte):SizeInt; overload;
function DicCmndSend(ServiceName:LongString; Cmnd:SmallInt):SizeInt; overload;
function DicCmndSend(ServiceName:LongString; Cmnd:Integer):SizeInt; overload;
function DicCmndSend(ServiceName:LongString; Cmnd:Int64):SizeInt; overload;
function DicCmndSend(ServiceName:LongString; Cmnd:Single):SizeInt; overload;
function DicCmndSend(ServiceName:LongString; Cmnd:Double):SizeInt; overload;
function DicCmndSend(ServiceName:LongString; Cmnd:PChar):SizeInt; overload;
function DicCmndSend(ServiceName:LongString; Cmnd:LongString):SizeInt; overload;

 //////////////////
 // TDicCmndService - DIM client CMND service. Uses to send commands to DIM servers in asynchronous mode.
 //////////////////
type
 TDicCmndService = class;
 TOnDicCmndSent = procedure(Service:TDicCmndService; ret_code:Integer);
 TDicCmndService = class(TDicBaseService)
 protected
  FCmndSent   : Cardinal;
  FCmndLost   : Cardinal;
  FOnCmndSent : TOnDicCmndSent;
  function  GetCmndSent:Cardinal;
  procedure SetCmndSent(Value:Cardinal);
  function  GetCmndLost:Cardinal;
  procedure SetCmndLost(Value:Cardinal);
  function  GetOnCmndSent:TOnDicCmndSent;
  procedure SetOnCmndSent(Value:TOnDicCmndSent);
 public
  property  CmndLost   : Cardinal       read GetCmndLost   write SetCmndLost;     // Counter of commands lost.
  property  CmndSent   : Cardinal       read GetCmndSent   write SetCmndSent;     // Counter of commands sent.
  property  OnCmndSent : TOnDicCmndSent read GetOnCmndSent write SetOnCmndSent;   // Callback notification on sent.
 public // Send commands of different type. Uses asynchronous mode with callback notification OnCmndSent.
  function  CmndSend(Cmnd:Pointer; Size:SizeInt):SizeInt; overload;
  function  CmndSend(Cmnd:Byte):SizeInt; overload;
  function  CmndSend(Cmnd:SmallInt):SizeInt; overload;
  function  CmndSend(Cmnd:Integer):SizeInt; overload;
  function  CmndSend(Cmnd:Int64):SizeInt; overload;
  function  CmndSend(Cmnd:Single):SizeInt; overload;
  function  CmndSend(Cmnd:Double):SizeInt; overload;
  function  CmndSend(Cmnd:PChar):SizeInt; overload;
  function  CmndSend(Cmnd:LongString):SizeInt; overload;
 public
  constructor Create(ServiceName:LongString; ServiceType:LongString=''; BufferSize:SizeInt=0);
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
  destructor  Destroy; override;
 end;

 /////////////////
 // TDimThreadList - thread safe service container and iterator.
 /////////////////

type
 TDimServiceIterator = procedure(Service:TDimService; Custom:Pointer; var Terminate:Boolean);
 TDimThreadList = class(TThreadList)
 public
  procedure FreeServices;                                // Free all services
  procedure StopServices;                                // Stop all services
  procedure StartServices;                               // Start all services
  procedure UpdateServices;                              // Update all services
  procedure DeleteServices;                              // Delete all, but don't free
  function  CountServices:Integer;                       // Count all services
  function  CountStartedServices:Integer;                // Count started services
  function  ListServicesNames:LongString;                // Return list of names
  function  HasService(Service:TDimService):Boolean;     // Has service in list?
  function  AddService(Service:TDimService):Boolean;     // Add this service to list
  function  DeleteService(Service:TDimService):Boolean;  // Delete from list, but don't Free
  procedure ForEachService(Iterator:TDimServiceIterator; Custom:Pointer=nil; Down:Boolean=false);
 end;

 //////////////
 // TDimClients - general list of DIM Clients. Contains all client INFO services.
 //////////////
type
 TDimClients = class(TObject)
 protected
  FTaskNode     : LongString;
  FInfoServices : TDimThreadList;
  FCmndServices : TDimThreadList;
  function  GetServing:Boolean;
  function  GetDnsNode:LongString;
  procedure SetDnsNode(Node:LongString);
  function  GetTaskName:LongString;
  function  GetTaskNode:LongString;
  function  GetInfoServices:TDimThreadList;
  function  GetCmndServices:TDimThreadList;
 public
  property  Serving      : Boolean        read GetServing;                   // DIM client working?
  property  DnsNode      : LongString     read GetDnsNode write SetDnsNode;  // DNS uses by Clients.
  property  TaskName     : LongString     read GetTaskName;                  // PID or empty if not serving.
  property  TaskNode     : LongString     read GetTaskNode;                  // PID@node or empty if not serving.
  property  InfoServices : TDimThreadList read GetInfoServices;              // List of all INFO Clients.
  property  CmndServices : TDimThreadList read GetCmndServices;              // List of all CMND Clients.
 public
  procedure StopServing;                                                     // Stop all services, disconnect DNS.
  procedure FreeServices;                                                    // Free all services, destroy it.
  procedure StopServices;                                                    // Stop all services, unregister.
  procedure StartServices;                                                   // Start all services, register to serve
  function  StartServing(DNS:LongString=''):Boolean;                         // Start to serving all services.
  function  InfoServingCount:Integer;                                        // Counter of all started services.
  function  CmndServingCount:Integer;                                        // Counter of all started services.
 public
  constructor Create;
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
  destructor  Destroy; override;
 end;

function DimClients:TDimClients;  // The only one DIM Clients instance allowed. It contains all Client services.

 /////////////////
 // DIM Exceptions - call SetDimBugReport to assign DIM exceptions handler.
 /////////////////

type // To be used on DIM errors
 EDimFail     = class(Exception);
 EDicFail     = class(EDimFail);
 EDisFail     = class(EDimFail);
 EDicInfoFail = class(EDicFail);
 EDicCmndFail = class(EDicFail);
 EDisInfoFail = class(EDisFail);
 EDisCmndFail = class(EDisFail);

type // Callback to call in case of Exception raised.
 TDimBugReport = procedure(E:Exception; O:TObject; Note:LongString);

procedure DimBugReport(E:Exception; O:TObject=nil; Note:LongString='');
procedure SetDimBugReport(Report:TDimBugReport);

 ///////////////
 // Common stuff
 ///////////////

function  GetEnvDimDnsNode:LongString;         // Get DNS from environment variable DIM_DNS_NODE
function  GetLocalHostNode:LongString;         // Get local node name as hostname command does
function  GetDimDnsNode:LongString;            // Get actual DNS from DIM (really it's DIS)
function  GetDicDnsNode:LongString;            // Get actual DNS from DIC
function  GetDisDnsNode:LongString;            // Get actual DNS from DIS
procedure SetDimDnsNode(Node:LongString);      // Set actual DNS to   DIM (for both DIC/DIS)
procedure SetDicDnsNode(Node:LongString);      // Set actual DNS to   DIC
procedure SetDisDnsNode(Node:LongString);      // Set actual DNS to   DIS

var
 DimTrafficCounts : record                     // DIM traffic counters:
  DicInfoItems,DicInfoItemsLost : QWORD;       // DIM client INFO items reveiced
  DicInfoBytes,DicInfoBytesLost : QWORD;       // DIM client INFO bytes received
  DicCmndItems,DicCmndItemsLost : QWORD;       // DIM client CMND items sent
  DicCmndBytes,DicCmndBytesLost : QWORD;       // DIM client CMND bytes sent
  DisInfoItems,DisInfoItemsLost : QWORD;       // DIM server INFO items sent
  DisInfoBytes,DisInfoBytesLost : QWORD;       // DIM server INFO bytes sent
  DisCmndItems,DisCmndItemsLost : QWORD;       // DIM server CMND items received
  DisCmndBytes,DisCmndBytesLost : QWORD;       // DIM server CMND bytes received
 end;
 
procedure ClearDimTrafficCounts;               // DIM traffic counters cleanup

const DimFormatSpecifiers = 'CDFILSX';         // List of DIM format specifiers
function DimSpecifierSize(s:Char):SizeInt;     // Return size of simple format specifier or 0 if one not valid

 // Check and parse DIM service type specifiers.
 // ServiceType format is semicolon - delimited list of items F:N;F:N;...
 // where F-format specifier ('C','D','F','I','L','S','X'), ':' - separator, N - counter (length).
 // The :N specifier may be skipped if N=1, so the expression 'D:1' is equivalent to expression 'D'.
 // For last item the :N expression may be skipped too. In this case counter determinated by the message size.
 // Return list of specifiers delimited by Delimeter, separated by Separator, with trail zero if TrailZero specified.
 // Return empty string on any format error(s).
function DimParseServiceType(ServiceType:LongString; Separator:LongString=':'; Delimeter:LongString=';'; TrailZero:Boolean=false):LongString;

 // Return last DIM type specifier: I:2;D:1;C:4 => 'C'
function DimLastTypeSpecifier(ServiceType:LongString):Char;

 // Calculate buffer size required to store DIM service with given type specifiers.
 // Trailing specifier uses TrailLength counter (length) if one length is not specified.
function DimServiceTypeSize(ServiceType:LongString; TrailLength:SizeInt=1):SizeInt;

implementation

 /////////////
 // TDimBuffer
 /////////////

function TDimBuffer.GetParent:TDimService;
begin
 if (Self<>nil)
 then Result:=FParent
 else Result:=nil;
end;

function TDimBuffer.GetAuto:Boolean;
begin
 if (Self<>nil)
 then Result:=FAuto
 else Result:=false;
end;

procedure TDimBuffer.SetAuto(Auto:Boolean);
begin
 if (Self=nil) then Exit;
 FAuto:=Auto;
end;

function TDimBuffer.GetSize:SizeInt;
begin
 if (Self<>nil)
 then Result:=Length(FBuffer)
 else Result:=0;
end;

procedure TDimBuffer.SetSize(Size:SizeInt);
begin
 if (Size<0) then Exit;
 if (Self=nil) then Exit;
 if (Size=Length(FBuffer)) then Exit;
 SetLength(FBuffer,Size);
end;

function TDimBuffer.Addr(Offset:SizeInt=0):Pointer;
begin
 if (Self<>nil) and (FBuffer<>nil)
 then Result:=PChar(FBuffer)+Offset
 else Result:=nil;
end;

function TDimBuffer.IsValidAddr(Addr:Pointer; Size:SizeInt=1):Boolean;
var Offset:SizeInt;
begin
 Result:=false;
 if (Size<0) then Exit;
 if (Addr=nil) then Exit;
 if (Self=nil) then Exit;
 if (FBuffer=nil) then Exit;
 Offset:=SubtractPointersAsPtrInt(Addr,FBuffer);
 if (Offset<0) or (Offset+Size>Length(FBuffer)) then Exit;
 Result:=true;
end;

function TDimBuffer.SetData(Source:Pointer; Size:SizeInt; Offset:SizeInt=0; CanGrow:Boolean=false):SizeInt;
begin
 Result:=0;
 if (Size<=0) then Exit;
 if (Offset<0) then Exit;
 if (Self=nil) then Exit;
 if (Source=nil) then Exit;
 if Length(FBuffer)<Offset+Size then begin
  if CanGrow
  then SetLength(FBuffer,Offset+Size)
  else Exit;
 end;
 SafeMove(Source^,Addr(Offset)^,Size);
 if FAuto then Update;
 Result:=Size;
end;

procedure TDimBuffer.Update;
begin
 if (Self=nil) then Exit;
 if (FParent=nil) then Exit;
 if (FParent.FBuffer<>Self) then Exit;
 if FParent.FStarted then FParent.Update;
end;

function TDimBuffer.GetData(Target:Pointer; Size:SizeInt; Offset:SizeInt=0):SizeInt;
begin
 Result:=0;
 if (Size<=0) then Exit;
 if (Offset<0) then Exit;
 if (Self=nil) then Exit;
 if (Target=nil) then Exit;
 if Length(FBuffer)<Offset+Size then Exit;
 SafeMove(Addr(Offset)^,Target^,Size);
 Result:=Size;
end;

function TDimBuffer.Assign(Source:TDimBuffer):SizeInt;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if (Source=nil) then Exit;
 if (Size<>Source.Size) then SetSize(Source.Size);
 Result:=SetData(Source.Addr,Source.Size);
end;

function TDimBuffer.GetAsChar(Offset:SizeInt=0):Char;
begin
 if GetData(@Result,SizeOf(Result),Offset)=0
 then SafeFillChar(Result,SizeOf(Result),0);
end;

function TDimBuffer.GetAsByte(Offset:SizeInt=0):Byte;
begin
 if GetData(@Result,SizeOf(Result),Offset)=0
 then SafeFillChar(Result,SizeOf(Result),0);
end;

function TDimBuffer.GetAsSmallInt(Offset:SizeInt=0):SmallInt;
begin
 if GetData(@Result,SizeOf(Result),Offset)=0
 then SafeFillChar(Result,SizeOf(Result),0);
end;

function TDimBuffer.GetAsInteger(Offset:SizeInt=0):Integer;
begin
 if GetData(@Result,SizeOf(Result),Offset)=0
 then SafeFillChar(Result,SizeOf(Result),0);
end;

function TDimBuffer.GetAsInt64(Offset:SizeInt=0):Int64;
begin
 if GetData(@Result,SizeOf(Result),Offset)=0
 then SafeFillChar(Result,SizeOf(Result),0);
end;

function TDimBuffer.GetAsFloat(Offset:SizeInt=0):Single;
begin
 if GetData(@Result,SizeOf(Result),Offset)=0
 then SafeFillChar(Result,SizeOf(Result),0);
end;

function TDimBuffer.GetAsDouble(Offset:SizeInt=0):Double;
begin
 if GetData(@Result,SizeOf(Result),Offset)=0
 then SafeFillChar(Result,SizeOf(Result),0);
end;

function TDimBuffer.GetAsPChar(Offset:SizeInt=0):PChar;
begin
 Result:=nil;
 if (Self=nil) then Exit;
 if (FBuffer=nil) then Exit;
 if (Offset<Low(FBuffer)) then Exit;
 if (Offset>High(FBuffer)) then Exit;
 Result:=PChar(FBuffer)+Offset;
end;

function TDimBuffer.GetAsString(Offset:SizeInt=0):LongString;
var Buff:PChar; MaxLen,Leng:SizeInt;
begin
 Result:='';
 if (Self=nil) then Exit;
 if (FBuffer=nil) then Exit;
 if (Offset<Low(FBuffer)) then Exit;
 if (Offset>High(FBuffer)) then Exit;
 Buff:=PChar(FBuffer)+Offset;
 MaxLen:=High(FBuffer)-Offset;
 Leng:=StrLLen(Buff,MaxLen);
 SetString(Result,Buff,Leng);
end;

procedure TDimBuffer.SetAsChar(const Value:Char; Offset:SizeInt=0; CanGrow:Boolean=false);
begin
 SetData(@Value,SizeOf(Value),Offset,CanGrow);
end;

procedure TDimBuffer.SetAsByte(const Value:Byte; Offset:SizeInt=0; CanGrow:Boolean=false);
begin
 SetData(@Value,SizeOf(Value),Offset,CanGrow);
end;

procedure TDimBuffer.SetAsSmallInt(const Value:SmallInt; Offset:SizeInt=0; CanGrow:Boolean=false);
begin
 SetData(@Value,SizeOf(Value),Offset,CanGrow);
end;

procedure TDimBuffer.SetAsInteger(const Value:Integer; Offset:SizeInt=0; CanGrow:Boolean=false);
begin
 SetData(@Value,SizeOf(Value),Offset,CanGrow);
end;

procedure TDimBuffer.SetAsInt64(const Value:Int64; Offset:SizeInt=0; CanGrow:Boolean=false);
begin
 SetData(@Value,SizeOf(Value),Offset,CanGrow);
end;

procedure TDimBuffer.SetAsFloat(const Value:Single; Offset:SizeInt=0; CanGrow:Boolean=false);
begin
 SetData(@Value,SizeOf(Value),Offset,CanGrow);
end;

procedure TDimBuffer.SetAsDouble(const Value:Double; Offset:SizeInt=0; CanGrow:Boolean=false);
begin
 SetData(@Value,SizeOf(Value),Offset,CanGrow);
end;

procedure TDimBuffer.SetAsPChar(const Value:PChar; Offset:SizeInt=0; CanGrow:Boolean=false);
begin
 SetAsString(Value,Offset,CanGrow);
end;

procedure TDimBuffer.SetAsString(const Value:LongString; Offset:SizeInt=0; CanGrow:Boolean=false);
var Buff:LongString; Leng:SizeInt;
begin
 if (Self=nil) then Exit;
 if (Offset<0) then Exit;
 if CanGrow
 then Leng:=Length(Value)
 else Leng:=Min(Length(Value),High(FBuffer)-Offset);
 if (Leng<0) then Exit; // insufficient buffer space
 if (Leng=0) then SetAsChar(#0,Offset,CanGrow) else begin
  Buff:=Copy(Value,1,Leng); // temporary data buffer
  SetData(PChar(Buff),Length(Buff)+1,Offset,CanGrow);
 end;
end;

constructor TDimBuffer.Create(Parent:TDimService; Size:SizeInt=0);
begin
 inherited Create;
 FParent:=Parent;
 SetSize(Size);
end;

destructor TDimBuffer.Destroy;
begin
 SetSize(0);
 FBuffer:=nil;
 inherited;
end;

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

function TDimService.GetID:Cardinal;
begin
 if (Self<>nil)
 then Result:=FID
 else Result:=0;
end;

function TDimService.GetTag:SizeInt;
begin
 if (Self<>nil)
 then Result:=FTag
 else Result:=0;
end;

procedure TDimService.SetTag(Value:SizeInt);
begin
 if (Self=nil) then Exit;
 FTag:=Value;
end;

function TDimService.GetObj:TObject;
begin
 if (Self<>nil)
 then Result:=FObj
 else Result:=nil;
end;

procedure TDimService.SetObj(Value:TObject);
begin
 if (Self=nil) then Exit;
 FObj:=Value;
end;

function TDimService.GetStarted:Boolean;
begin
 if (Self<>nil)
 then Result:=FStarted
 else Result:=false;
end;

procedure TDimService.SetStarted(Value:Boolean);
begin
 if Value then Start else Stop;
end;

function TDimService.GetTimeStamp:TDateTime;
begin
 if (Self<>nil)
 then Result:=FTimeStamp
 else Result:=0;
end;

function TDimService.GetBuffer:TDimBuffer;
begin
 if (Self<>nil)
 then Result:=FBuffer
 else Result:=nil;
end;

function TDimService.GetFiller:TDimBuffer;
begin
 if (Self<>nil)
 then Result:=FFiller
 else Result:=nil;
end;

function TDimService.GetMessageSize:SizeInt;
begin
 if (Self<>nil)
 then Result:=FMessageSize
 else Result:=0;
end;

function TDimService.GetMessageLeng:SizeInt;
begin
 if (Self<>nil)
 then Result:=FMessageLeng
 else Result:=0;
end;

function TDimService.GetServiceName:LongString;
begin
 if (Self<>nil)
 then Result:=FServiceName
 else Result:='';
end;

function TDimService.GetServiceType:LongString;
begin
 if (Self<>nil)
 then Result:=FServiceType
 else Result:='';
end;

procedure TDimService.Start;
begin
 if (Self=nil) then Exit;
 if FStarted then Exit;
 FStarted:=true;
 OnStart;
end;

procedure TDimService.Stop;
begin
 if (Self=nil) then Exit;
 if not FStarted then Exit;
 FStarted:=false;
 OnStop;
end;

procedure TDimService.Update;
begin
 if (Self=nil) then Exit;
 OnUpdate;
end;

procedure TDimService.OnStart;
begin
end;

procedure TDimService.OnStop;
begin
end;

procedure TDimService.OnUpdate;
begin
end;

constructor TDimService.Create(Name:LongString; Size:SizeInt=0);
begin
 inherited Create;
 FServiceName:=Name;
 FBuffer:=TDimBuffer.Create(Self,Size);
 FBuffer.Master:=@FBuffer;
 FFiller:=TDimBuffer.Create(Self,0);
 FFiller.Assign(DefaultFiller);
 FFiller.Master:=@FFiller;
end;

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

destructor TDimService.Destroy;
begin
 FBuffer.Free;
 FFiller.Free;
 FServiceName:='';
 FServiceType:='';
 inherited;
end;

 //////////////////
 // TDicBaseService
 //////////////////

function TDicBaseService.GetServerServices:LongString;
var P:PChar;
begin
 Result:='';
 if (Self=nil) then Exit;
 if not FCallBackNow then Exit;
 P:=dic_get_server_services(dic_get_conn_id);
 if (P<>nil) then Result:=P;
end;

function TDicBaseService.GetServerName:LongString;
var s:LongString;
begin
 Result:='';
 if (Self=nil) then Exit;
 if not FCallBackNow then Exit;
 s:=StringOfChar(#0,MAX_PATH);
 if dic_get_server(PChar(s))>0
 then Result:=PChar(s);
end;

function TDicBaseService.GetServerPid:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if not FCallBackNow then Exit;
 if dic_get_server_pid(Result)=0 then Result:=0;
end;

function TDicBaseService.GetConnId:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if not FCallBackNow then Exit;
 Result:=dic_get_conn_id;
end;

 //////////////////
 // TDicInfoService
 //////////////////

 // see _dim.TDic_User_Routine
procedure DicUserRoutine(var tag:TDimLong; buff:Pointer; var size:Integer); cdecl;
var Service:TDicInfoService; lost:SizeInt;
begin
 Service:=PtrIntToPointer(tag);
 if (Service=nil) then Exit;
 try
  Service.FCallBackNow:=true;
  try
   Inc(Service.FInfoGot);
   Service.FTimeStamp:=Now;
   Service.FMessageLeng:=size;
   if Service.FServiceType='' // get format specifier
   then Service.FServiceType:=dic_get_format(Service.FID);
   inc(DimTrafficCounts.DicInfoItems);
   inc(DimTrafficCounts.DicInfoBytes,size);
   if Assigned(Service.FOnInfoTake) then begin
    Service.FMessageSize:=size;
    Service.FOnInfoTake(Service,buff,size);
   end else begin
    Service.FMessageSize:=Min(Service.Buffer.Size,size);
    if (Service.Buffer.SetData(buff,Service.FMessageSize)>0) then begin
     lost:=size-Service.FMessageSize;
     if (lost>0) then inc(DimTrafficCounts.DicInfoBytesLost,lost);
    end else begin
     if (size>0) then begin
      inc(DimTrafficCounts.DicInfoBytesLost,size);
      inc(DimTrafficCounts.DicInfoItemsLost);
     end;
    end;
   end;
   if Assigned(Service.FOnInfoGot) then Service.FOnInfoGot(Service);
  finally
   Service.FCallBackNow:=false;
  end;
 except
  on E:Exception do DimBugReport(E,Service);
 end;
end;

constructor TDicInfoService.Create(Name:LongString; Size:SizeInt=0; Mode:Integer=MONITORED; TimeOut:Integer=10);
begin
 inherited Create(Name,Size);
 FTimeOut:=TimeOut;
 FMode:=Mode;
end;

procedure TDicInfoService.AfterConstruction;
begin
 inherited;
 DimClients.InfoServices.AddService(Self);
end;

procedure TDicInfoService.BeforeDestruction;
begin
 Stop;
 DimClients.InfoServices.DeleteService(Self);
 inherited;
end;

destructor TDicInfoService.Destroy;
begin
 inherited;
end;

function TDicInfoService.GetMode:Integer;
begin
 if (Self<>nil)
 then Result:=FMode
 else Result:=0;
end;

procedure TDicInfoService.SetMode(Value:Integer);
begin
 if (Self=nil) then Exit;
 FMode:=Value;
end;

function TDicInfoService.GetTimeOut:Integer;
begin
 if (Self<>nil)
 then Result:=FTimeOut
 else Result:=0;
end;

procedure TDicInfoService.SetTimeOut(Value:Integer);
begin
 if (Self=nil) then Exit;
 FTimeOut:=Value;
end;

function TDicInfoService.GetInfoGot:Cardinal;
begin
 if (Self<>nil)
 then Result:=FInfoGot
 else Result:=0;
end;

procedure TDicInfoService.SetInfoGot(Value:Cardinal);
begin
 if (Self=nil) then Exit;
 FInfoGot:=Value;
end;

procedure TDicInfoService.SetOnInfoGot(Value:TOnDicInfoGot);
begin
 if (Self=nil) then Exit;
 FOnInfoGot:=Value;
end;

procedure TDicInfoService.SetOnInfoTake(Value:TOnDicInfoTake);
begin
 if (Self=nil) then Exit;
 FOnInfoTake:=Value;
end;

procedure TDicInfoService.OnStart;
var Buffer_Addr:Pointer; Buffer_Size:SizeInt;
begin
 if DicInfoUsesStaticBuffer then Buffer_Size:=Buffer.Size else Buffer_Size:=0;
 if DicInfoUsesStaticBuffer then Buffer_Addr:=Buffer.Addr else Buffer_Addr:=nil;
 // Always use callback routine as most flexible solution
 FID:=dic_info_service(PChar(FServiceName),FMode,FTimeOut,
      Buffer_Addr,Buffer_Size,DicUserRoutine,PointerToPtrInt(Self),
      Filler.Addr,Filler.Size);
 if (Mode=ONCE_ONLY) then FID:=0;
 if (FID=0) then FStarted:=false;
end;

procedure TDicInfoService.OnStop;
begin
 if (FID<>0) then begin
  dic_release_service(FID);
  FID:=0;
 end;
end;

 //////////////
 // DicCmndSend
 //////////////

function DicCmndSend(ServiceName:LongString; Cmnd:Pointer; Size:SizeInt):SizeInt; overload;
begin
 Result:=dic_cmnd_service(PChar(ServiceName),Cmnd,Size);
 if (Result=0) then begin
  inc(DimTrafficCounts.DicCmndItemsLost);
  inc(DimTrafficCounts.DicCmndBytesLost,size);
 end else begin
  inc(DimTrafficCounts.DicCmndItems);
  inc(DimTrafficCounts.DicCmndBytes,size);
 end;
end;

function DicCmndSend(ServiceName:LongString; Cmnd:Byte):SizeInt; overload;
begin
 Result:=DicCmndSend(ServiceName,@Cmnd,SizeOf(Cmnd));
end;

function DicCmndSend(ServiceName:LongString; Cmnd:SmallInt):SizeInt; overload;
begin
 Result:=DicCmndSend(ServiceName,@Cmnd,SizeOf(Cmnd));
end;

function DicCmndSend(ServiceName:LongString; Cmnd:Integer):SizeInt; overload;
begin
 Result:=DicCmndSend(ServiceName,@Cmnd,SizeOf(Cmnd));
end;

function DicCmndSend(ServiceName:LongString; Cmnd:Int64):SizeInt; overload;
begin
 Result:=DicCmndSend(ServiceName,@Cmnd,SizeOf(Cmnd));
end;

function DicCmndSend(ServiceName:LongString; Cmnd:Single):SizeInt; overload;
begin
 Result:=DicCmndSend(ServiceName,@Cmnd,SizeOf(Cmnd));
end;

function DicCmndSend(ServiceName:LongString; Cmnd:Double):SizeInt; overload;
begin
 Result:=DicCmndSend(ServiceName,@Cmnd,SizeOf(Cmnd));
end;

function DicCmndSend(ServiceName:LongString; Cmnd:PChar):SizeInt; overload;
begin
 if (Cmnd<>nil)
 then Result:=DicCmndSend(ServiceName,Cmnd,strlen(Cmnd)+1)
 else Result:=0;
end;

function DicCmndSend(ServiceName:LongString; Cmnd:LongString):SizeInt; overload;
begin
 Result:=DicCmndSend(ServiceName,PChar(Cmnd));
end;

 //////////////////
 // TDicCmndService
 //////////////////

 // See _dim.TDic_Cmnd_Routine
procedure DicCmndUserRoutine(var tag:TDimLong; var ret_code:Integer); cdecl;
var Service:TDicCmndService; size,lost:SizeInt;
begin
 Service:=PtrIntToPointer(tag);
 if (Service=nil) then Exit;
 try
  Service.FCallBackNow:=true;
  try
   if (ret_code=0) then begin
    Inc(Service.FCmndLost);
    lost:=Service.MessageLeng;
    size:=0;
   end else begin
    Inc(Service.FCmndSent);
    size:=Service.MessageLeng;
    lost:=0;
   end;
   Service.FTimeStamp:=Now;
   inc(DimTrafficCounts.DicCmndItems,ord(size>0));
   inc(DimTrafficCounts.DicCmndBytes,size);
   inc(DimTrafficCounts.DicCmndItemsLost,ord(lost>0));
   inc(DimTrafficCounts.DicCmndBytesLost,lost);
   if Assigned(Service.FOnCmndSent) then Service.FOnCmndSent(Service,ret_code);
  finally
   Service.FCallBackNow:=false;
  end;
 except
  on E:Exception do DimBugReport(E,Service);
 end;
end;

constructor TDicCmndService.Create(ServiceName,ServiceType:LongString; BufferSize:SizeInt);
begin
 inherited Create(ServiceName,BufferSize);
 FServiceType:=ServiceType;
end;

procedure TDicCmndService.AfterConstruction;
begin
 inherited;
 DimClients.CmndServices.AddService(Self);
end;

procedure TDicCmndService.BeforeDestruction;
begin
 Stop;
 DimClients.CmndServices.DeleteService(Self);
 inherited;
end;

destructor TDicCmndService.Destroy;
begin
 inherited;
end;

function TDicCmndService.GetCmndLost:Cardinal;
begin
 if (Self<>nil)
 then Result:=FCmndLost
 else Result:=0;
end;

procedure TDicCmndService.SetCmndLost(Value:Cardinal);
begin
 if (Self=nil) then Exit;
 FCmndLost:=Value;
end;

function TDicCmndService.GetCmndSent:Cardinal;
begin
 if (Self<>nil)
 then Result:=FCmndSent
 else Result:=0;
end;

procedure TDicCmndService.SetCmndSent(Value:Cardinal);
begin
 if (Self=nil) then Exit;
 FCmndSent:=Value;
end;

function TDicCmndService.GetOnCmndSent:TOnDicCmndSent;
begin
 if (Self<>nil)
 then Result:=FOnCmndSent
 else Result:=nil;
end;

procedure TDicCmndService.SetOnCmndSent(Value:TOnDicCmndSent);
begin
 if (Self=nil) then Exit;
 FOnCmndSent:=Value;
end;

function TDicCmndService.CmndSend(Cmnd:Pointer; Size:SizeInt):SizeInt;
begin
 Result:=dic_cmnd_callback(PChar(FServiceName),Cmnd,Size,DicCmndUserRoutine,PointerToPtrInt(Self));
 if (Result=0) then begin
  inc(DimTrafficCounts.DicCmndItemsLost);
  inc(DimTrafficCounts.DicCmndBytesLost,size);
 end else begin
  FMessageSize:=FBuffer.SetData(Cmnd,Size);
  FMessageLeng:=size;
 end;
end;

function TDicCmndService.CmndSend(Cmnd:Byte):SizeInt;
begin
 Result:=CmndSend(@Cmnd,SizeOf(Cmnd));
end;

function TDicCmndService.CmndSend(Cmnd:SmallInt):SizeInt;
begin
 Result:=CmndSend(@Cmnd,SizeOf(Cmnd));
end;

function TDicCmndService.CmndSend(Cmnd:Integer):SizeInt;
begin
 Result:=CmndSend(@Cmnd,SizeOf(Cmnd));
end;

function TDicCmndService.CmndSend(Cmnd:Int64):SizeInt;
begin
 Result:=CmndSend(@Cmnd,SizeOf(Cmnd));
end;

function TDicCmndService.CmndSend(Cmnd:Single):SizeInt;
begin
 Result:=CmndSend(@Cmnd,SizeOf(Cmnd));
end;

function TDicCmndService.CmndSend(Cmnd:Double):SizeInt;
begin
 Result:=CmndSend(@Cmnd,SizeOf(Cmnd));
end;

function TDicCmndService.CmndSend(Cmnd:PChar):SizeInt;
begin
 if (Cmnd<>nil)
 then Result:=CmndSend(Cmnd,strlen(Cmnd)+1)
 else Result:=0;
end;

function TDicCmndService.CmndSend(Cmnd:LongString):SizeInt;
begin
 Result:=CmndSend(PChar(Cmnd));
end;

 /////////////////
 // TDimThreadList
 /////////////////

procedure DimServiceFree(Service:TDimService; Custom:Pointer; var Terminate:Boolean);
begin
 Service.Free;
end;

procedure TDimThreadList.FreeServices;
begin
 if (Self=nil) then Exit;
 ForEachService(DimServiceFree,nil,true);
end;

procedure DimServiceStop(Service:TDimService; Custom:Pointer; var Terminate:Boolean);
begin
 Service.Stop;
end;

procedure TDimThreadList.StopServices;
begin
 if (Self=nil) then Exit;
 ForEachService(DimServiceStop);
end;

procedure DimServiceStart(Service:TDimService; Custom:Pointer; var Terminate:Boolean);
begin
 Service.Start;
end;

procedure TDimThreadList.StartServices;
begin
 if (Self=nil) then Exit;
 ForEachService(DimServiceStart);
end;

procedure DimServiceUpdate(Service:TDimService; Custom:Pointer; var Terminate:Boolean);
begin
 Service.Update;
end;

procedure TDimThreadList.UpdateServices;
begin
 if (Self=nil) then Exit;
 ForEachService(DimServiceUpdate);
end;

procedure DimServiceCountStarted(Service:TDimService; Custom:Pointer; var Terminate:Boolean);
begin
 if (Custom=nil) then Terminate:=true else
 if Service.Started then Inc(Integer(Custom^));
end;

function  TDimThreadList.CountStartedServices:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 ForEachService(DimServiceCountStarted,@Result);
end;

procedure DimServiceListServices(Service:TDimService; Custom:Pointer; var Terminate:Boolean);
begin
 if (Custom=nil) then Terminate:=true else
 TStringList(Custom).Add(Service.ServiceName);
end;

function  TDimThreadList.ListServicesNames:LongString;
var List:TStringList;
begin
 Result:='';
 if (Self=nil) then Exit;
 List:=TStringList.Create;
 try
  ForEachService(DimServiceListServices,List);
  Result:=List.Text;
 finally
  List.Free;
 end;
end;

procedure TDimThreadList.DeleteServices;
begin
 if (Self=nil) then Exit;
 with LockList do
 try
  Count:=0;
 finally
  UnlockList;
 end;
end;

function TDimThreadList.DeleteService(Service:TDimService):Boolean;
var i:Integer;
begin
 Result:=false;
 if (Self=nil) then Exit;
 if (Service=nil) then Exit;
 with LockList do
 try
  i:=IndexOf(Service);
  if (i>=0) then Delete(i);
  Result:=(i>=0);
 finally
  UnlockList;
 end;
end;

function TDimThreadList.AddService(Service:TDimService):Boolean;
var i,j:Integer;
begin
 Result:=false;
 if (Self=nil) then Exit;
 if (Service=nil) then Exit;
 with LockList do
 try
  i:=IndexOf(Service); j:=0;
  if (i<0) then j:=Add(Service);
  Result:=(i<0) and (j>=0);
 finally
  UnlockList;
 end;
end;

function TDimThreadList.HasService(Service:TDimService):Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 if (Service=nil) then Exit;
 with LockList do
 try
  Result:=(IndexOf(Service)>=0);
 finally
  UnlockList;
 end;
end;

function TDimThreadList.CountServices:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 with LockList do
 try
  Result:=Count;
 finally
  UnlockList;
 end;
end;

procedure TDimThreadList.ForEachService(Iterator:TDimServiceIterator; Custom:Pointer=nil; Down:Boolean=false);
var i:Integer; Item:TObject; Terminate:Boolean;
begin
 if Assigned(Self) then
 if Assigned(Iterator) then
 with LockList do
 try
  //Pack;
  Terminate:=false;
  if Down then begin
   for i:=Count-1 downto 0 do begin
    Item:=Items[i]; if (Item is TDimService) then Iterator(TDimService(Item),Custom,Terminate);
    if Terminate then Break;
   end;
  end else begin
   for i:=0 to Count-1 do begin
    Item:=Items[i]; if (Item is TDimService) then Iterator(TDimService(Item),Custom,Terminate);
    if Terminate then Break;
   end;
  end;
 finally
  UnlockList;
 end;
end;

 //////////////
 // TDimClients
 //////////////

const
 TheDimClients : TDimClients = nil;

function DimClients:TDimClients;
begin
 if TheDimClients=nil then TheDimClients:=TDimClients.Create;
 Result:=TheDimClients;
end;

constructor TDimClients.Create;
begin
 inherited;
 FInfoServices:=TDimThreadList.Create;
 FCmndServices:=TDimThreadList.Create;
end;

procedure TDimClients.AfterConstruction;
begin
 inherited;
 if (TheDimClients=nil)
 then TheDimClients:=Self;
end;

procedure TDimClients.BeforeDestruction;
begin
 StopServing;
 FreeServices;
 if (TheDimClients=Self)
 then TheDimClients:=nil;
 inherited;
end;

destructor TDimClients.Destroy;
begin
 FInfoServices.Free;
 FCmndServices.Free;
 FTaskNode:='';
 inherited;
end;

procedure TDimClients.FreeServices;
begin
 if (Self=nil) then Exit;
 StopServing;
 FInfoServices.FreeServices;
 FCmndServices.FreeServices;
end;

procedure TDimClients.StopServices;
begin
 if (Self=nil) then Exit;
 FInfoServices.StopServices;
 FInfoServices.StopServices;
end;

procedure TDimClients.StartServices;
begin
 if (Self=nil) then Exit;
 FInfoServices.StartServices;
 FCmndServices.StartServices;
end;

function TDimClients.InfoServingCount:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if not Serving then Exit;
 Result:=FInfoServices.CountStartedServices;
end;

function TDimClients.CmndServingCount:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if not Serving then Exit;
 Result:=FCmndServices.CountStartedServices;
end;

procedure TDimClients.StopServing;
begin
 if (Self=nil) then Exit;
 StopServices;
 if Serving then begin
  dic_close_dns;
  FTaskNode:='';
 end;
end;

function TDimClients.GetServing:Boolean;
begin
 if (Self<>nil)
 then Result:=(Length(FTaskNode)>0)
 else Result:=false;
end;

function TDimClients.GetTaskName:LongString;
begin
 if (Self<>nil)
 then Result:=StrAheadOf(FTaskNode,'@')
 else Result:='';
end;

function TDimClients.GetTaskNode:LongString;
begin
 if (Self<>nil)
 then Result:=FTaskNode
 else Result:='';
end;

function TDimClients.GetInfoServices:TDimThreadList;
begin
 if (Self<>nil)
 then Result:=FInfoServices
 else Result:=nil;
end;

function TDimClients.GetCmndServices:TDimThreadList;
begin
 if (Self<>nil)
 then Result:=FCmndServices
 else Result:=nil;
end;

function TDimClients.StartServing(DNS:LongString=''):Boolean;
var Buff:packed array[0..MAX_PATH] of Char;
begin
 Result:=false;
 if (Self=nil) then Exit;
 if Serving then StopServing;
 if (DNS<>'') then DnsNode:=DNS;
 if (DnsNode='') then Exit;
 if (InfoServices.CountServices>0)
 or (CmndServices.CountServices>0)
 then StartServices else Exit;
 if (dic_get_id(Buff)<>0)
 then FTaskNode:=Buff
 else StopServing;
 Result:=Serving;
end;

function TDimClients.GetDnsNode:LongString;
var Node:packed array[0..MAX_PATH] of Char;
begin
 if dic_get_dns_node(Node)>0
 then Result:=Node
 else Result:='';
end;

procedure TDimClients.SetDnsNode(Node:LongString);
begin
 dic_set_dns_node(PChar(Node));
end;

 /////////////////
 // DIM Exceptions
 /////////////////
const
 DimReportBug : TDimBugReport = nil;

procedure DimBugReport(E:Exception; O:TObject; Note:LongString);
begin
 if Assigned(DimReportBug) then DimReportBug(E,O,Note);
end;

procedure SetDimBugReport(Report:TDimBugReport);
begin
 DimReportBug:=Report;
end;

 ///////////////
 // Common stuff
 ///////////////

function GetEnvDimDnsNode:LongString;
var Node:packed array[0..MAX_PATH] of Char;
begin
 if get_dns_node_name(Node)>0
 then Result:=StrLower(Node)
 else Result:='';
end;

function GetLocalHostNode:LongString;
var Node:packed array[0..MAX_PATH] of Char;
begin
 if get_node_name(Node)>0
 then Result:=StrLower(Node)
 else Result:='';
end;

function GetDimDnsNode:LongString;
var Node:packed array[0..MAX_PATH] of Char;
begin
 if dim_get_dns_node(Node)>0
 then Result:=StrLower(Node)
 else Result:='';
end;

function GetDicDnsNode:LongString;
var Node:packed array[0..MAX_PATH] of Char;
begin
 if dic_get_dns_node(Node)>0
 then Result:=StrLower(Node)
 else Result:='';
end;

function GetDisDnsNode:LongString;
var Node:packed array[0..MAX_PATH] of Char;
begin
 if dis_get_dns_node(Node)>0
 then Result:=StrLower(Node)
 else Result:='';
end;

procedure SetDimDnsNode(Node:LongString);
begin
 dim_set_dns_node(PChar(Node));
end;

procedure SetDicDnsNode(Node:LongString);
begin
 dic_set_dns_node(PChar(Node));
end;

procedure SetDisDnsNode(Node:LongString);
begin
 dis_set_dns_node(PChar(Node));
end;

function DimSpecifierSize(s:Char):SizeInt;
begin
 case UpCase(s) of
  'C' : Result:=SizeOf(Char);
  'D' : Result:=SizeOf(Double);
  'F' : Result:=SizeOf(Single);
  'I' : Result:=SizeOf(Integer);
  'L' : Result:=SizeOf(Integer);
  'S' : Result:=SizeOf(SmallInt);
  'X' : Result:=SizeOf(Int64);
  else  Result:=0;
 end;
end;

function DimParseServiceType(ServiceType:LongString; Separator:LongString=':'; Delimeter:LongString=';'; TrailZero:Boolean=false):LongString;
var i,errors:SizeInt; c:Char; spec,list:LongString;
 procedure Ignore;
 begin
 end;
 procedure AddSpec(Def:Integer);
 var len,siz:SizeInt;
 begin
  if spec<>'' then begin                                        // Skip specifier if one empty
   if (Length(spec)=1) then spec:=spec+IntToStr(Def);           // Default length if single char
   siz:=DimSpecifierSize(spec[1]); if (siz=0) then inc(errors); // Check type specifier is valid
   len:=StrToIntDef(Copy(spec,2,Length(spec)-1),-1);            // Extract length
   if (Separator<>'') then System.Insert(Separator,spec,2);     // Insert separator
   if (Def>0) and (len=0) then inc(errors);                     // Non-trailing zero length?
   if (Def=0) and (len=0) then begin                            // Trailing zero length?
    if not TrailZero then spec:=spec[1];                        //  handle it
   end;                                                         //
   if (len<0) then inc(errors);                                 // Invalid length?
   if (list='') then list:=spec else list:=list+Delimeter+spec; // Add modified specifier to list
   spec:=''                                                     // Clear specifier buffer
  end;
 end;
begin
 Result:='';
 errors:=0; spec:=''; list:='';
 ServiceType:=Trim(ServiceType);           // Remove leading/trailing spaces
 for i:=Length(ServiceType) downto 1 do    // Remove
 if (ServiceType[i] in [#0..' ',';',','])  //  trailing
 then Delete(ServiceType,i,1) else Break;  //  delimeters
 for i:=1 to Length(ServiceType) do begin
  c:=UpCase(ServiceType[i]);               // Enforce upper case
  case c of
   ':',' ' : Ignore;                       // Ignore spaces and separator chars
   ';',',' : AddSpec(1);                   // On delimeters - add specifier to list
   #13,#10 : AddSpec(1);                   // On delimeters - add specifier to list
   'L' : spec:=spec+'I';                   // Replace L specifiers to I equivalent
   else  spec:=spec+c;                     // Accumulate all other chars
  end;
 end;
 if (spec<>'') then AddSpec(0);            // Handle last item: if no length specified, set 0
 if (errors=0) then Result:=list;          // Return result list or empty string on errors
end;

function DimLastTypeSpecifier(ServiceType:LongString):Char;
var i:SizeInt;
begin
 Result:=#0;
 for i:=Length(ServiceType) downto 1 do
 if DimSpecifierSize(ServiceType[i])>0 then begin
  Result:=UpCase(ServiceType[i]);
  Break;
 end;
end;

function DimServiceTypeSize(ServiceType:LongString; TrailLength:SizeInt=1):SizeInt;
var i,errors,size:SizeInt; c:Char; spec:LongString;
 procedure Ignore;
 begin
 end;
 procedure AddSpec(Def:Integer);
 var len,siz:SizeInt;
 begin
  if spec<>'' then begin
   if (Length(spec)=1) then spec:=spec+IntToStr(Def);
   siz:=DimSpecifierSize(spec[1]); if (siz=0) then inc(errors);
   len:=StrToIntDef(Copy(spec,2,Length(spec)-1),-1);
   if (Def>0) and (len=0) then inc(errors);
   if (Def=0) and (len=0) then len:=TrailLength;
   if (len<0) then inc(errors);
   inc(size,len*siz);
   spec:=''
  end;
 end;
begin
 Result:=0;
 errors:=0; spec:=''; size:=0;
 ServiceType:=Trim(ServiceType);
 for i:=Length(ServiceType) downto 1 do
 if (ServiceType[i] in [#0..' ',';',','])
 then Delete(ServiceType,i,1) else Break;
 for i:=1 to Length(ServiceType) do begin
  c:=UpCase(ServiceType[i]);
  case c of
   ':',' ' : Ignore;
   ';',',' : AddSpec(1);
   #13,#10 : AddSpec(1);
   'L' : spec:=spec+'I';
   else  spec:=spec+c;
  end;
 end;
 if (spec<>'') then AddSpec(0);
 if (errors=0) then Result:=size;        
end;

procedure ClearDimTrafficCounts;
begin
 SafeFillChar(DimTrafficCounts,SizeOf(DimTrafficCounts),0);
end;

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

procedure Init_crw_dimc;
begin
 SetDimBugReport(BugReport);
 ClearDimTrafficCounts;
 DimClients;
end;

procedure Free_crw_dimc;
begin
 FreeAndNil(TheDimClients);
 ClearDimTrafficCounts;
end;

initialization

 Init_crw_dimc;

finalization

 Free_crw_dimc;

end.

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

