////////////////////////////////////////////////////////////////////////////////
//                                                                            //
//        Copyright (c) 2020 Alexey Kuryakin kouriakine@mail.ru               //
//                                                                            //
//                            Under LGPL license                              //
//                                                                            //
////////////////////////////////////////////////////////////////////////////////
unit EasyIpc; // Easy single thread duplex text InterProcess Communication pipe.

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

interface

uses
 sysutils, windows, classes, math;

{$IFNDEF FPC}
const                                                                            // Constants for old Delphi
 LineEnding         = #13#10; sLineBreak = LineEnding;                           // LineEnding, sLineBreak
 DirectorySeparator = '\';    PathDelim  = DirectorySeparator;                   // DirectorySeparator
 PathSeparator      = ';';    PathSep    = PathSeparator;                        // PathSeparator
type
 PtrInt = LongInt; PtrUint = LongWord; IntPtr = PtrInt; UintPtr = PtrUint;       // Pointer-size integers
{$ENDIF}

/////////////////////////////////////////////////////////////////////////////////
// EasyIPC is easy, single thread, duplex (bidirect) Inter Process Communication.
// It's peer to peer clent-server text communication channel. Use HEX encoding to
// transfer binary data. Use polling (for example, with timer) to Send/Recv data.
// EasyIPC makes all IO operations in non-blocking manner so thread never blocks.
// At least it is true if TimeOut=0.
//
// EasyIpc_Init(PipeName,Options) - create IPC object and return his handle or 0.
//  PipeName - Host\Name for IPC client, Name for IPC server. "." mean Localhost.
//             Name should be system-unique identifier string. Example: .\DemoIpc
//  Options  - LineEnding delimited text as OptionName=OptionValue, where options
//             is {TimeOut,RxBuffSize,TxBuffSize,LogsHistory}.
//
// EasyIpc_Free(hIpc) - Free (delete) EasyIpc object hIpc (EasyIpc_Init created).
//
// EasyIpc_Poll(hIpc) - Polling I/O procedure to be called periodically by timer.
//  EasyIpc_Poll(hIpc) call is equivalent to EasyIpc_Recv(hIpc,0), but faster.
//
// EasyIpc_Send(hIpc,TextLines)  - Send TextLines to transmitter FIFO and pipe.
//
// EasyIpc_Recv(hIpc,Count)  - Receive text (upto Count byte) from receiver FIFO.
//
// EasyIpc_Ctrl(hIpc,Request)  - Query or Control IPC object via Request command.
//  Request are "Name=Value" to set or "Name" to get the value of parameter Name.
//  Name can be {Connected,IsServer,IsClient,FileName,PipeName,HostName,BaseName,
//  Handle,TimeOut,RxBuffSize,TxBuffSize,RxLost,TxLost,RxFifoLimit,TxFifoLimit,
//  RxTotal,TxTotal,RxLength,TxLength,LogsHistory}
//
/////////////////////////////////////////////////////////////////////////////////
function EasyIpc_Init(const PipeName,Options:String):PtrUint;
function EasyIpc_Free(hIpc:PtrUint):Boolean;
function EasyIpc_Poll(hIpc:PtrUint):Boolean;
function EasyIpc_Send(hIpc:PtrUint; const TextLines:String):Boolean;
function EasyIpc_Recv(hIpc:PtrUint; Count:Integer):String;
function EasyIpc_Ctrl(hIpc:PtrUint; const Request:String):String;

/////////////////////////////////////////////////////////////////////////////////
// EasyIpc is simplified TEasyPipe's wrapper - specially to embed to interpreters
// like DieselPascal, DaqPascal, DaqScript etc.  Most codes located in TEasyPipe.
/////////////////////////////////////////////////////////////////////////////////

const
 DefPipeTimeOut     = 0;                                                         // Default pipe timeout
 MinPipeBuffSize    = 1024;                                                      // Minimal pipe buffer size
 DefPipeBuffSize    = 1024*64;                                                   // Default pipe buffer size
 MinPipeFifoLimit   = 1024*128;                                                  // Minimal pipe FIFO limit
 DefPipeFifoLimit   = 1024*1024*4;                                               // Default pipe FIFO limit
 DefPipeLogsHistory = 0;                                                         // Default history for list of logs

