////////////////////////////////////////////////////////////////////////////////
// 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:                                                                   //
// Unified interface for TPipe, TSocketPipe, TTask etc.                       //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20070204 - Creation                                                        //
// 20040303 - pipe_init modified                                              //
// 20190319 - awake for pipe_send                                             //
// 20230908 - Modified for FPC (A.K.)                                         //
////////////////////////////////////////////////////////////////////////////////

unit _crw_pipeio; // Pipe I/O routines

{$I _crw_sysdef}

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

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

interface

uses
 _crw_sharemem, // NB: THIS UNIT MUST BE FIRST !!!
 {$IFDEF UNIX} cthreads, dl, {$ENDIF}
 {$IFDEF WINDOWS} windows, {$ENDIF}
 {$IFDEF WINDOWS} winsock, {$ENDIF}
 sysutils, classes, math, sockets,
 _crw_alloc, _crw_fifo, _crw_rtc, _crw_str, _crw_fio, _crw_polling,
 _crw_dynar, _crw_uart, _crw_pipe, _crw_task, _crw_tcp;

 ///////////////////////////////////////////////////////////////////////////////
 // Easy pipe routines, to use in DAQ PASCAL
 // pid          - Pipe index, integer value > 0 to identify pipe.
 //                Zero value of tid uses to indicate error or null pipe.
 //                Pipe may be COM, TASK, PIPE, TCP.
 // pipe_init    - pipe_init('com Port 1 BaudRate 9600 Parity NONE DataBits 8 StopBits 1 XonXoff 0 BufSize 8 DcbFlags 0').
 //                 Initialize COM port.
 //                pipe_init('task cmd')
 //                 That is same as task_init('cmd').
 //                pipe_init('pipe name      Polling 1 Priority tpCritical TxPipeSize 16384 RxPipeSize 32768 Timeout 1000')
 //                 Create named pipe server.
 //                pipe_init('pipe host\name Polling 1 Priority tpCritical TxPipeSize 16384 RxPipeSize 32768 Timeout 1000')
 //                 Create named pipe client.
 //                pipe_init('tcp server 1    port 1234 Polling 1 Priority tpCritical TxPipeSize 16384 RxPipeSize 32768 Timeout 1000')
 //                 Create TCP server.
 //                pipe_init('tcp client host port 1234 Polling 1 Priority tpCritical TxPipeSize 16384 RxPipeSize 32768 Timeout 1000')
 //                 Create TCP client.
 // pipe_free    - Destroy pipe instance.
 // pipe_ref     - Return pipe instance by reference or nil if not exists.
 // pipe_pid     - For pid=TASK return task_pid, otherwise return current process ID.
 // pipe_run     - For pid=TASK return task_run, otherwise return true.
 // pipe_wait    - For pid=TASK return task_wait, otherwise return pipe_connected>0.
 // pipe_send    - Send data string to pipe.
 // pipe_recv    - Receive data string from pipe.
 // pipe_txcount - Data count in transmitter pipe.
 // pipe_rxcount - Data count in receiver    pipe.
 // pipe_txspace - Data space in transmitter pipe.
 // pipe_rxspace - Data space in receiver    pipe.
 // pipe_result  - For pid=TASK return task_result, otherwise return 259=STILL_ACTIVE.
 // pipe_kill    - For pid=TASK return task_kill, otherwise return pipe_wait.
 // pipe_ctrl    - Set/get pipe parameters as s:=pipe_ctrl(pid,'name=value').
 //                For COM, no parameters to get/set.
 //                For TASK, see task_ctrl.
 //                For PIPE can get/set RxPipeSize, TxPipeSize, Polling, Priority.
 //                For TCP can get/set RxPipeSize, TxPipeSize, Polling, Priority.
 //                For TCP can get HostIP, PeerIP, HostName, PeerName, Target.
 // pipe_txclear - Clear transmitter pipe.
 // pipe_rxclear - Clear receiver    pipe.
 // pipe_count   - Return number of pipe channels.
 // pipe_stream  - Return pipe stream reference, inxed=0..pipe_count-1.
 // pipe_connected - Return number of active connections.
 ///////////////////////////////////////////////////////////////////////////////
