 {
 ****************************************************************************
 CRW32 project
 Copyright (C) by Kuryakin Alexey, Sarov, Russia, 2004, <kouriakine@mail.ru>
 Named pipes.
 Modifications:
  20040420 - Creation
  20040422 - First tested release
  20070220 - Reporter
 ****************************************************************************
 }

unit _pipe;

{$I _sysdef}

interface

uses
 sysutils, windows, classes, math,
 _alloc, _fifo, _rtc, _str, _fio, _dynar, _polling;

 {
 *******************************************************************************
 Назначение.
  Этот модуль предназначен для работы с именованными каналами (NamedPipe).
  Связь по каналу сделана так, что возможен только один экземпляр канала,
  то есть только одна пара клиент-сервер с данным именем. В принципе, идеология
  каналов допускает работу с многими экземплярами каналов, но для предполагаемых
  приложений (прикладные задачи CRW-DAQ) это не подходит. Зато два экземпляра
  класса TPipe, клиент и сервер, автоматически устанавливают контакт и
  автоматически восстанавливают связь, если она была потеряна. Для измерительных
  задач это гораздо важнее.
 *******************************************************************************
 Принцип работы.
  Прост до предела. Всеми операциями I/O занимается отдельный поток, который
  общается с клиентским потоком через FIFO. Поток периодически сканирует канал и
  инициирует необходимые операции чтения/записи, беря данные из FIFO передатчика
  и помещая в FIFO приемника, а также регистрируя ошибки при помощи процедуры
  пользователя Report.
  При старте или при разрыве связи:
   - сервер закрывает канал и создает его снова
   - клиент периодически пытается открыть существующий канал
  Поэтому при разрыве связи она автоматически восстанавливается, когда возникают
  благоприятные условия. Это хорошо для случая, когда измерительная машина может
  работать автономно. Как только появилась связь с центральным сервером, канал
  тут же ее подхватывает. Удобно.
  Этот метод не блещет изощренностью, но представляется наиболее устойчивым к
  возможным сбоям, а кроме того, он проще, чем работа по событиям или сообщениям,
  а потому кажется предпочтительнее. Тем более, что нагрузка CPU при работе
  оказалась близка к 0 (диспетчер задач Windows 2000 показывает 0).
 *******************************************************************************
 Программирование.
  1) aHost - имя компьютера-сервера, с которым хочет связаться клиент.
     Чтобы запустить сервер, надо указать пустое имя компьютера aHost.
     Имя компьютера aHost='.' означает клиента на локальной машине.
  2) Для обмена данными используется FIFO RxFifo-приемник, TxFifo-передатчик.
     Для чтения данных из канала вызывается pipe.RxFifo.Get.
     Для записи данных в канал   вызывается pipe.TxFifo.Put.
  3) Опрос канала организуется через поток Polling.
     Для приостановки опроса используйте pipe.Polling.Enable(..)
  4) Для сообщений об ошибках задается callback процедура Report, кроме того,
     надо анализировать RxFifo.Lost,TxFifo.Lost.
  5) Все каналы регистрируются в списке FullPipeList.
  6) На низком уровне используются только стандартные средства Win32, поэтому
     надеюсь, что с переносимостью не будет проблем.
  7) Как выяснилось, каналы поддерживаются только под NT/W2K/XP.
 *******************************************************************************
 Конфигурирование.
  Конфигурация канала задается при его создании и далее не меняется.
  Можно конфигурировать канал через INI-файл:
  pipe:=NewPipeFromIniFile('example.cfg','[Pipe]')
   [Pipe]
   PipeName = alex\test            ; Host\Name; host=''(server); host='.'(local client)
   FifoSize = 32                   ; Fifo size in KB
   PipePolling = 1, tpTimeCritical ; Polling thread
   TimeOut = 1000                  ; Timeout to check connection
 *******************************************************************************
 Пример программирования.
  Server:
   pipe:=NewPipe('','test');
   while not Terminated do begin
    write(pipe.RxFifo.GetText);      // Receive data...
    pipe.TxFifo.PutTex(GetUserData); // Transmit data ...
   end;
   Kill(pipe);
  Client:
   pipe:=NewPipe('host','test');
   while not Terminated do begin
    write(pipe.RxFifo.GetText);      // Receive data...
    pipe.TxFifo.PutTex(GetUserData); // Transmit data ...
   end;
   Kill(pipe);
 *******************************************************************************
 }