type
 TEasyPipe = class(TObject)                                                      // Named pipe wrapper class
 private
  myHandle      : THandle;                                                       // Pipe file handle
  myFileName    : String;                                                        // Pipe file UNC name
  myRxFifo      : String;                                                        // Receiver    FIFO
  myTxFifo      : String;                                                        // Transmitter FIFO
  myRxBuffer    : String;                                                        // Receiver    buffer
  myTxBuffer    : String;                                                        // Transmitter buffer
  myRxFifoLimit : Integer;                                                       // Receiver    buffer limit
  myTxFifoLimit : Integer;                                                       // Transmitter buffer limit
  myIsServer    : Boolean;                                                       // Server or client?
  myConnected   : Boolean;                                                       // Connected?
  myRxPending   : Boolean;                                                       // Receiver pending IO
  myTxPending   : Boolean;                                                       // Transmitter pending IO
  myRxOverlap   : TOverlapped;                                                   // Receiver overlap
  myTxOverlap   : TOverlapped;                                                   // Transmitter overlap
  mySecDesc     : TSecurityDescriptor;                                           // Security descriptor
  mySecAttr     : TSecurityAttributes;                                           // Security attributes
  myTimeOut     : Integer;                                                       // Timeout to check connection
  myRxLost      : Int64;                                                         // Lost RxFifo bytes
  myTxLost      : Int64;                                                         // Lost TxFifo bytes
  myRxLast      : Int64;                                                         // Last value of RxLost
  myTxLast      : Int64;                                                         // Last value of TxLost
  myRxTotal     : Int64;                                                         // Count bytes received by Rx
  myTxTotal     : Int64;                                                         // Count bytes written  by Tx
  myLastCheck   : Cardinal;                                                      // Time when last check done
  myLogsHistory : Integer;                                                       // History for list of logs
  myLogsList    : TStringList;                                                   // List of operation logs
 private
  function    GetFileName:String;                                                // As \\host\pipe\name
  function    GetPipeName:String;                                                // As host\name
  function    GetHostName:String;                                                // As host
  function    GetBaseName:String;                                                // As name
  function    GetHandle:THandle;
  function    GetTimeOut:Integer;
  function    GetIsServer:Boolean;
  function    GetIsClient:Boolean;
  function    GetConnected:Boolean;
  function    GetRxBuffSize:Integer;
  function    GetTxBuffSize:Integer;
  function    GetRxFifoLimit:Integer;
  procedure   SetRxFifoLimit(aLimit:Integer);
  function    GetTxFifoLimit:Integer;
  procedure   SetTxFifoLimit(aLimit:Integer);
  function    GetLogsHistory:Integer;
  procedure   SetLogsHistory(aHistory:Integer);
  function    GetRxLost:Int64;
  function    GetTxLost:Int64;
  function    GetRxTotal:Int64;
  function    GetTxTotal:Int64;
  function    GetRxLength:Integer;
  function    GetTxLength:Integer;
  function    GetLogsCount:Integer;
  function    GetLogsTextMove:String;
  function    GetLogsTextCopy:String;
  procedure   OnTxSent(TxCount:DWord);
  procedure   OnRxRead(RxCount:DWord);
  procedure   Report(const What:String; Code:Integer);                           // Add report to logs
  procedure   Close(aErrorCode,aRxLost,aTxLost:Integer);                         // Close pipe handle
 public
  constructor Create(const aPipeName    : String;                                // Host\Name(client) or Name(server)
                           aRxBuffSize  : Integer;                               // Rx Buffer size
                           aTxBuffSize  : Integer;                               // Tx Buffer size
                           aTimeOut     : Integer;                               // Timeout for connections
                           aLogsHistory : Integer);                              // History for list of logs
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
  destructor  Destroy; override;
 public
  procedure   Poll;                                                              // To be called by timer
  property    FileName     : String    read GetFileName;                         // Pipe UNC name as \\host\pipe\name
  property    PipeName     : String    read GetPipeName;                         // As host\name (client) or name (server)
  property    HostName     : String    read GetHostName;                         // Get host name
  property    BaseName     : String    read GetBaseName;                         // Get base name
  property    Handle       : THandle   read GetHandle;                           // Pipe handle
  property    TimeOut      : Integer   read GetTimeOut;                          // TimeOut, ms
  property    IsServer     : Boolean   read GetIsServer;                         // Is Server mode?
  property    IsClient     : Boolean   read GetIsClient;                         // Is Client mode?
  property    Connected    : Boolean   read GetConnected;                        // Connected?
  property    RxBuffSize   : Integer   read GetRxBuffSize;                       // Rx buffer size
  property    TxBuffSize   : Integer   read GetTxBuffSize;                       // Tx buffer size
  property    RxLost       : Int64     read GetRxLost;                           // Rx lost bytes
  property    TxLost       : Int64     read GetTxLost;                           // Tx lost bytes
  property    RxTotal      : Int64     read GetRxTotal;                          // Rx received bytes
  property    TxTotal      : Int64     read GetTxTotal;                          // Tx written  bytes
  property    RxLength     : Integer   read GetRxLength;                         // Rx FIFO data length
  property    TxLength     : Integer   read GetTxLength;                         // Tx FIFO data length
  property    RxFifoLimit  : Integer   read GetRxFifoLimit write SetRxFifoLimit; // Rx Fifo size limit
  property    TxFifoLimit  : Integer   read GetTxFifoLimit write SetTxFifoLimit; // Tx Fifo size limit
  property    LogsHistory  : Integer   read GetLogsHistory write SetLogsHistory; // History for list of logs
  property    LogsCount    : Integer   read GetLogsCount;                        // Count of logs in list.
  property    LogsTextMove : String    read GetLogsTextMove;                     // Get logs as text and clear
  property    LogsTextCopy : String    read GetLogsTextCopy;                     // Get logs as text and stay
  function    GetRxFifo(Count:Integer=MaxInt):String;                            // Receiver    FIFO readout
  function    GetTxFifo(Count:Integer=MaxInt):String;                            // Transmitter FIFO readout
  procedure   PutRxFifo(const Data:String);                                      // Receiver    FIFO writing
  procedure   PutTxFifo(const Data:String);                                      // Transmitter FIFO writing
  procedure   Clear(const What:String);                                          // Clear('RxFifo,TxFifo,RxLost,TxLost,Logs')
 end;