function pipe_init(const cmd_line:LongString; aPipeReporter:TPipeReporter=nil; aSocketReporter:TSocketReporter=nil):Integer;
function pipe_free(pid:Integer):Boolean;
function pipe_ref(pid:Integer):TObject;
function pipe_pid(pid:Integer):Integer;
function pipe_run(pid:Integer):Boolean;
function pipe_wait(pid,timeout:Integer):Boolean;
function pipe_send(pid:Integer; const data:LongString; awake:Boolean=false):Integer;
function pipe_recv(pid,maxlen:Integer):LongString;
function pipe_txcount(pid:Integer):Integer;
function pipe_rxcount(pid:Integer):Integer;
function pipe_txspace(pid:Integer):Integer;
function pipe_rxspace(pid:Integer):Integer;
function pipe_result(pid:Integer):Integer;
function pipe_kill(pid,how,exit_code,timeout:Integer):Boolean;
function pipe_ctrl(pid:Integer; const param:LongString):LongString;
function pipe_txclear(pid:Integer):Boolean;
function pipe_rxclear(pid:Integer):Boolean;
function pipe_count(pid:Integer):Integer;
function pipe_stream(pid,index:Integer):Integer;
function pipe_connected(pid:Integer):Integer;

procedure TestPipeIO;

implementation