const
 DefPipeTimeOut  = 1000;                                                        // Default pipe timeout
 DefPipeFifoSize = 1024*16;                                                     // Default pipe Tx fifo size
 DefPipeFactor   = 2;                                                           // Factor of RxFifo.Size/TxFifo.Size
 DefPipeDelay    = 1;                                                           // Default pipe polling delay
 DefPipePriority = tpTimeCritical;                                              // Default pipe thread priority

type
 TPipe = class;                                                                 // Predefine pipe class
 TPipeReporter = procedure(                                                     // Proc. to report errors
                           Pipe:TPipe;                                          // Sender pipe
                           When:Double;                                         // When it happened
                     const What:ShortString;                                    // What is happened
                           Code:Integer);                                       // Error code
 TPipe = class(TMasterObject)                                                   // Named pipe wrap class
 private
  myFile      : THandle;                                                        // Pipe file handle
  myName      : packed array[0..255] of char;                                   // Pipe name
  myServer    : Boolean;                                                        // Server or client?
  myRxFifo    : TFifo;                                                          // Receiver FIFO
  myTxFifo    : TFifo;                                                          // Transmitter FIFO
  myPolling   : TPolling;                                                       // Polling thread
  myReporter  : TPipeReporter;                                                  // Proc. to report errors
  myConnected : Boolean;                                                        // Connected?
  myRxPending : Boolean;                                                        // Receiver pending IO
  myTxPending : Boolean;                                                        // Transmitter pending IO
  myRxOverlap : TOverlapped;                                                    // Receiver overlap
  myTxOverlap : TOverlapped;                                                    // Transmitter overlap
  myRxBuffer  : packed array[0..1024*4-1] of char;                              // Receiver buffer
  myTxBuffer  : packed array[0..1024*4-1] of char;                              // Transmitter buffer
  mySecDesc   : TSecurityDescriptor;                                            // Security descriptor
  mySecAttr   : TSecurityAttributes;                                            // Security attributes
  myTimeOut   : Integer;                                                        // Timeout to check connection
  myRxLost    : Int64;                                                          // Last value of RxFifo.Lost
  myTxLost    : Int64;                                                          // Last value of TxFifo.Lost
  myLastCheck : Cardinal;                                                       // Time when last check done
 private
  function    GetServer:Boolean;
  function    GetRxFifo:TFifo;
  function    GetTxFifo:TFifo;
  function    GetPolling:TPolling;
  function    GetConnected:Boolean;
  procedure   Report(const What:ShortString; Code:Integer);
  procedure   SetReporter(aReporter:TPipeReporter);
  procedure   Close(aErrorCode:Integer=ERROR_SUCCESS; aRxLost:Integer=0; aTxLost:Integer=0);
  procedure   Poll;
 public
  constructor Create(const aHost : ShortString;                                 // Host(client) or empty(server)
                     const aName : ShortString;                                 // Pipe name
                     aReporter   : TPipeReporter;                               // Callback to report errors
                     aDelay      : Integer;                                     // Polling delay
                     aPriority   : TThreadPriority;                             // Thread priority
                     aRxFifoSize : Integer;                                     // Receiver fifo size
                     aTxFifoSize : Integer;                                     // Transmitter fifo size
                     aTimeOut    : Integer);                                    // Timeout for connections
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
  destructor  Destroy; override;
  function    GetProperties(TheText:TText):TText;
 public
  property    Server             : Boolean   read GetServer;                    // Server or client
  property    RxFifo             : TFifo     read GetRxFifo;                    // Receiver FIFO
  property    TxFifo             : TFifo     read GetTxFifo;                    // Transmitter FIFO
  property    Polling            : TPolling  read GetPolling;                   // Polling thread
  property    Reporter           : TPipeReporter write SetReporter;             // Error report procedure
  property    Connected          : Boolean   read GetConnected;                 // Connected?
 end;

 //
 // [Pipe]
 // PipeName = alex\test            ; Host\Name; Host=''(server); Host='.'(local client)
 // FifoSize = 16                   ; Fifo size in KB
 // PipePolling = 1, tpTimeCritical ; Polling thread
 // TimeOut = 1000                  ; Timeout to check connection
 //
function  NewPipeFromIniFile(const IniFile,Section:ShortString; aReporter:TPipeReporter=nil):TPipe;
function  NewPipe(const aHost : ShortString;                                    // Host(client) or empty(server)
                  const aName : ShortString;                                    // Pipe name
                  aReporter   : TPipeReporter   = nil;                          // Callback to report errors
                  aDelay      : Integer         = DefPipeDelay;                 // Polling delay
                  aPriority   : TThreadPriority = DefPipePriority;              // Thread priority
                  aRxFifoSize : Integer         = DefPipeFifoSize*DefPipeFactor;// Receiver fifo size
                  aTxFifoSize : Integer         = DefPipeFifoSize;              // Transmitter fifo size
                  aTimeOut    : Integer         = DefPipeTimeOut                // Timeout for connections
                             ): TPipe;