function  NewEasyPipe(const aPipeName    : String;                               // Host\Name(client) or Name(server)
                            aRxBuffSize  : Integer         = DefPipeBuffSize;    // Rx Buffer size
                            aTxBuffSize  : Integer         = DefPipeBuffSize;    // Tx Buffer size
                            aTimeOut     : Integer         = DefPipeTimeOut;     // Timeout for connections
                            aLogsHistory : Integer         = DefPipeLogsHistory  // History for list of logs
                                       ) : TEasyPipe;

const FullEasyPipeList:TThreadList=nil; // Full list of all pipes

implementation

 /////////////////////////////////////////////////////
 // Private Dictionary for fast string identification.
 /////////////////////////////////////////////////////
type
 TStringIdentifier = (
  sid_Unknown,
  sid_Connected,
  sid_IsServer,
  sid_IsClient,
  sid_FileName,
  sid_PipeName,
  sid_HostName,
  sid_BaseName,
  sid_Handle,
  sid_TimeOut,
  sid_RxBuffSize,
  sid_TxBuffSize,
  sid_RxLost,
  sid_TxLost,
  sid_RxTotal,
  sid_TxTotal,
  sid_RxLength,
  sid_TxLength,
  sid_RxFifoLimit,
  sid_TxFifoLimit,
  sid_LogsHistory,
  sid_LogsCount,
  sid_LogsTextMove,
  sid_LogsTextCopy,
  sid_Clear,
  sid_Asterisk,
  sid_Unused
 );

const
 Dictionary:TStringList=nil;

procedure FreeDictionary;
begin
 FreeAndNil(Dictionary);
end;

procedure InitDictionary;
 procedure AddSid(const key:String; sid:TStringIdentifier);
 begin
  Dictionary.AddObject(key,TObject(PtrInt(Ord(sid))));
 end;
begin
 if (Dictionary<>nil) then Exit;
 Dictionary:=TStringList.Create;
 Dictionary.Sorted:=true;
 /////////////////////////////////////////////
 // Dictionary for fast strings identification
 /////////////////////////////////////////////
 AddSid( 'Connected'          , sid_Connected);
 AddSid( 'IsServer'           , sid_IsServer);
 AddSid( 'IsClient'           , sid_IsClient);
 AddSid( 'FileName'           , sid_FileName);
 AddSid( 'PipeName'           , sid_PipeName);
 AddSid( 'HostName'           , sid_HostName);
 AddSid( 'BaseName'           , sid_BaseName);
 AddSid( 'Handle'             , sid_Handle);
 AddSid( 'TimeOut'            , sid_TimeOut);
 AddSid( 'RxBuffSize'         , sid_RxBuffSize);
 AddSid( 'TxBuffSize'         , sid_TxBuffSize);
 AddSid( 'RxLost'             , sid_RxLost);
 AddSid( 'TxLost'             , sid_TxLost);
 AddSid( 'RxTotal'            , sid_RxTotal);
 AddSid( 'TxTotal'            , sid_TxTotal);
 AddSid( 'RxLength'           , sid_RxLength);
 AddSid( 'TxLength'           , sid_TxLength);
 AddSid( 'RxFifoLimit'        , sid_RxFifoLimit);
 AddSid( 'TxFifoLimit'        , sid_TxFifoLimit);
 AddSid( 'LogsHistory'        , sid_LogsHistory);
 AddSid( 'LogsCount'          , sid_LogsCount);
 AddSid( 'LogsTextMove'       , sid_LogsTextMove);
 AddSid( 'LogsTextCopy'       , sid_LogsTextCopy);
 AddSid( 'Clear'              , sid_Clear);
 AddSid( '*'                  , sid_Asterisk);
end;

function Identify(const key:String):TStringIdentifier;
var i,sid:Integer;
begin
 if (Dictionary=nil) then InitDictionary;
 i:=Dictionary.IndexOf(key);
 if (i<0) then sid:=Ord(sid_Unknown) else sid:=PtrInt(Dictionary.Objects[i]);
 if (sid>=Ord(Low(TStringIdentifier))) and (sid<=Ord(High(TStringIdentifier)))
 then Result:=TStringIdentifier(sid)
 else Result:=sid_Unknown;
end;

 /////////////////////////
 // EasyIPC implementation
 /////////////////////////

function EasyIpc_Init(const PipeName,Options:String):PtrUint;
var List:TStringList; RxBuffSize,TxBuffSize,TimeOut,LogsHistory:Integer;
begin
 TimeOut:=DefPipeTimeOut;
 RxBuffSize:=DefPipeBuffSize;
 TxBuffSize:=DefPipeBuffSize;
 LogsHistory:=DefPipeLogsHistory;
 if (Options<>'') then begin
  List:=TStringList.Create;
  try
   List.Text:=AdjustLineBreaks(Options);
   TimeOut:=StrToIntDef(Trim(List.Values['TimeOut']),DefPipeTimeOut);
   RxBuffSize:=StrToIntDef(Trim(List.Values['RxBuffSize']),DefPipeBuffSize);
   TxBuffSize:=StrToIntDef(Trim(List.Values['TxBuffSize']),DefPipeBuffSize);
   LogsHistory:=StrToIntDef(Trim(List.Values['LogsHistory']),DefPipeLogsHistory);
  finally
   List.Free;
  end;
 end;
 Result:=PtrUint(NewEasyPipe(PipeName,RxBuffSize,TxBuffSize,TimeOut,LogsHistory));
end;