function pipe_init(const cmd_line:LongString; aPipeReporter:TPipeReporter; aSocketReporter:TSocketReporter):Integer;
var com:TUartPort; pipe:TPipe; tcp:TSocketPipe;
var aPort,aBaudRate,aXonXoff,aBufSize,aDcbFlags,aOptions,d:Integer;
var i,aMaxConn,aDelay,aRxPipeSize,aTxPipeSize,aTimeOut:Integer;
var aParity:TParity; aDataBits:TDataBits; aStopBits:TStopBits;
var aPriority:TThreadPriority; f:Double;
var w1,w2,w3,w4,aName,aHost:LongString;
begin
 Result:=0;
 try
  w1:=ExtractWord(1,cmd_line,ScanSpaces);
  if IsSameText(w1,'com') then begin
   aPort:=0;
   aBaudRate:=9600;
   aParity:=NOPARITY;
   aDataBits:=8;
   aStopBits:=ONESTOPBIT;
   aXonXoff:=0;
   aBufSize:=4;
   aDcbFlags:=0;
   for i:=2 to WordCount(cmd_line,ScanSpaces) do begin
    w2:=ExtractWord(i+0,cmd_line,ScanSpaces);
    w3:=ExtractWord(i+1,cmd_line,ScanSpaces);
    if IsSameText(w2,'Port') then if Str2Int(w3,d) then aPort:=d;
    if IsSameText(w2,'BaudRate') then if Str2Int(w3,d) then aBaudRate:=d;
    if IsSameText(w2,'Parity') then begin
     if (w3='NONE')  or (w3='NOPARITY')    or (w3='N') then aParity:=NOPARITY    else
     if (w3='ODD')   or (w3='ODDPARITY')   or (w3='O') then aParity:=ODDPARITY   else
     if (w3='EVEN')  or (w3='EVENPARITY')  or (w3='E') then aParity:=EVENPARITY  else
     if (w3='MARK')  or (w3='MARKPARITY')  or (w3='M') then aParity:=MARKPARITY  else
     if (w3='SPACE') or (w3='SPACEPARITY') or (w3='S') then aParity:=SPACEPARITY else aParity:=NOPARITY;
    end;
    if IsSameText(w2,'DataBits') then if Str2Int(w3,d) then aDataBits:=d;
    if IsSameText(w2,'StopBits') then begin
     if Str2Real(w3,f) and (f=1.0) then aStopBits:=ONESTOPBIT   else
     if Str2Real(w3,f) and (f=1.5) then aStopBits:=ONE5STOPBITS else
     if Str2Real(w3,f) and (f=2.0) then aStopBits:=TWOSTOPBITS  else aStopBits:=ONESTOPBIT;
    end;
    if IsSameText(w2,'XonXoff') then if Str2Int(w3,d) then aXonXoff:=d;
    if IsSameText(w2,'BufSize') then if Str2Int(w3,d) then aBufSize:=d;
    if IsSameText(w2,'DcbFlags') then if Str2Int(w3,d) then aDcbFlags:=d;
   end;
   com:=uart[aPort];
   if not com.Ok then Exit;
   if com.Active then Exit;
   if not com.Open(aBaudRate,aParity,aDataBits,aStopBits,aXonXoff<>0,aBufSize*1024,aDcbFlags) then Exit;
   Result:=com.Ref;
   Exit;
  end;
  if IsSameText(w1,'task') then begin
   w2:=SkipWords(1,cmd_line,ScanSpaces);
   Result:=task_init(w2);
   if Result<>0 then begin
    task_ctrl(Result,Format('TxPipeSize=%d',[TSocketPipe.DefFifoSize]));
    task_ctrl(Result,Format('RxPipeSize=%d',[TSocketPipe.DefFifoSize]));
    aName:=ExtractFilePath(task_ctrl(Result,'ExeName'));
    if DirExists(aName) and not IsEmptyStr(aName) then
    task_ctrl(Result,Format('HomeDir=%s',[aName]));
    task_ctrl(Result,Format('Display=%d',[0]));
   end;
   Exit;
  end;
  if IsSameText(w1,'pipe') then begin
   aName:=ExtractWord(2,cmd_line,ScanSpaces);
   aName:=LoCaseStr(aName);
   aHost:=ExtractWord(1,aName,['\','/']);
   aName:=ExtractWord(2,aName,['\','/']);
   if IsEmptyStr(aName) then begin
    aName:=aHost;
    aHost:='';
   end;
   aDelay:=TPipe.DefDelay;
   aPriority:=TPipe.DefPriority;
   aTimeOut:=TPipe.DefTimeout;
   aTxPipeSize:=TPipe.DefFifoSize;
   aRxPipeSize:=TPipe.DefFifoSize;
   for i:=3 to WordCount(cmd_line,ScanSpaces) do begin
    w2:=ExtractWord(i+0,cmd_line,ScanSpaces);
    w3:=ExtractWord(i+1,cmd_line,ScanSpaces);
    w4:=ExtractWord(i+2,cmd_line,ScanSpaces);
    if IsSameText(w2,'Polling') then if Str2Int(w3,d) then begin
     aDelay:=TPipe.ValidateDelay(d);
     aPriority:=TPipe.ValidatePriority(GetPriorityByName(w4,aPriority));
    end;
    if IsSameText(w2,'Priority') then aPriority:=TPipe.ValidatePriority(GetPriorityByName(w3,aPriority));
    if IsSameText(w2,'TimeOut') then if Str2Int(w3,d) then aTimeOut:=TPipe.ValidateTimeout(d);
    if IsSameText(w2,'TxPipeSize') then if Str2Int(w3,d) then aTxPipeSize:=TPipe.ValidateFifoSize(d);
    if IsSameText(w2,'RxPipeSize') then if Str2Int(w3,d) then aRxPipeSize:=TPipe.ValidateFifoSize(d);
   end;
   pipe:=NewPipe(aHost,aName,aPipeReporter,aDelay,aPriority,aRxPipeSize,aTxPipeSize,aTimeOut);
   Result:=pipe.Ref;
   Exit;
  end;
  if IsSameText(w1,'tcp') then begin
   tcp:=nil;
   aPort:=0;
   aHost:='';
   aMaxConn:=0;
   aDelay:=TSocketPipe.DefDelay;
   aPriority:=TSocketPipe.DefPriority;
   aOptions:=DefSocketOptions;
   aTimeOut:=TSocketPipe.DefTimeout;
   aTxPipeSize:=TSocketPipe.DefFifoSize;
   aRxPipeSize:=TSocketPipe.DefFifoSize;
   for i:=2 to WordCount(cmd_line,ScanSpaces) do begin
    w2:=ExtractWord(i+0,cmd_line,ScanSpaces);
    w3:=ExtractWord(i+1,cmd_line,ScanSpaces);
    w4:=ExtractWord(i+2,cmd_line,ScanSpaces);
    if IsSameText(w2,'Port') then if Str2Int(w3,d) then aPort:=d;
    if IsSameText(w2,'Server') then if Str2Int(w3,d) then aMaxConn:=d;
    if IsSameText(w2,'Client') then aHost:=w3;
    if IsSameText(w2,'Polling') then if Str2Int(w3,d) then begin
     aDelay:=TSocketPipe.ValidateDelay(d);
     aPriority:=TSocketPipe.ValidatePriority(GetPriorityByName(w4,aPriority));
    end;
    if IsSameText(w2,'Priority') then aPriority:=TSocketPipe.ValidatePriority(GetPriorityByName(w3,aPriority));
    if IsSameText(w2,'TimeOut') then if Str2Int(w3,d) then aTimeOut:=TSocketPipe.ValidateTimeout(d);
    if IsSameText(w2,'Options') then if Str2Int(w3,d) then aOptions:=d;
    if IsSameText(w2,'TxPipeSize') then if Str2Int(w3,d) then aTxPipeSize:=TSocketPipe.ValidateFifoSize(d);
    if IsSameText(w2,'RxPipeSize') then if Str2Int(w3,d) then aRxPipeSize:=TSocketPipe.ValidateFifoSize(d);
   end;
   if (aPort<=0) then Exit;
   if not tcp.Ok then
   if Length(aHost)>0 then tcp:=NewTcpClient(aPort,aHost,aSocketReporter,aDelay,aPriority,aRxPipeSize,aTxPipeSize,aTimeOut,aOptions);
   if not tcp.Ok then
   if (aMaxConn>0) then tcp:=NewTcpServer(aPort,aMaxConn,aSocketReporter,aDelay,aPriority,aRxPipeSize,aTxPipeSize,aTimeOut,aOptions);
   if not tcp.Ok then Exit;
   tcp.Options:=aOptions;
   Result:=tcp.Ref;
   Exit;
  end;
 except
  on E:Exception do BugReport(E,nil,'pipe_init');
 end;
end;

function pipe_free(pid:Integer):Boolean;
var ref:TObject;
begin
 Result:=False;
 try
  ref:=pipe_ref(pid);
  if not Assigned(ref) then Exit;
  if (ref is TUartPort) then begin
   TUartPort(ref).Close;
   Result:=true;
   Exit;
  end;
  if (ref is TTask) then begin
   Result:=task_free(pid);
   Exit;
  end;
  if (ref is TPipe) then begin
   Result:=True;
   Kill(ref);
   Exit;
  end;
  if (ref is TSocketPipe) then begin
   Result:=True;
   // Don't kill child sockets.
   if TSocketPipe(ref).HasOwner then Exit;
   Kill(ref);
   Exit;
  end;
 except
  on E:Exception do BugReport(E,nil,'pipe_free');
 end;
end;

function pipe_ref(pid:Integer):TObject;
begin
 Result:=task_ref(pid);
 if not Assigned(Result) then Result:=ObjectRegistry[pid];
end;

function pipe_pid(pid:Integer):Integer;
var ref:TObject;
begin
 Result:=0;
 try
  ref:=pipe_ref(pid);
  if not Assigned(ref) then Exit;
  if (ref is TUartPort) then begin
   Result:=GetCurrentProcessId;
   Exit;
  end;
  if (ref is TTask) then begin
   Result:=TTask(ref).Pid;
   Exit;
  end;
  if (ref is TPipe) then begin
   Result:=GetCurrentProcessId;
   Exit;
  end;
  if (ref is TSocketPipe) then begin
   Result:=GetCurrentProcessId;
   Exit;
  end;
 except
  on E:Exception do BugReport(E,nil,'pipe_pid');
 end;
end;

function pipe_run(pid:Integer):Boolean;
var ref:TObject;
begin
 Result:=False;
 try
  ref:=pipe_ref(pid);
  if not Assigned(ref) then Exit;
  if (ref is TUartPort) then begin
   Result:=True;
   Exit;
  end;
  if (ref is TTask) then begin
   Result:=TTask(ref).Run;
   Exit;
  end;
  if (ref is TPipe) then begin
   Result:=True;
   Exit;
  end;
  if (ref is TSocketPipe) then begin
   Result:=True;
   Exit;
  end;
 except
  on E:Exception do BugReport(E,nil,'pipe_run');
 end;
end;

function pipe_wait(pid,timeout:Integer):Boolean;
var ref:TObject;
 procedure Wait;
 var ms:Double;
 begin
  ms:=msecnow;
  while (msecnow<ms+timeout) and (pipe_connected(pid)>0) do Sleep(1);
 end;
begin
 Result:=False;
 try
  ref:=pipe_ref(pid);
  if not Assigned(ref) then Exit;
  if (ref is TUartPort) then begin
   if (timeout>0) then Wait;
   Result:=TUartPort(ref).Active;
   Exit;
  end;
  if (ref is TTask) then begin
   Result:=TTask(ref).Running(timeout);
   Exit;
  end;
  if (ref is TPipe) then begin
   if (timeout>0) then Wait;
   Result:=TPipe(ref).Connected;
   Exit;
  end;
  if (ref is TSocketPipe) then begin
   if (timeout>0) then Wait;
   Result:=TSocketPipe(ref).Connected>0;
   Exit;
  end;
 except
  on E:Exception do BugReport(E,nil,'pipe_wait');
 end;
end;

function pipe_send(pid:Integer; const data:LongString; awake:Boolean=false):Integer;
var ref:TObject; len:Integer;
begin
 Result:=0;
 len:=Length(data);
 if (len>0) or awake then
 try
  ref:=pipe_ref(pid);
  if not Assigned(ref) then Exit;
  if (ref is TUartPort) then begin
   if (len>0) then Result:=TUartPort(ref).WriteBuf(PChar(data),len);
   if awake then uart.Polling.Awake;
   Exit;
  end;
  if (ref is TTask) then begin
   if (len>0) then Result:=Ord(TTask(ref).StdInpPipeFifoPutText(data)=TRUE)*len;
   if awake then {NotRealisedYet};
   Exit;
  end;
  if (ref is TPipe) then begin
   if (len>0) then Result:=ord(TPipe(ref).TxFifo.PutText(data)=TRUE)*len;
   if awake then TPipe(ref).Polling.Awake;
   Exit;
  end;
  if (ref is TSocketPipe) then begin
   if (len>0) then Result:=ord(TSocketPipe(ref).TxFifo.PutText(data)=TRUE)*len;
   if awake then TSocketPipe(ref).Polling.Awake;
   Exit;
  end;
 except
  on E:Exception do BugReport(E,nil,'pipe_send');
 end;
end;

function pipe_recv(pid,maxlen:Integer):LongString;
var ref:TObject;
begin
 Result:='';
 if (maxlen>0) then
 try
  ref:=pipe_ref(pid);
  if not Assigned(ref) then Exit;
  if (ref is TUartPort) then begin
   Result:=TUartPort(ref).ReadStr(Max(0,Min(255,maxlen)));
   Exit;
  end;
  if (ref is TTask) then begin
   Result:=TTask(ref).StdOutPipeFifoGetText(Max(0,maxlen));
   Exit;
  end;
  if (ref is TPipe) then begin
   Result:=TPipe(ref).RxFifo.GetText(Max(0,maxlen));
   Exit;
  end;
  if (ref is TSocketPipe) then begin
   Result:=TSocketPipe(ref).RxFifo.GetText(Max(0,maxlen));
   Exit;
  end;
 except
  on E:Exception do BugReport(E,nil,'pipe_recv');
 end;
end;

function pipe_txcount(pid:Integer):Integer;
var ref:TObject;
begin
 Result:=0;
 try
  ref:=pipe_ref(pid);
  if not Assigned(ref) then Exit;
  if (ref is TUartPort) then begin
   Result:=TUartPort(ref).TxCount;
   Exit;
  end;
  if (ref is TTask) then begin
   Result:=TTask(ref).StdInpPipeFifoCount;
   Exit;
  end;
  if (ref is TPipe) then begin
   Result:=TPipe(ref).TxFifo.Count;
   Exit;
  end;
  if (ref is TSocketPipe) then begin
   Result:=TSocketPipe(ref).TxFifo.Count;
   Exit;
  end;
 except
  on E:Exception do BugReport(E,nil,'pipe_txcount');
 end;
end;

function pipe_rxcount(pid:Integer):Integer;
var ref:TObject;
begin
 Result:=0;
 try
  ref:=pipe_ref(pid);
  if not Assigned(ref) then Exit;
  if (ref is TUartPort) then begin
   Result:=TUartPort(ref).RxCount;
   Exit;
  end;
  if (ref is TTask) then begin
   Result:=TTask(ref).StdOutPipeFifoCount;
   Exit;
  end;
  if (ref is TPipe) then begin
   Result:=TPipe(ref).RxFifo.Count;
   Exit;
  end;
  if (ref is TSocketPipe) then begin
   Result:=TSocketPipe(ref).RxFifo.Count;
   Exit;
  end;
 except
  on E:Exception do BugReport(E,nil,'pipe_rxcount');
 end;
end;

function pipe_txspace(pid:Integer):Integer;
var ref:TObject;
begin
 Result:=0;
 try
  ref:=pipe_ref(pid);
  if not Assigned(ref) then Exit;
  if (ref is TUartPort) then begin
   Result:=TUartPort(ref).TxSpace;
   Exit;
  end;
  if (ref is TTask) then begin
   Result:=TTask(ref).StdInpPipeFifoSpace;
   Exit;
  end;
  if (ref is TPipe) then begin
   Result:=TPipe(ref).TxFifo.Space;
   Exit;
  end;
  if (ref is TSocketPipe) then begin
   Result:=TSocketPipe(ref).TxFifo.Space;
   Exit;
  end;
 except
  on E:Exception do BugReport(E,nil,'pipe_txspace');
 end;
end;

function pipe_rxspace(pid:Integer):Integer;
var ref:TObject;
begin
 Result:=0;
 try
  ref:=pipe_ref(pid);
  if not Assigned(ref) then Exit;
  if (ref is TUartPort) then begin
   Result:=TUartPort(ref).RxSpace;
   Exit;
  end;
  if (ref is TTask) then begin
   Result:=TTask(ref).StdOutPipeFifoSpace;
   Exit;
  end;
  if (ref is TPipe) then begin
   Result:=TPipe(ref).RxFifo.Space;
   Exit;
  end;
  if (ref is TSocketPipe) then begin
   Result:=TSocketPipe(ref).RxFifo.Space;
   Exit;
  end;
 except
  on E:Exception do BugReport(E,nil,'pipe_rxspace');
 end;
end;

function pipe_result(pid:Integer):Integer;
var ref:TObject;
begin
 Result:=0;
 try
  ref:=pipe_ref(pid);
  if not Assigned(ref) then Exit;
  if (ref is TUartPort) then begin
   Result:=STILL_ACTIVE;
   Exit;
  end;
  if (ref is TTask) then begin
   Result:=TTask(ref).ExitCode;
   Exit;
  end;
  if (ref is TPipe) then begin
   Result:=STILL_ACTIVE;
   Exit;
  end;
  if (ref is TSocketPipe) then begin
   Result:=STILL_ACTIVE;
   Exit;
  end;
 except
  on E:Exception do BugReport(E,nil,'pipe_result');
 end;
end;

function pipe_kill(pid,how,exit_code,timeout:Integer):Boolean;
var ref:TObject;
begin
 Result:=False;
 try
  ref:=pipe_ref(pid);
  if not Assigned(ref) then Exit;
  if (ref is TUartPort) then begin
   Result:=pipe_wait(pid,timeout);
   Exit;
  end;
  if (ref is TTask) then begin
   Result:=TTask(ref).Terminate(how,exit_code,timeout);
   Exit;
  end;
  if (ref is TPipe) then begin
   Result:=pipe_wait(pid,timeout);
   Exit;
  end;
  if (ref is TSocketPipe) then begin
   Result:=pipe_wait(pid,timeout);
   Exit;
  end;
 except
  on E:Exception do BugReport(E,nil,'pipe_kill');
 end;
end;

function pipe_ctrl(pid:Integer; const param:LongString):LongString;
var ref:TObject; p,d:Integer; sn,sv:LongString;
begin
 Result:='?';
 try
  ref:=pipe_ref(pid);
  if not Assigned(ref) then Exit;
  p:=ExtractNameValuePair(param,sn,sv);
  if (ref is TUartPort) then begin
   Result:=TUartPort(ref).Ctrl(param);
   Exit;
  end;
  if (ref is TTask) then begin
   Result:=task_ctrl(pid,param);
   Exit;
  end;
  if (ref is TPipe) then begin
   Result:=TPipe(ref).Ctrl(param);
   Exit;
   // Obsolete:
   if IsSameText(sn,'TxPipeSize') then begin
    if (p>0) and Str2Int(sv,d) then TPipe(ref).TxFifo.Size:=d;
    Result:=Format('%d',[TPipe(ref).TxFifo.Size]);
    Exit;
   end;
   if IsSameText(sn,'RxPipeSize') then begin
    if (p>0) and Str2Int(sv,d) then TPipe(ref).RxFifo.Size:=d;
    Result:=Format('%d',[TPipe(ref).RxFifo.Size]);
    Exit;
   end;
   if IsSameText(sn,'Polling') then begin
    if (p>0) and Str2Int(sv,d) then TPipe(ref).Polling.Delay:=d;
    Result:=Format('%d',[TPipe(ref).Polling.Delay]);
    Exit;
   end;
   if IsSameText(sn,'Priority') then begin
    if p>0 then TPipe(ref).Polling.Priority:=GetPriorityByName(Trim(sv));
    Result:=GetPriorityName(TPipe(ref).Polling.Priority);
    Exit;
   end;
  end;
  if (ref is TSocketPipe) then begin
   Result:=TSocketPipe(ref).Ctrl(param);
   Exit;
   // Obsolete:
   if IsSameText(sn,'TxPipeSize') then begin
    if (p>0) and Str2Int(sv,d) then TSocketPipe(ref).TxFifo.Size:=d;
    Result:=Format('%d',[TSocketPipe(ref).TxFifo.Size]);
    Exit;
   end;
   if IsSameText(sn,'RxPipeSize') then begin
    if (p>0) and Str2Int(sv,d) then TSocketPipe(ref).RxFifo.Size:=d;
    Result:=Format('%d',[TSocketPipe(ref).RxFifo.Size]);
    Exit;
   end;
   if IsSameText(sn,'Polling') then begin
    if (p>0) and Str2Int(sv,d) then TSocketPipe(ref).Polling.Delay:=d;
    Result:=Format('%d',[TSocketPipe(ref).Polling.Delay]);
    Exit;
   end;
   if IsSameText(sn,'Priority') then begin
    if p>0 then TSocketPipe(ref).Polling.Priority:=GetPriorityByName(Trim(sv));
    Result:=GetPriorityName(TSocketPipe(ref).Polling.Priority);
    Exit;
   end;
   if IsSameText(sn,'HostIP') then begin
    Result:=IpToStr(TSocketPipe(ref).HostIP);
    Exit;
   end;
   if IsSameText(sn,'PeerIP') then begin
    Result:=IpToStr(TSocketPipe(ref).PeerIP);
    Exit;
   end;
   if IsSameText(sn,'HostName') then begin
    Result:=TSocketPipe(ref).HostName;
    Exit;
   end;
   if IsSameText(sn,'PeerName') then begin
    Result:=TSocketPipe(ref).PeerName;
    Exit;
   end;
   if IsSameText(sn,'Target') then begin
    Result:=TSocketPipe(ref).Target;
    Exit;
   end;
  end;
 except
  on E:Exception do BugReport(E,nil,'pipe_ctrl');
 end;
end;

function pipe_txclear(pid:Integer):Boolean;
var ref:TObject;
begin
 Result:=False;
 try
  ref:=pipe_ref(pid);
  if not Assigned(ref) then Exit;
  if (ref is TUartPort) then begin
   TUartPort(ref).TxClear;
   Result:=True;
   Exit;
  end;
  if (ref is TTask) then begin
   TTask(ref).StdInpPipeFifoClear;
   Result:=True;
   Exit;
  end;
  if (ref is TPipe) then begin
   TPipe(ref).TxFifo.Clear;
   Result:=True;
   Exit;
  end;
  if (ref is TSocketPipe) then begin
   TSocketPipe(ref).TxFifo.Clear;
   Result:=True;
   Exit;
  end;
 except
  on E:Exception do BugReport(E,nil,'pipe_txclear');
 end;
end;

function pipe_rxclear(pid:Integer):Boolean;
var ref:TObject;
begin
 Result:=False;
 try
  ref:=pipe_ref(pid);
  if not Assigned(ref) then Exit;
  if (ref is TUartPort) then begin
   TUartPort(ref).RxClear;
   Result:=True;
   Exit;
  end;
  if (ref is TTask) then begin
   TTask(ref).StdOutPipeFifoClear;
   Result:=True;
   Exit;
  end;
  if (ref is TPipe) then begin
   TPipe(ref).RxFifo.Clear;
   Result:=True;
   Exit;
  end;
  if (ref is TSocketPipe) then begin
   TSocketPipe(ref).RxFifo.Clear;
   Result:=True;
   Exit;
  end;
 except
  on E:Exception do BugReport(E,nil,'pipe_rxclear');
 end;
end;

function pipe_count(pid:Integer):Integer;
var ref:TObject;
begin
 Result:=0;
 try
  ref:=pipe_ref(pid);
  if not Assigned(ref) then Exit;
  if (ref is TUartPort) then begin
   Result:=1;
   Exit;
  end;
  if (ref is TTask) then begin
   Result:=1;
   Exit;
  end;
  if (ref is TPipe) then begin
   Result:=1;
   Exit;
  end;
  if (ref is TSocketPipe) then begin
   Result:=TSocketPipe(ref).Count;
   Exit;
  end;
 except
  on E:Exception do BugReport(E,nil,'pipe_count');
 end;
end;

function pipe_stream(pid,index:Integer):Integer;
var ref:TObject;
begin
 Result:=0;
 try
  ref:=pipe_ref(pid);
  if not Assigned(ref) then Exit;
  if (ref is TUartPort) then begin
   if (index=0) then Result:=pid;
   Exit;
  end;
  if (ref is TTask) then begin
   if (index=0) then Result:=pid;
   Exit;
  end;
  if (ref is TPipe) then begin
   if (index=0) then Result:=pid;
   Exit;
  end;
  if (ref is TSocketPipe) then begin
   Result:=TSocketPipe(ref)[index].Ref;
   Exit;
  end;
 except
  on E:Exception do BugReport(E,nil,'pipe_stream');
 end;
end;

function pipe_connected(pid:Integer):Integer;
var ref:TObject;
begin
 Result:=0;
 try
  ref:=pipe_ref(pid);
  if not Assigned(ref) then Exit;
  if (ref is TUartPort) then begin
   Result:=Ord(TUartPort(ref).Active=TRUE);
   Exit;
  end;
  if (ref is TTask) then begin
   Result:=Ord(TTask(ref).Running(0)=TRUE);
   Exit;
  end;
  if (ref is TPipe) then begin
   Result:=Ord(TPipe(ref).Connected=TRUE);
   Exit;
  end;
  if (ref is TSocketPipe) then begin
   Result:=TSocketPipe(ref).Connected;
   Exit;
  end;
 except
  on E:Exception do BugReport(E,nil,'pipe_connected');
 end;
end;

procedure TestReporter(Pipe:TSocketPipe; When:Double; What:PChar; Code:Integer);
begin
 Echo(WinToDosStr(SocketErrorReport(What,Code)));
end;

procedure TestPipeIO;
var pipe,i,n,m:Integer; s:String;
begin
 Echo('Test pipe I/O.');
 n:=0;
 m:=ObjectRegistry.Count;
 if ParamStr(1)=''
 then pipe:=pipe_init('tcp port 1234 server 2')
 else pipe:=pipe_init('tcp port 1234 client '+ParamStr(1));
 (pipe_ref(pipe) as TSocketPipe).Reporter:=TestReporter;
 Echo((pipe_ref(pipe) as TSocketPipe).Polling.Name);
 while pipe<>0 do begin
  if pipe_connected(pipe)>0 then
  for i:=0 to pipe_count(pipe)-1 do
  if pipe_connected(pipe_stream(pipe,i))>0 then begin
   s:=pipe_recv(pipe_stream(pipe,i),255);
   if s<>'' then Echo(Format('%g %s',[msecnow,s]));
   if GetTickCount mod 100 = 0 then begin
    pipe_send(pipe_stream(pipe,i),Format('%d %s',[n,DateTimeToStr(Now)+CRLF]));
    inc(n);
   end;
   if Pos('exit',s)>0 then begin pipe_free(pipe); pipe:=0; end;
  end;
  Sleep(1);
 end;
 Echo(Format('Exit %d',[ObjectRegistry.Count-m]));
end;

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

procedure Init_crw_pipeio;
begin
end;

procedure Free_crw_pipeio;
begin
end;

initialization

 Init_crw_pipeio;

finalization

 Free_crw_pipeio;

end.

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