procedure Kill(var TheObject:TPipe); overload;

function GetFullPipeListProperties(TheText:TText):TText;

function FullPipeList:TObjectStorage;

implementation

 {
 ********************
 TPipe implementation
 ********************
 }
procedure PipePollAction(aPolling:TPolling; var Terminate:Boolean);
begin
 if aPolling.LinkObject is TPipe
 then (aPolling.LinkObject as TPipe).Poll
 else Terminate:=true;
end;

function TPipe.GetServer:Boolean;
begin
 if Assigned(Self) then Result:=myServer else Result:=false;
end;

function TPipe.GetRxFifo:TFifo;
begin
 if Assigned(Self) then Result:=myRxFifo else Result:=nil;
end;

function TPipe.GetTxFifo:TFifo;
begin
 if Assigned(Self) then Result:=myTxFifo else Result:=nil;
end;

function TPipe.GetPolling:TPolling;
begin
 if Assigned(Self) then Result:=myPolling else Result:=nil;
end;

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

procedure TPipe.Report(const What:ShortString; Code:Integer);
begin
 if Assigned(Self) then
 try
  if Assigned(myReporter) then myReporter(Self,msecnow,What,Code);
 except
  on E:Exception do BugReport(E,Self);
 end;
end;

procedure TPipe.SetReporter(aReporter:TPipeReporter);
begin
 if Assigned(Self) then myReporter:=aReporter;
end;

procedure TPipe.Close(aErrorCode:Integer; aRxLost:Integer; aTxLost:Integer);
begin
 if Assigned(Self) then
 try
  if myFile <> INVALID_HANDLE_VALUE then begin                                 // If file opened
   CloseHandle(myFile);                                                        // Close file
   myFile:=INVALID_HANDLE_VALUE;                                               // Mark it closed
   myConnected:=false;                                                         // No connection
   myRxPending:=false;                                                         // No pending read
   myTxPending:=false;                                                         // No pending write
   SafeFillChar(myRxOverlap,sizeof(myRxOverlap),0);                            // Clear read overlap
   SafeFillChar(myTxOverlap,sizeof(myTxOverlap),0);                            // Clear write overlap
  end;
  if (aErrorCode<>ERROR_SUCCESS) or (aRxLost+aTxLost<>0) then begin            // If error occured
   myRxFifo.Lost:=myRxFifo.Lost+Length(myRxFifo.GetText)+aRxLost;              // Receiver data lost
   myTxFifo.Lost:=myTxFifo.Lost+Length(myTxFifo.GetText)+aTxLost;              // Transmitter data lost
  end;
  Report('Close',aErrorCode);
 except
  on E:Exception do BugReport(E,Self);
 end;
end;

constructor TPipe.Create(const aHost : ShortString;
                         const aName : ShortString;
                         aReporter   : TPipeReporter;
                         aDelay      : Integer;
                         aPriority   : TThreadPriority;
                         aRxFifoSize : Integer;
                         aTxFifoSize : Integer;
                         aTimeOut    : Integer);
begin
 inherited Create;
 myFile:=INVALID_HANDLE_VALUE;
 myServer:=IsEmptyStr(aHost);
 if Server
 then StrPCopy(myName,Format('\\%s\pipe\%s',['.',Trim(aName)]))
 else StrPCopy(myName,Format('\\%s\pipe\%s',[Trim(aHost),Trim(aName)]));
 myRxFifo:=NewFifo(aRxFifoSize);
 myRxFifo.Master:=myRxFifo;
 myTxFifo:=NewFifo(aTxFifoSize);
 myTxFifo.Master:=myTxFifo;
 myPolling:=NewPolling(PipePollAction, aDelay, aPriority, false, StrPas(myName));
 myPolling.Master:=myPolling;
 myPolling.LinkObject:=Self;
 myReporter:=aReporter;
 myConnected:=false;
 myRxPending:=false;
 myTxPending:=false;
 SafeFillChar(myRxOverlap,sizeof(myRxOverlap),0);
 SafeFillChar(myTxOverlap,sizeof(myTxOverlap),0);
 SafeFillChar(myRxBuffer,sizeof(myRxBuffer),0);
 SafeFillChar(myTxBuffer,sizeof(myTxBuffer),0);
 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;
 myTxLost:=0;
 myLastCheck:=0;
end;

procedure TPipe.AfterConstruction;
begin
 inherited AfterConstruction;
 FullPipeList.Add(Self);
 Polling.Enable(true);