function IsValidIpc(hIpc:PtrUint):Boolean;
var List:TList;
begin
 Result:=false;
 if (hIpc=0) then Exit;
 if (FullEasyPipeList<>nil) then begin
  List:=FullEasyPipeList.LockList;
  try
   if (List.IndexOf(Pointer(hIpc))<0) then Exit;
  finally
   FullEasyPipeList.UnlockList;
  end;
 end;
 Result:=true;
end;

function EasyIpc_Free(hIpc:PtrUint):Boolean;
begin
 Result:=false;
 if not IsValidIpc(hIpc) then Exit;
 TEasyPipe(hIpc).Free;
 Result:=true;
end;

function EasyIpc_Poll(hIpc:PtrUint):Boolean;
begin
 Result:=false;
 if not IsValidIpc(hIpc) then Exit;
 TEasyPipe(hIpc).Poll;
 Result:=true;
end;

function EasyIpc_Send(hIpc:PtrUint; const TextLines:String):Boolean;
begin
 Result:=false;
 if not IsValidIpc(hIpc) then Exit;
 if (TextLines<>'') then TEasyPipe(hIpc).PutTxFifo(AdjustLineBreaks(TextLines)); TEasyPipe(hIpc).Poll;
end;

function EasyIpc_Recv(hIpc:PtrUint; Count:Integer):String;
begin
 Result:='';
 if not IsValidIpc(hIpc) then Exit;
 TEasyPipe(hIpc).Poll; if (Count>0) then Result:=AdjustLineBreaks(TEasyPipe(hIpc).GetRxFifo(Count));
end;

function EasyIpc_Ctrl(hIpc:PtrUint; const Request:String):String;
var n,v:String; p:Integer;
 procedure AddItem(var S:String; const Name:String);
 begin
  S:=S+(Name+'='+EasyIpc_Ctrl(hIpc,Name)+LineEnding);
 end;
begin
 Result:='';
 p:=Pos('=',Request);
 if (p>0) then begin
  n:=Trim(Copy(Request,1,p-1));
  v:=Trim(Copy(Request,p+1,MaxInt));
 end else begin
  n:=Trim(Request);
  v:='';
 end;
 if (n='') then Exit;
 if not IsValidIpc(hIpc) then Exit;
 case Identify(n) of
  sid_Connected: begin
   Result:=IntToStr(Ord(TEasyPipe(hIpc).Connected));
   Exit;
  end;
  sid_IsServer: begin
   Result:=IntToStr(Ord(TEasyPipe(hIpc).IsServer));
   Exit;
  end;
  sid_IsClient: begin
   Result:=IntToStr(Ord(TEasyPipe(hIpc).IsClient));
   Exit;
  end;
  sid_FileName: begin
   Result:=TEasyPipe(hIpc).FileName;
   Exit;
  end;
  sid_PipeName: begin
   Result:=TEasyPipe(hIpc).PipeName;
   Exit;
  end;
  sid_HostName: begin
   Result:=TEasyPipe(hIpc).HostName;
   Exit;
  end;
  sid_BaseName: begin
   Result:=TEasyPipe(hIpc).BaseName;
   Exit;
  end;
  sid_Handle: begin
   Result:=IntToStr(TEasyPipe(hIpc).Handle);
   Exit;
  end;
  sid_TimeOut: begin
   Result:=IntToStr(TEasyPipe(hIpc).TimeOut);
   Exit;
  end;
  sid_RxBuffSize: begin
   Result:=IntToStr(TEasyPipe(hIpc).RxBuffSize);
   Exit;
  end;
  sid_TxBuffSize: begin
   Result:=IntToStr(TEasyPipe(hIpc).TxBuffSize);
   Exit;
  end;
  sid_RxLost: begin
   Result:=IntToStr(TEasyPipe(hIpc).RxLost);
   Exit;
  end;
  sid_TxLost: begin
   Result:=IntToStr(TEasyPipe(hIpc).TxLost);
   Exit;
  end;
  sid_RxTotal: begin
   Result:=IntToStr(TEasyPipe(hIpc).RxTotal);
   Exit;
  end;
  sid_TxTotal: begin
   Result:=IntToStr(TEasyPipe(hIpc).TxTotal);
   Exit;
  end;
  sid_RxLength: begin
   Result:=IntToStr(TEasyPipe(hIpc).RxLength);
   Exit;
  end;
  sid_TxLength: begin
   Result:=IntToStr(TEasyPipe(hIpc).TxLength);
   Exit;
  end;
  sid_RxFifoLimit: begin
   Result:=IntToStr(TEasyPipe(hIpc).RxFifoLimit);
   Exit;
  end;
  sid_TxFifoLimit: begin
   Result:=IntToStr(TEasyPipe(hIpc).TxFifoLimit);
   Exit;
  end;
  sid_LogsHistory:  begin
   if (v<>'') then TEasyPipe(hIpc).LogsHistory:=StrToIntDef(v,TEasyPipe(hIpc).LogsHistory);
   Result:=IntToStr(TEasyPipe(hIpc).LogsHistory);
   Exit;
  end;
  sid_LogsCount: begin
   Result:=IntToStr(TEasyPipe(hIpc).LogsCount);
   Exit;
  end;
  sid_LogsTextMove: begin
   Result:=TEasyPipe(hIpc).LogsTextMove;
   Exit;
  end;
  sid_LogsTextCopy: begin
   Result:=TEasyPipe(hIpc).LogsTextCopy;
   Exit;
  end;
  sid_Clear: begin
   if (v<>'') then TEasyPipe(hIpc).Clear(v);
   Exit;
  end;
  sid_Asterisk: begin
   AddItem(Result,'Connected');
   AddItem(Result,'IsServer');
   AddItem(Result,'IsClient');
   AddItem(Result,'FileName');
   AddItem(Result,'PipeName');
   AddItem(Result,'HostName');
   AddItem(Result,'BaseName');
   AddItem(Result,'RxLost');
   AddItem(Result,'TxLost');
   AddItem(Result,'RxTotal');
   AddItem(Result,'TxTotal');
   AddItem(Result,'RxLength');
   AddItem(Result,'TxLength');
   AddItem(Result,'Handle');
   AddItem(Result,'TimeOut');
   AddItem(Result,'LogsCount');
   AddItem(Result,'LogsHistory');
   AddItem(Result,'RxBuffSize');
   AddItem(Result,'TxBuffSize');
   AddItem(Result,'RxFifoLimit');
   AddItem(Result,'TxFifoLimit');
   Exit;
  end;
 end;
end;

 ///////////////////////
 // TEasyPipe implementation
 ///////////////////////
function TEasyPipe.GetFileName:String;
begin
 if (Self=nil) then Result:='' else Result:=myFileName;
end;

function TEasyPipe.GetPipeName:String;
begin
 if (Self=nil) then Result:='' else
 if myIsServer then Result:=BaseName else Result:=HostName+DirectorySeparator+BaseName;
end;

function TEasyPipe.GetHostName:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 if myIsServer then Exit;
 Result:=ExtractFileDir(ExtractFileDir(Copy(myFileName,3,Length(myFileName)-2)));
end;

function TEasyPipe.GetBaseName:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 Result:=ExtractFileName(myFileName);
end;

function TEasyPipe.GetHandle:THandle;
begin
 if (Self=nil) then Result:=0 else Result:=myHandle;
end;

function TEasyPipe.GetTimeOut:Integer;
begin
 if (Self=nil) then Result:=0 else Result:=myTimeOut;
end;

function TEasyPipe.GetIsServer:Boolean;
begin
 if (Self=nil) then Result:=false else Result:=myIsServer;
end;

function TEasyPipe.GetIsClient:Boolean;
begin
 if (Self=nil) then Result:=false else Result:=not myIsServer;
end;

function TEasyPipe.GetRxBuffSize:Integer;
begin
 if (Self=nil) then Result:=0 else Result:=Length(myRxBuffer);
end;

function TEasyPipe.GetTxBuffSize:Integer;
begin
 if (Self=nil) then Result:=0 else Result:=Length(myTxBuffer);
end;

function TEasyPipe.GetRxFifoLimit:Integer;
begin
 if (Self=nil) then Result:=0 else Result:=myRxFifoLimit;
end;

procedure TEasyPipe.SetRxFifoLimit(aLimit:Integer);
begin
 if (Self=nil) then Exit;
 myRxFifoLimit:=Max(MinPipeFifoLimit,aLimit);
end;

function TEasyPipe.GetTxFifoLimit:Integer;
begin
 if (Self=nil) then Result:=0 else Result:=myTxFifoLimit;
end;

procedure TEasyPipe.SetTxFifoLimit(aLimit:Integer);
begin
 if (Self=nil) then Exit;
 myTxFifoLimit:=Max(MinPipeFifoLimit,aLimit);
end;

function TEasyPipe.GetRxLost:Int64;
begin
 if (Self=nil) then Result:=0 else Result:=myRxLost;
end;

function TEasyPipe.GetTxLost:Int64;
begin
 if (Self=nil) then Result:=0 else Result:=myTxLost;
end;

function TEasyPipe.GetRxTotal:Int64;
begin
 if (Self=nil) then Result:=0 else Result:=myRxTotal;
end;

function TEasyPipe.GetTxTotal:Int64;
begin
 if (Self=nil) then Result:=0 else Result:=myTxTotal;
end;

function TEasyPipe.GetRxLength:Integer;
begin
 if (Self=nil) then Result:=0 else Result:=Length(myRxFifo);
end;

function TEasyPipe.GetTxLength:Integer;
begin
 if (Self=nil) then Result:=0 else Result:=Length(myTxFifo);
end;

function TEasyPipe.GetRxFifo(Count:Integer):String;
begin
 Result:='';
 if (Self=nil) then Exit;
 Count:=Min(Count,Length(myRxFifo));
 if (Count<=0) then Exit;
 Result:=Copy(myRxFifo,1,Count);
 Delete(myRxFifo,1,Count); 
end;

function TEasyPipe.GetTxFifo(Count:Integer):String;
begin
 Result:='';
 if (Self=nil) then Exit;
 Count:=Min(Count,Length(myTxFifo));
 if (Count<=0) then Exit;
 Result:=Copy(myTxFifo,1,Count);
 Delete(myTxFifo,1,Count); 
end;

procedure TEasyPipe.PutRxFifo(const Data:String);
begin
 if (Self=nil) then Exit; if (Data='') then Exit;
 if (Length(myRxFifo)+Length(Data)>myRxFifoLimit) then begin
  Report('RxFifoOverflowDataLost',Length(Data)); 
  Inc(myRxLost,Length(Data));
  Exit;
 end;
 myRxFifo:=myRxFifo+Data; 
end;