end;

procedure TPipe.BeforeDestruction;
begin
 Polling.Enable(false);
 FullPipeList.Remove(Self);
 inherited BeforeDestruction;
end;

destructor TPipe.Destroy;
begin
 try
  Polling.Enable(false);
  Close;
  Kill(myPolling);
  Kill(myRxFifo);
  Kill(myTxFifo);
 except
  on E:Exception do BugReport(E,Self);
 end;
 inherited Destroy;
end;

function TPipe.GetProperties(TheText:TText):TText;
begin
 Result:=TheText;
 if Assigned(Self) then
 try
  if Server
  then TheText.AddLn(Format('PipeName = %s',[ExtractWord(3,StrPas(myName),['\','/'])]))
  else TheText.AddLn(Format('PipeName = %s\%s',[ExtractWord(1,StrPas(myName),['\','/']),ExtractWord(3,StrPas(myName),['\','/'])]));
  TheText.AddLn(Format('FifoSize = %d K',[TxFifo.Size div 1024]));
  TheText.AddLn(Format('PipePolling = %d, %s',[Polling.Delay,GetPriorityName(Polling.Priority)]));
  TheText.AddLn(Format('TimeOut = %d',[myTimeOut]));
  TheText.AddLn(Format('RxLost = %d',[RxFifo.Lost]));
  TheText.AddLn(Format('TxLost = %d',[TxFifo.Lost]));
 except
  on E:Exception do BugReport(E,Self);
 end;
end;

procedure TPipe.Poll;
var
 RxCount : DWORD;
 TxCount : DWORD;
begin
 if Assigned(Self) then
 try
  //
  // If file handle is not created, try to create it
  //
  if myFile = INVALID_HANDLE_VALUE then begin                                  // If file not opened
   if Server then begin                                                        // Server:
    myFile:=CreateNamedPipe(myName,                                            // 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
                            TxFifo.Size,                                       // output buffer size, in bytes
                            RxFifo.Size,                                       // input buffer size, in bytes
                            myTimeOut,                                         // time-out time, msec
                            @mySecAttr);                                       // pointer to security attributes structure
    if myFile <> 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:
    myFile:=CreateFile(myName,                                                 // 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 myFile <> INVALID_HANDLE_VALUE                                          // If file created
    then Report('CreateFile',ERROR_SUCCESS)                                    // Report success
    else Report('CreateFile',GetLastError);                                    // Else report error
   end;
   if myFile <> 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
    SafeFillChar(myRxOverlap,sizeof(myRxOverlap),0);                           // Clear read overlap
    SafeFillChar(myTxOverlap,sizeof(myTxOverlap),0);                           // Clear write overlap
   end else Sleep(myTimeOut);                                                  // If file fails,wait some time
  end;
  //
  // File created, may connect/read/write
  //
  if myFile <> INVALID_HANDLE_VALUE then begin
   //
   // If not still connected, try to connect now...
   //
   if not myConnected then begin
    while ReadFile(myFile,myRxBuffer,sizeof(myRxBuffer),RxCount,@myRxOverlap)  // Read data to buffer
    do myRxFifo.Put(@myRxBuffer,RxCount);                                      // 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);                            // End of file reached
     ERROR_BROKEN_PIPE: Close(GetLastError,RxCount);                           // Connection lost
     else Close(GetLastError,RxCount);                                         // 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(myFile,myRxOverlap,RxCount,FALSE) then begin       // If pending read complete
      myRxFifo.Put(@myRxBuffer,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);                           // End of file reached
      ERROR_BROKEN_PIPE: Close(GetLastError,RxCount);                          // Connection lost
      else Close(GetLastError,RxCount);                                        // Unknown error occured
     end;
    end else begin                                                             // When no pending read:
     RxCount:=min(sizeof(myRxBuffer),myRxFifo.Space);                          // Check FIFO space
     if RxCount>0 then begin                                                   // If have FIFO space
      if ReadFile(myFile,myRxBuffer,RxCount,RxCount,@myRxOverlap)              // If read immediatly
      then myRxFifo.Put(@myRxBuffer,RxCount)                                   // Then put data to FIFO
      else                                                                     // If not read
      case GetLastError of                                                     // Analize error:
       ERROR_IO_PENDING: myRxPending:=true;                                    // Mark pending read
       ERROR_HANDLE_EOF: Close(GetLastError,RxCount);                          // End of file reached
       ERROR_BROKEN_PIPE: Close(GetLastError,RxCount);                         // Connection lost
       else Close(GetLastError,RxCount);                                       // Unknown error occured
      end;
     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(myFile,myTxOverlap,TxCount,FALSE)                  // If write complete
     then myTxPending:=false                                                   // 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:=myTxFifo.Get(@myTxBuffer,sizeof(myTxBuffer));                    // Copy FIFO to buffer
     if TxCount>0 then begin                                                   // If has data to write
      if not WriteFile(myFile,myTxBuffer,TxCount,TxCount,@myTxOverlap) then    // 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 myRxFifo.Lost<>myRxLost then begin                                       // Check if RxFifo.Lost changed
    if myRxFifo.Lost>myRxLost then Report('RxLost',-1);                        // If increased, report Rx data lost
    myRxLost:=myRxFifo.Lost;                                                   // Remember for future
   end;
   if myTxFifo.Lost<>myTxLost then begin                                       // Check if TxFifo.Lost changed
    if myTxFifo.Lost>myTxLost then Report('TxLost',-1);                        // If increased, report Tx data lost
    myTxLost:=myTxFifo.Lost;                                                   // Remember for future
   end;
   myLastCheck:=GetTickCount;                                                  // Remember moment of last check
  end;
 except
  on E:Exception do BugReport(E,Self);
 end;
end;

function  NewPipeFromIniFile(const IniFile,Section:ShortString; aReporter:TPipeReporter=nil):TPipe;
var
 aHost     : ShortString;
 aName     : ShortString;
 aDelay    : Integer;
 aPriority : TThreadPriority;
 aFifoSize : Integer;
 aTimeOut  : Integer;
begin
 Result:=nil;
 try
  if ReadIniFileVariable(IniFile,Section,'PipeName%a',aName) then begin
   aName:=LoCaseStr(aName);
   aHost:=ExtractWord(1,aName,['\','/']);
   aName:=ExtractWord(2,aName,['\','/']);
   if IsEmptyStr(aName) then begin
    aName:=aHost;
    aHost:='';
   end;
  end else aName:='';
  if not IsEmptyStr(aName) then begin
   if not ReadIniFileVariable(IniFile,Section,'TimeOut%i',aTimeOut) then aTimeOut:=DefPipeTimeOut;
   if not ReadIniFileVariable(IniFile,Section,'FifoSize%i',aFifoSize) then aFifoSize:=DefPipeFifoSize div 1024;
   if not ReadIniFilePolling(IniFile,Section,'PipePolling',aDelay,aPriority) then begin
    aDelay:=DefPipeDelay;
    aPriority:=DefPipePriority;
   end;
   aTimeOut:=max(0,aTimeOut);
   aFifoSize:=min(1024*64,max(4,aFifoSize))*1024;
   Result:=NewPipe(aHost,aName,aReporter,aDelay,aPriority,aFifoSize*DefPipeFactor,aFifoSize,aTimeOut);
  end;
 except
  on E:Exception do BugReport(E);
 end;
end;

function  NewPipe(const aHost : ShortString;
                  const aName : ShortString;
                  aReporter   : TPipeReporter;
                  aDelay      : Integer;
                  aPriority   : TThreadPriority;
                  aRxFifoSize : LongInt;
                  aTxFifoSize : LongInt;
                  aTimeOut    : Integer
                            ) : TPipe;
begin
 Result:=nil;
 try
  Result:=TPipe.Create(aHost,aName,aReporter,aDelay,aPriority,aRxFifoSize,aTxFifoSize,aTimeOut);
 except
  on E:Exception do BugReport(E);
 end;
end;

procedure Kill(var TheObject:TPipe); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E);
 end;
end;

procedure aPipeProperties(Index:LongInt; const aObject:TObject; var Terminate:Boolean; CustomData:Pointer);
begin
 if aObject is TPipe then
 with (aObject as TPipe) do begin
  TText(CustomData).Addln(Format('[%s]',[LoCaseStr(StrPas(myName))]));
  GetProperties(TText(CustomData));
 end;
end;

function GetFullPipeListProperties(TheText:TText):TText;
begin
 Result:=TheText;
 FullPipeList.ForEach(aPipeProperties,TheText);
end;

const
 TheFullPipeList : TObjectStorage = nil;

function FullPipeList:TObjectStorage;
begin
 Result:=TheFullPipeList;
end;

initialization

 TheFullPipeList:=NewObjectStorage(false);
 TheFullPipeList.Master:=TheFullPipeList;
 TheFullPipeList.OwnsObjects:=false;

finalization

 ResourceLeakageLog(Format('%-60s = %d',['FullPipeList.Count', TheFullPipeList.Count]));
 Kill(TheFullPipeList);

end.