procedure TEasyPipe.PutTxFifo(const Data:String);
begin
 if (Self=nil) then Exit; if (Data='') then Exit;
 if (Length(myTxFifo)+Length(Data)>myTxFifoLimit) then begin
  Report('TxFifoOverflowDataLost',Length(Data)); 
  Inc(myTxLost,Length(Data));
  Exit;
 end;
 myTxFifo:=myTxFifo+Data; 
end;

function TEasyPipe.GetConnected:Boolean;
begin
 if (Self=nil) then Result:=false else Result:=myConnected;
end;

function TEasyPipe.GetLogsHistory:Integer;
begin
 if (Self=nil) then Result:=0 else Result:=myLogsHistory;
end;

procedure TEasyPipe.SetLogsHistory(aHistory:Integer);
begin
 if (Self=nil) then Exit;
 myLogsHistory:=Max(0,aHistory);
end;

function TEasyPipe.GetLogsCount:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if (myLogsList=nil) then Exit;
 Result:=myLogsList.Count;
end;

function TEasyPipe.GetLogsTextMove:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 if (myLogsList=nil) then Exit;
 Result:=myLogsList.Text;
 myLogsList.Clear;
end;

function TEasyPipe.GetLogsTextCopy:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 if (myLogsList=nil) then Exit;
 Result:=myLogsList.Text;
end;

procedure TEasyPipe.Report(const What:String; Code:Integer);
begin
 if (Self=nil) then Exit;
 if (myLogsList=nil) then Exit;
 while (myLogsList.Count>Max(0,myLogsHistory)) do myLogsList.Delete(0); if (myLogsHistory<=0) then Exit;
 myLogsList.Add(FormatDateTime('yyyy.mm.dd-hh:nn:ss',Now)+' => '+myFileName+' '+What+' Code '+IntToStr(Code));
end;

procedure TEasyPipe.OnRxRead(RxCount:DWORD);
begin
 if (Self=nil) then Exit;
 Inc(myRxTotal,RxCount);
 if (myLogsList=nil) then Exit;
 if (myLogsHistory<=0) then Exit;
 Report('RxRead='+IntToStr(RxCount),ERROR_SUCCESS);
end;

procedure TEasyPipe.OnTxSent(TxCount:DWORD);
begin
 if (Self=nil) then Exit;
 Inc(myTxTotal,TxCount);
 if (myLogsList=nil) then Exit;
 if (myLogsHistory<=0) then Exit;
 Report('TxSent='+IntToStr(TxCount),ERROR_SUCCESS);
end;


procedure TEasyPipe.Close(aErrorCode,aRxLost,aTxLost:Integer);
begin
 if Assigned(Self) then begin
  if myHandle <> INVALID_HANDLE_VALUE then begin                               // If file opened
   CloseHandle(myHandle);                                                      // Close file
   myHandle:=INVALID_HANDLE_VALUE;                                             // Mark it closed
   myConnected:=false;                                                         // No connection
   myRxPending:=false;                                                         // No pending read
   myTxPending:=false;                                                         // No pending write
   FillChar(myRxOverlap,sizeof(myRxOverlap),0);                                // Clear read overlap
   FillChar(myTxOverlap,sizeof(myTxOverlap),0);                                // Clear write overlap
  end;
  if (aErrorCode<>ERROR_SUCCESS) or (aRxLost+aTxLost<>0) then begin            // If error occured
   myRxLost:=myRxLost+Length(myRxFifo)+aRxLost;                                // Receiver data lost
   myTxLost:=myTxLost+Length(myTxFifo)+aTxLost;                                // Transmitter data lost
  end;
  Report('Close',aErrorCode);
 end;
end;

constructor TEasyPipe.Create(const aPipeName    : String;
                                   aRxBuffSize  : Integer;
                                   aTxBuffSize  : Integer;
                                   aTimeOut     : Integer;
                                   aLogsHistory : Integer);
begin
 inherited Create;
 myHandle:=INVALID_HANDLE_VALUE;
 myIsServer:=(Trim(ExtractFileDir(aPipeName))='');
 if IsServer
 then myFileName:=Format('\\%s\pipe\%s',['.',Trim(ExtractFileName(aPipeName))])
 else myFileName:=Format('\\%s\pipe\%s',[Trim(ExtractFileDir(aPipeName)),Trim(ExtractFileName(aPipeName))]);
 myRxFifo:='';
 myTxFifo:='';
 myConnected:=false;
 myRxPending:=false;
 myTxPending:=false;
 myLogsList:=TStringList.Create;
 myLogsHistory:=Max(0,aLogsHistory);
 myRxFifoLimit:=DefPipeFifoLimit;
 myTxFifoLimit:=DefPipeFifoLimit;
 FillChar(myRxOverlap,sizeof(myRxOverlap),0);
 FillChar(myTxOverlap,sizeof(myTxOverlap),0);
 aRxBuffSize:=Max(MinPipeBuffSize,aRxBuffSize); myRxBuffer:=StringOfChar(#0,aRxBuffSize);
 aTxBuffSize:=Max(MinPipeBuffSize,aTxBuffSize); myTxBuffer:=StringOfChar(#0,aTxBuffSize);
 if InitializeSecurityDescriptor(@mySecDesc,SECURITY_DESCRIPTOR_REVISION) and
    SetSecurityDescriptorDacl(@mySecDesc,True,nil,True)
 then Report('InitializeSecurity',ERROR_SUCCESS)
 else Report('InitializeSecurity',GetLastError);
 mySecAttr.nLength:=sizeof(mySecAttr);
 mySecAttr.lpSecurityDescriptor:=@mySecDesc;
 mySecAttr.bInheritHandle:=False;
 myTimeOut:=aTimeOut;
 myRxLost:=0; myRxLast:=0; myRxTotal:=0;
 myTxLost:=0; myTxLast:=0; myTxTotal:=0;
 myLastCheck:=0;
end;

procedure TEasyPipe.AfterConstruction;
var List:TList;
begin
 inherited AfterConstruction;
 if (FullEasyPipeList<>nil) then begin
  List:=FullEasyPipeList.LockList;
  try
   List.Add(Self);
  finally
   FullEasyPipeList.UnlockList;
  end;
 end;
end;

procedure TEasyPipe.BeforeDestruction;
var List:TList;
begin
 if (FullEasyPipeList<>nil) then begin
  List:=FullEasyPipeList.LockList;
  try
   List.Remove(Self);
  finally
   FullEasyPipeList.UnlockList;
  end;
 end;
 inherited BeforeDestruction;
end;

destructor TEasyPipe.Destroy;
begin
 Close(ERROR_SUCCESS,0,0);
 FreeAndNil(myLogsList);
 myFileName:='';
 myRxFifo:='';
 myTxFifo:='';
 myRxBuffer:='';
 myTxBuffer:='';
 inherited Destroy;
end;

procedure TEasyPipe.Poll;
var RxCount,TxCount:DWORD;
begin
 if Assigned(Self) then begin
  //
  // If file handle is not created, try to create it
  //
  if myHandle = INVALID_HANDLE_VALUE then begin                                // If file not opened
   if IsServer then begin                                                      // Server:
    myHandle:=CreateNamedPipe(PChar(myFileName),                                   // pointer to pipe name
                            PIPE_ACCESS_DUPLEX or FILE_FLAG_OVERLAPPED,        // pipe open mode
                            PIPE_TYPE_BYTE or PIPE_READMODE_BYTE,              // pipe-specific modes
                            1,                                                 // maximum number of instances
                            Length(myTxBuffer),                                // output buffer size, in bytes
                            Length(myRxBuffer),                                // input buffer size, in bytes
                            myTimeOut,                                         // time-out time, msec
                            @mySecAttr);                                       // pointer to security attributes structure
    if myHandle <> INVALID_HANDLE_VALUE                                        // If file created
    then Report('CreateNamedPipe',ERROR_SUCCESS)                               // Then report success
    else Report('CreateNamedPipe',GetLastError);                               // Else report error
   end else begin                                                              // Client:
    myHandle:=CreateFile(PChar(myFileName),                                        // pointer to name of the file
                       GENERIC_READ or GENERIC_WRITE,                          // access mode
                       FILE_SHARE_READ or FILE_SHARE_WRITE,                    // share mode
                       @mySecAttr,                                             // security
                       OPEN_EXISTING,                                          // how to create
                       FILE_FLAG_OVERLAPPED,                                   // use overlapped I/O
                       0);                                                     // template file - not used
    if myHandle <> INVALID_HANDLE_VALUE                                        // If file created
    then Report('CreateFile',ERROR_SUCCESS)                                    // Report success
    else Report('CreateFile',GetLastError);                                    // Else report error
   end;
   if myHandle <> INVALID_HANDLE_VALUE then begin                              // If file was created
    myConnected:=false;                                                        // Mark no connection
    myRxPending:=false;                                                        // Mark no pending read
    myTxPending:=false;                                                        // Mark no pending write
    FillChar(myRxOverlap,sizeof(myRxOverlap),0);                               // Clear read overlap
    FillChar(myTxOverlap,sizeof(myTxOverlap),0);                               // Clear write overlap
   end else if (myTimeOut>0) then Sleep(myTimeOut);                            // If file fails,wait some time
  end;
  //
  // File created, may connect/read/write
  //
  if myHandle <> INVALID_HANDLE_VALUE then begin
   //
   // If not still connected, try to connect now...
   //
   if not myConnected then begin
    while ReadFile(myHandle,PChar(myRxBuffer)^,Length(myRxBuffer),RxCount,@myRxOverlap) // Read data to buffer
    do begin PutRxFifo(Copy(myRxBuffer,1,RxCount)); OnRxRead(RxCount); end;    // Transfer to FIFO
    case GetLastError of                                                       // Analize error:
     ERROR_PIPE_LISTENING:;                                                    // Server waiting for client
     ERROR_IO_PENDING:                                                         // Connection established
      begin
       myConnected:=true;                                                      // Mark we are connected
       myRxPending:=true;                                                      // Mark pending read
       Report('Connected',ERROR_SUCCESS);                                      // Mark connection
      end;
     ERROR_HANDLE_EOF: Close(GetLastError,RxCount,0);                          // End of file reached
     ERROR_BROKEN_PIPE: Close(GetLastError,RxCount,0);                         // Connection lost
     else Close(GetLastError,RxCount,0);                                       // Unknown error occured
    end;
   end;
   //
   // If connection esteblished, try to read from pipe...
   //
   if myConnected then begin                                                   // When connected
    if myRxPending then begin                                                  // When pending read:
     if GetOverlappedResult(myHandle,myRxOverlap,RxCount,FALSE) then begin     // If pending read complete
      PutRxFifo(Copy(myRxBuffer,1,RxCount)); OnRxRead(RxCount);                // Put data to FIFO
      myRxPending:=false;                                                      // Clear pending flag
     end else                                                                  // Else
     case GetLastError of                                                      // Analize errors:
      ERROR_IO_INCOMPLETE: ;                                                   // Wait for read completion
      ERROR_HANDLE_EOF: Close(GetLastError,RxCount,0);                         // End of file reached
      ERROR_BROKEN_PIPE: Close(GetLastError,RxCount,0);                        // Connection lost
      else Close(GetLastError,RxCount,0);                                      // Unknown error occured
     end;
    end else begin                                                             // When no pending read:
     if ReadFile(myHandle,PChar(myRxBuffer)^,Length(myRxBuffer),RxCount,@myRxOverlap)   // If read immediatly
     then begin PutRxFifo(Copy(myRxBuffer,1,RxCount)); OnRxRead(RxCount); end  // Then put data to FIFO
     else                                                                      // If not read immediatly
     case GetLastError of                                                      // Analize error:
      ERROR_IO_PENDING: myRxPending:=true;                                     // Mark pending read
      ERROR_HANDLE_EOF: Close(GetLastError,RxCount,0);                         // End of file reached
      ERROR_BROKEN_PIPE: Close(GetLastError,RxCount,0);                        // Connection lost
      else Close(GetLastError,RxCount,0);                                      // Unknown error occured
     end;
    end;
   end;
   //
   // If connection esteblished, try to write to pipe...
   //
   if myConnected then begin                                                   // When connected
    if myTxPending then begin                                                  // When pending write:
     if GetOverlappedResult(myHandle,myTxOverlap,TxCount,FALSE)                // If write complete
     then begin myTxPending:=false; OnTxSent(TxCount); end                     // Clear pending flag
     else                                                                      // If not write complete
     case GetLastError of                                                      // Analize error:
      ERROR_IO_INCOMPLETE: ;                                                   // Wait for write completion
      ERROR_BROKEN_PIPE: Close(GetLastError,0,TxCount);                        // Connection lost
      else Close(GetLastError,0,TxCount);                                      // Unknown error occured
     end;
    end else begin                                                             // When no pending write:
     TxCount:=Min(Length(myTxFifo),Length(myTxBuffer));                        // Calculate data size to write
     if TxCount>0 then begin                                                   // If has data to write
      Move(PChar(myTxFifo)^,PChar(myTxBuffer)^,TxCount);                       // Copy FIFO data to buffer
      Delete(myTxFifo,1,TxCount);                                              // Remove this data from FIFO
      if WriteFile(myHandle,PChar(myTxBuffer)^,TxCount,TxCount,@myTxOverlap)   // Try to write data to pipe immediatly
      then OnTxSent(TxCount)                                                   // If yes count written bytes
      else                                                                     // If not written immediatly
      case GetLastError of                                                     // Analize error:
       ERROR_IO_PENDING: myTxPending:=true;                                    // Mark pending write
       ERROR_BROKEN_PIPE: Close(GetLastError,0,TxCount);                       // Connection lost
       else Close(GetLastError,0,TxCount);                                     // Unknown error occured
      end;
     end;
    end;
   end;
  end;
  //
  // Check if FIFO data lost, report if so
  //
  if abs(GetTickCount-myLastCheck)>myTimeOut then begin                        // Every TimeOut milliseconds
   if myRxLost<>myRxLast then begin                                            // Check if RxLost changed
    if myRxLost>myRxLast then Report('RxLost',-1);                             // If increased, report Rx data lost
    myRxLast:=myRxLost;                                                        // Remember for future
   end;
   if myTxLost<>myTxLast then begin                                            // Check if TxLost changed
    if myTxLost>myTxLast then Report('TxLost',-1);                             // If increased, report Tx data lost
    myTxLast:=myTxLost;                                                        // Remember for future
   end;
   myLastCheck:=GetTickCount;                                                  // Remember moment of last check
  end;
 end;
end;

procedure TEasyPipe.Clear(const What:String);
var Sample:String;
begin
 if (Self=nil) then Exit;
 Sample:=','+UpperCase(What)+',';
 if (Pos(',RXLOST,',Sample)>0) then myRxLost:=0;
 if (Pos(',TXLOST,',Sample)>0) then myTxLost:=0;
 if (Pos(',RXFIFO,',Sample)>0) then myRxFifo:='';
 if (Pos(',TXFIFO,',Sample)>0) then myTxFifo:='';
 if (Pos(',RXTOTAL,',Sample)>0) then myRxTotal:=0;
 if (Pos(',TXTOTAL,',Sample)>0) then myTxTotal:=0;
 if (Pos(',LOGS,',Sample)>0) then if (myLogsList<>nil) then myLogsList.Clear;
end;

function  NewEasyPipe(const aPipeName    : String;
                            aRxBuffSize  : Integer = DefPipeBuffSize;
                            aTxBuffSize  : Integer = DefPipeBuffSize;
                            aTimeOut     : Integer = DefPipeTimeout;
                            aLogsHistory : Integer = DefPipeLogsHistory
                                       ) : TEasyPipe;
begin
 Result:=TEasyPipe.Create(aPipeName,aRxBuffSize,aTxBuffSize,aTimeOut,aLogsHistory);
end;

initialization

 InitDictionary;
 FullEasyPipeList:=TThreadList.Create;

finalization

 FreeAndNil(FullEasyPipeList);
 FreeDictionary;
 
end.

