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

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

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// Task (i.e. process, application, program) execution control routines.      //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20040725 - Creation                                                        //
// 20040729 - First tested release                                            //
// 20040801 - KillProcess,KillProcessTree,TRunningProcessList                 //
// 20052102 - GetExeByFile,ShellExecuteOpen                                   //
// 20050514 - Account,CreateProcessWithLogon etc.                             //
// 20050516 - Bug fixed: Account fail in W2k.                                 //
// 20050812 - Priority                                                        //
// 20051226 - Inherit handles only if stdio redirected, SmartExecute.         //
// 20060326 - Fixed bug (possible deadlock) in Detach.                        //
// 20070220 - StdInpPipeFifoClear,StdOutPipeFifoClear                         //
// 20090103 - TTask.Run modified                                              //
// 20101225 - FindParentProcessId,FindParentProcessExe,GetProcessHandleCount  //
// 20120518 - GetConsoleWindow,GetWindowClassName,GetWindowProcessId,         //
//            FindWindowByPidAndClassName,                                    //
//            WM_COPYDATA_SendToWindowByPidAndClassName                       //
// 20170413 - EnumThreads, EnumProcesses                                      //
// 20170818 - PidAffinity, cpu_count                                          //
// 20180619 - TTask.Decrypt(aBuff,aSize),TaskShuttleEncode,TaskShuttleDecode  //
// 20200614 - EnumModules,GetListOfModules,GetListOfModulesAsText             //
// 20200924 - AssocQueryString,GetExeByExtension,GetSystemAssoc,              //
//            GetSystemFType,...                                              //
// 20210405 - GetAuto clean on close                                          //
// 20210421 - task_ref_min,task_ref_max                                       //
// 20210626 - ConsoleWnd, Terminate (correct wm_close to console).            //
// 20211013 - WScriptShellRun,GetRegAppPath,GetAppPath                        //
// 20230913 - Modified for FPC (A.K.). Unit _task was splitted to _crw_task,  //
//            _crw_sysid, _crw_proc, _crw_wmctrl, _crw_uac, etc               //
// 20230921 - 1st release for FPC                                             //
// 20231219 - DetachedPidList,PollDetachedPids                                //
// 20240322 - LogNote                                                         //
// 20240518 - DebugLog on Task Run/Kill                                       //
// 20250207 - TRunningProcessList.ExtractField,Threads,ResfreshProcessList    //
// 20250208 - TRunningProcessList uses TStringList because it's immutable     //
// 20260308 - PidKill                                                         //
// 20260416 - TRunningProcessList.IndexOfPid                                  //
////////////////////////////////////////////////////////////////////////////////

unit _crw_task; // Task, i.e. process control

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

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

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 {$IFDEF WINDOWS} jwatlhelp32, shellapi, comobj, registry, {$ENDIF}
 {$IFDEF UNIX} baseunix, unix, {$ENDIF}
 sysutils, classes, math, variants, lmessages, lcltype, lclintf, lazfileutils,
 pipes, process,
 _crw_alloc, _crw_str, _crw_fifo, _crw_fio, _crw_rtc, _crw_dynar, _crw_crypt,
 _crw_base64, _crw_polling, _crw_proc, _crw_assoc, _crw_wmctrl, _crw_sysid,
 _crw_uac, _crw_utf8, _crw_environ, _crw_ef, _crw_hl, _crw_dbglog,
 _crw_procps, _crw_procws;

 ///////////////////////
 // TTask.Options flags.
 ///////////////////////
const
 poTermOnDetach           = $00000001; // Terminate process on TTask.Detach
 poTermStdInpPipeOnDetach = $00000002; // Terminate process on TTask.Detach if StdInp redirected to pipe
 poTermStdOutPipeOnDetach = $00000004; // Terminate process on TTask.Detach if StdOut redirected to pipe
 poTermStdErrPipeOnDetach = $00000008; // Terminate process on TTask.Detach if StdErr redirected to pipe
 poNonBlockingStdInpPipe  = $00000010; // Uses non-blocking StdInp pipe I/O
 poNonBlockingStdOutPipe  = $00000020; // Uses non-blocking StdOut pipe I/O
 poNonBlockingStdErrPipe  = $00000040; // Uses non-blocking StdErr pipe I/O
 poNonBlockingAtomicPipe  = $00000080; // Task IO uses atomic pipe operations (PIPE_BUF)
 poInheritCurrEnviroment  = $00000100; // Task process inherit current environment (Unix)
 poSwitchStdErrToStdOut   = $00000200; // Redirect StdErr to StdOut if StdErrPipe=0
 poAssumeStdInpTextMode   = $00000400; // Assume StdInp working in text mode with EOL
 poAssumeStdOutTextMode   = $00000800; // Assume StdOut working in text mode with EOL
 poAssumeStdErrTextMode   = $00001000; // Assume StdErr working in text mode with EOL

 //////////////////
 // Default values.
 //////////////////
const
 DefTaskTermHow = 0;                        // Default termination code "How"
 DefTaskDisplay = 1;                        // Default TTask.Display mode
 DefTaskOptions = poTermStdInpPipeOnDetach  // Terminate if StdInp redirected
               or poTermStdOutPipeOnDetach  // Terminate if StdOut redirected
               or poTermStdErrPipeOnDetach  // Terminate if StdErr redirected
               or poNonBlockingStdInpPipe   // Use nonblocking StdInp (Unix)
               or poNonBlockingStdOutPipe   // Use nonblocking StdOut (Unix)
               or poNonBlockingStdErrPipe   // Use nonblocking StdErr (Unix)
               or poNonBlockingAtomicPipe   // Use atomic pipe IO     (Unix)
               or poInheritCurrEnviroment;  // Inherit environment    (Unix)

const
 MinTaskPollPeriod  = 1;               // Minimal poll period for StdOut,StdErr
 MaxTaskPollPeriod  = 1000;            // Maximal poll period for StdOut,StdErr
 DefTaskPollPeriod  : Integer = 4;     // Default poll period for StdOut,StdErr

const
 MinTaskRunTimeout  = 1;               // Minimal wait timeout for Run
 MaxTaskRunTimeout  = 5000;            // Maximal wait timeout for Run
 DefTaskRunTimeout  : Integer = 500;   // Default wait timeout for Run

const
 MinTaskSyncTimeout = 1;               // Minimal wait timeout for RxSync
 MaxTaskSyncTimeout = 5000;            // Maximal wait timeout for RxSync
 DefTaskSyncTimeout : Integer = 100;   // Default wait timeout for RxSync

const
 MinTaskSendTimeout = 1;               // Minimal wait timeout for Send/Write
 MaxTaskSendTimeout = 5000;            // Maximal wait timeout for Send/Write
 DefTaskSendTimeout : Integer = 2000;  // Default wait timeout for Send/Write

const                                  // Uses StdIO Fifo GrowFactor = 2
 MinTaskPipeLimit   = MegaByte*1;      // Minimal StdIn/Out/Err Fifo GrowLimit
 MaxTaskPipeLimit   = MegaByte*128;    // Maximal StdIn/Out/Err Fifo GrowLimit
 DefTaskPipeLimit   = MegaByte*32;     // Default StdIn/Out/Err Fifo GrowLimit

const
 TaskGuardParanoid  : Boolean = false; //  Burn all account info ASAP

type // Handler for detached processes.
 TTaskDetachedPidHandler = function(aPid:TPid):Integer;

 // Default handler for detached processes.
function DefaultTaskPollDetachedPids(aPid:TPid):Integer;

 ////////////////////////////////////
 // Exception raised on TTask errors.
 ////////////////////////////////////
type
 ETask = class(EEchoException);

 ///////////////////////////////////////////////////////////////////////////////
 // Task (process,application,program) control class.
 // Uses to run applications/commands, standard I/O redirection ect.
 // Methods:
 //  Run       - If process attached, i.e Pid<>0, return false.
 //              Otherwise call CreateProcess to create new process.
 //              Process defined by AppName,CmdLine,Environment,Display,etc.
 //              If StdInpPipeSize>0, redirect StdIn.
 //              If StdOutPipeSize>0, redirect StdOut.
 //              If StdErrPipeSize>0, redirect StdErr.
 //              If Run return true, new process attached, i.e. Pid<>0.
 //              Use Running to check if process still running or not.
 //  Running   - return true if process attached and still running.
 //              Running or Running(0) return process state immediately.
 //              Running(timeout) may be used to wait normal task termination.
 //  Detach    - Detach process, if one running, close process & pipe handles.
 //              If poTerminateOnDetach in Options, process will be terminated.
 //              If process still running, it will now live with it's own life.
 //              Be care, if uses standard i/o redirection: all file/pipe handles
 //              will be closed.
 //              If process still running, it may cause process file i/o errors.
 //              So you should not use Detach with file/pipe redirection.
 //  Terminate - process termination with given exit code.
 //              Maybe some timeout needed to be sure that process really killed.
 //              Even if process killed, all handles opened until Detach call.
 //  AppName   - Application name. May be empty, if CmdLine is not empty.
 //  CmdLine   - Application command line parameters. May be empty.
 //  HomeDir   - Start directory when task started. Empty mean current directory.
 //  Account   - Encrypted account (user,domain,password) to logon as another user.
 //  Encrypt   - Find encrypted account by user+CRLF+domain+CRLF+password.
 //  Environment - Enwironment strings for task. Empty means current environment.
 //  StdInpPipeSize - if >0, standard input  redirected to pipe.
 //  StdOutPipeSize - if >0, standard output redirected to pipe.
 //  StdErrPipeSize - if >0, standard errors redirected to pipe.
 //  StdInpPipeFifo - FIFO to write to  StdIn  pipe if redirected.
 //  StdOutPipeFifo - FIFO to read from StdOut pipe if redirected.
 //  StdErrPipeFifo - FIFO to read from StdErr pipe if redirected.
 //  StdInpPriority - StdIn  I/O thread priority.
 //  StdOutPriority - StdOut I/O thread priority.
 //  StdErrPriority - StdErr I/O thread priority.
 //  ExitCode       - Process exit code (or STILL_ACTIVE if Running in Windows)
 //  ExitStatus     - WaitPid status (ExitCode or may be <> ExitCode on Unix)
 //  Display        - usually SW_SHOWNORMAL or SW_HIDE
 //  Options        - miscallenious options
 //  ThreadPriority - main process thread priority.
 //  ProcessPriority- process priority class level, see GetPriorityClassLevel.
 //  Info           - general process information
 //  Pid            - process identifier or 0 if task was not Run or was Detach.
 //  Wnd            - handle of main window of main process thread or 0.
 // Notes:
 // 1) Use "Pid<>0" to test if prosess attached or not.
 //    If process is not attached, we have no any information or access to it.
 //    If process attached, USER COULD NOT CHANGE properties, like AppName,
 //    CmdLine,HomeDir,Account,Environment,StdInpXX,StdOutXX,StdErrXX,Options.
 //    All changes will be ignored while (CanEdit=false) i.e. (Pid<>0).
 // 2) If process attached, use "Running" to check if process still running.
 // 3) Tx,StdInp means Transmitter (Task transmit data   to   Process.StdIn)
 // 4) Rx,StdOut means Receiver    (Task receive  data   from Process.StdOut)
 // 5) Ex,StdErr means ErrorReport (Task receive  errors from Process.StdErr)
 ///////////////////////////////////////////////////////////////////////////////
 // General Task class for process control
 ///////////////////////////////////////////////////////////////////////////////
 TTask = class(TLatch)
 private
  myTid      : Integer;
  myProcess  : TProcess;
  myCodePage : Integer;
  myAccount  : packed record
   Key       : PureString;
   User      : PureString;
   Domain    : PureString;
   Password  : PureString;
  end;
  myStdInp   : packed record
   Fifo      : TFifo;
   Polling   : TPolling;
   PipeSize  : Integer;
   PipeLimit : Integer;
   Priority  : Integer;
  end;
  myStdOut   : packed record
   Fifo      : TFifo;
   Polling   : TPolling;
   PipeSize  : Integer;
   PipeLimit : Integer;
   Priority  : Integer;
  end;
  myStdErr   : packed record
   Fifo      : TFifo;
   Polling   : TPolling;
   PipeSize  : Integer;
   PipeLimit : Integer;
   Priority  : Integer;
  end;
  myOptions         : Integer;
  myThreadPriority  : Integer;
  myProcessPriority : Integer;
  myPollPeriod      : Integer;
  myRunTimeout      : Integer;
  mySyncTimeout     : Integer;
  mySendTimeout     : Integer;
 private
  function    GetPid:TPid;
  function    GetTid:Integer;
  procedure   SetTid(aTid:Integer);
  function    GetProcess:TProcess;
  function    GetAppName:LongString;
  procedure   SetAppName(aAppName:LongString);
  function    GetExeName:LongString;
  procedure   SetExeName(aExeName:LongString);
  function    GetCmdLine:LongString;
  procedure   SetCmdLine(aCmdLine:LongString);
  function    GetCmdArgs:LongString;
  procedure   SetCmdArgs(aCmdArgs:LongString);
  function    GetHomeDir:LongString;
  procedure   SetHomeDir(aHomeDir:LongString);
  function    GetAccount:LongString;
  function    GetCodePage:Integer;
  procedure   SetCodePage(aCodePage:Integer);
  procedure   SetAccount(aAccount:LongString);
  function    GetEnvironment:LongString;
  procedure   SetEnvironment(aEnvironment:LongString);
  function    GetStdInpPipeSize:Integer;
  procedure   SetStdInpPipeSize(aPipeSize:Integer);
  function    GetStdInpPipeLimit:Integer;
  procedure   SetStdInpPipeLimit(aPipeLimit:Integer);
  function    GetStdInpPipeFifoCount:Integer;
  function    GetStdInpPipeFifoSpace:Integer;
  function    GetStdInpPriority:TThreadPriority;
  procedure   SetStdInpPriority(aPriority:TThreadPriority);
  function    GetStdOutPipeSize:Integer;
  procedure   SetStdOutPipeSize(aPipeSize:Integer);
  function    GetStdOutPipeLimit:Integer;
  procedure   SetStdOutPipeLimit(aPipeLimit:Integer);
  function    GetStdOutPipeFifoCount:Integer;
  function    GetStdOutPipeFifoSpace:Integer;
  function    GetStdOutPriority:TThreadPriority;
  procedure   SetStdOutPriority(aPriority:TThreadPriority);
  function    GetStdErrPipeSize:Integer;
  procedure   SetStdErrPipeSize(aPipeSize:Integer);
  function    GetStdErrPipeLimit:Integer;
  procedure   SetStdErrPipeLimit(aPipeLimit:Integer);
  function    GetStdErrPipeFifoCount:Integer;
  function    GetStdErrPipeFifoSpace:Integer;
  function    GetStdErrPriority:TThreadPriority;
  procedure   SetStdErrPriority(aPriority:TThreadPriority);
  function    GetDisplay:Integer;
  procedure   SetDisplay(aDisplay:Integer);
  function    GetConsoleMode:Integer;
  procedure   SetConsoleMode(aConsoleMode:Integer);
  function    GetExitCode:Integer;
  function    GetExitStatus:Integer;
  function    GetOptions:Integer;
  procedure   SetOptions(aOptions:Integer);
  function    GetThreadPriority:TThreadPriority;
  procedure   SetThreadPriority(aPriority:TThreadPriority);
  function    GetProcessPriority:Integer;
  procedure   SetProcessPriority(aPriority:Integer);
  function    GetPollPeriod:Integer;
  procedure   SetPollPeriod(aPeriod:Integer);
  function    GetRunTimeout:Integer;
  procedure   SetRunTimeout(aTimeout:Integer);
  function    GetSyncTimeout:Integer;
  procedure   SetSyncTimeout(aTimeout:Integer);
  function    GetSendTimeout:Integer;
  procedure   SetSendTimeout(aTimeout:Integer);
  function    GetMainWnd:hWnd;
  function    GetConsoleWnd:hWnd;
 protected
  function    CheckOk:Boolean; override;
  procedure   ErrorFound(E:Exception; const Note:LongString=''); override;
  procedure   ReadStreamToFifo(Stream:TInputPipeStream; Fifo:TFifo;
                               TextMode:Boolean);
  procedure   WriteFifoToStream(Fifo:TFifo; Stream:TOutputPipeStream;
                                TextMode,AtomicPipe:Boolean);
  procedure   WriteFifoToStdInp;
  procedure   ReadStdOutToFifo;
  procedure   ReadStdErrToFifo;
  function    CanEdit:Boolean;
 public
  constructor Create;
  destructor  Destroy; override;
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
 public
  function    Run:Boolean;
  function    Running(aTimeOut:Integer=0):Boolean;
  function    Ctrl(const arg:LongString):LongString;
  procedure   Detach(aHow:Integer=DefTaskTermHow;aExitCode:Integer=0;aTimeOut:Integer=0);
  function    Terminate(aHow:Integer=DefTaskTermHow;aExitCode:Integer=0;aTimeOut:Integer=0):Boolean;
  function    Encrypt(const UserCrlfDomainCrlfPassword:LongString):LongString;
  function    Decrypt(aBuff:PChar=nil; aSize:Integer=0):Boolean;
  function    StdInpSync(aTimeOut:Integer; aNum:Integer=1):Int64;
  function    StdOutSync(aTimeOut:Integer; aNum:Integer=1):Int64;
  function    StdErrSync(aTimeOut:Integer; aNum:Integer=1):Int64;
  procedure   ApplyEncoding(var Data:LongString; Direct:Integer);
  function    NeedEncoding:Boolean;
  procedure   StdInpPipeFifoClear;
  procedure   StdOutPipeFifoClear;
  procedure   StdErrPipeFifoClear;
  procedure   Burn(Who:Integer=7);
 public
  function    Send(const data:LongString):Integer;
  function    Recv(MaxLen:Integer):LongString;
  function    TxSend(const data:LongString):Integer;
  function    RxRecv(MaxLen:Integer):LongString;
  function    ExRecv(MaxLen:Integer):LongString;
 public
  property Pid                 : TPid                read GetPid;
  property Tid                 : Integer             read GetTid;
  property Process             : TProcess            read GetProcess;
  property AppName             : LongString          read GetAppName         write SetAppName;
  property ExeName             : LongString          read GetExeName         write SetExeName;
  property CmdLine             : LongString          read GetCmdLine         write SetCmdLine;
  property CmdArgs             : LongString          read GetCmdArgs         write SetCmdArgs;
  property HomeDir             : LongString          read GetHomeDir         write SetHomeDir;
  property Account             : LongString          read GetAccount         write SetAccount;
  property CodePage            : Integer             read GetCodePage        write SetCodePage;
  property PollPeriod          : Integer             read GetPollPeriod      write SetPollPeriod;
  property RunTimeout          : Integer             read GetRunTimeout      write SetRunTimeout;
  property SyncTimeout         : Integer             read GetSyncTimeout     write SetSyncTimeout;
  property SendTimeout         : Integer             read GetSendTimeOut     write SetSendTimeout;
  property Environment         : LongString          read GetEnvironment     write SetEnvironment;
  property StdInpPipeSize      : Integer             read GetStdInpPipeSize  write SetStdInpPipeSize;
  property StdInpPipeLimit     : Integer             read GetStdInpPipeLimit write SetStdInpPipeLimit;
  property StdInpPipeFifoCount : Integer             read GetStdInpPipeFifoCount;
  property StdInpPipeFifoSpace : Integer             read GetStdInpPipeFifoSpace;
  function StdInpPipeFifoPutText(const aText:LongString; WakeUp:Boolean=true):Boolean;
  property StdInpPriority      : TThreadPriority     read GetStdInpPriority  write SetStdInpPriority;
  property StdOutPipeSize      : Integer             read GetStdOutPipeSize  write SetStdOutPipeSize;
  property StdOutPipeLimit     : Integer             read GetStdOutPipeLimit write SetStdOutPipeLimit;
  property StdOutPipeFifoCount : Integer             read GetStdOutPipeFifoCount;
  property StdOutPipeFifoSpace : Integer             read GetStdOutPipeFifoSpace;
  function StdOutPipeFifoGetText(aSize:Integer=MaxInt):LongString;
  property StdOutPriority      : TThreadPriority     read GetStdOutPriority  write SetStdOutPriority;
  property StdErrPipeSize      : Integer             read GetStdErrPipeSize  write SetStdErrPipeSize;
  property StdErrPipeLimit     : Integer             read GetStdErrPipeLimit write SetStdErrPipeLimit;
  property StdErrPipeFifoCount : Integer             read GetStdErrPipeFifoCount;
  property StdErrPipeFifoSpace : Integer             read GetStdErrPipeFifoSpace;
  function StdErrPipeFifoGetText(aSize:Integer=MaxInt):LongString;
  property StdErrPriority      : TThreadPriority     read GetStdErrPriority  write SetStdErrPriority;
  property ExitCode            : Integer             read GetExitCode;
  property ExitStatus          : Integer             read GetExitStatus;
  property Display             : Integer             read GetDisplay         write SetDisplay;
  property ConsoleMode         : Integer             read GetConsoleMode     write SetConsoleMode;
  property Options             : Integer             read GetOptions         write SetOptions;
  property ThreadPriority      : TThreadPriority     read GetThreadPriority  write SetThreadPriority;
  property ProcessPriority     : Integer             read GetProcessPriority write SetProcessPriority;
  property MainWnd             : hWnd                read GetMainWnd;
  property ConsoleWnd          : hWnd                read GetConsoleWnd;
 public // Service functions
  class function IsValidExeFile(FileName:LongString):Boolean;
 public // Detached PID handling (antizombie)
  class function DetachedPidList:TObjectStorage;
  class function AddDetachedPid(aPid:TPid):Boolean;
  class function DelDetachedPid(aPid:TPid):Boolean;
  // This procedure should be called by timer to avoid zombie processes.
  class function PollDetachedPids(aHandler:TTaskDetachedPidHandler=nil):Integer;
 public // Set LogNoteCommandPrefix to send aMsg to MainConsole instead of Echo.
  class procedure LogNote(const aMsg:LongString);
  class var LogNoteCommandPrefix:LongString;
 end;

 ////////////////////////////////////////////
 // Full list of all existing TTask instances
 ////////////////////////////////////////////
function  FullTaskList:TObjectStorage;

 ////////////////////////////////
 // Task construction/destruction
 ////////////////////////////////
function  NewTask(const aAppName     : LongString      = '';
                  const aCmdLine     : LongString      = '';
                  const aHomeDir     : LongString      = '';
                  const aAccount     : LongString      = '';
                  const aEnvironment : LongString      = '';
                  const aDisplay     : Cardinal        = DefTaskDisplay;
                  const aStdInpPipe  : Integer         = 0;
                  const aStdOutPipe  : Integer         = 0;
                  const aStdErrPipe  : Integer         = 0;
                  const aOptions     : Integer         = DefTaskOptions;
                  const aRunning     : Boolean         = false):TTask;
procedure Kill(var TheObject:TTask); overload;

 // Simple (shuttle) protection for TTask.Decrypt data
function TaskShuttleEncode(Str:LongString):LongString;
function TaskShuttleDecode(Str:LongString):LongString;

 ///////////////////////////////////////////////////////////////////////////////
 // Выполнить командную строку CmdLine.
 // Если ShellCm='Open','Print','Explore', вызвать через ShellExecute
 ///////////////////////////////////////////////////////////////////////////////
function SmartExecute(const CmdLine:LongString;
                            Display:Integer=SW_SHOWNORMAL;
                            ShellCm:LongString=''):Boolean;

 ///////////////////////////////////////////////////////////////////////////////
 // Set process affinity mask
 ///////////////////////////////////////////////////////////////////////////////
function PidAffinity(pid:TPid; mask:Int64=0):Int64;

 ///////////////////////////////////////////////////////////////////////////////
 // TRunningProcessList is list of processes currently running in the system.
 // It's wrapper (parser) for GetListOfProcesses results to use it easy.
 // Count         - Number of running processes.
 // Pid           - Process identifier array. Index in range 0..Count-1.
 // ParentPid     - Parent process PID array.
 // TaskName      - Task name - usually process base file name.
 // Priority      - Process priority level (1-31 on Windows, 1-120 on Linux).
 // Threads       - How many threads running in process.
 // PriorityClass - Process priority class.
 // CmdLine       - Command line (required creation Mode glopf_CmdLine).
 // Notes:
 //  1. TRunningProcessList is immutable snapshot, so it's thread safe.
 //  2. Creation Mode contains glopf_XXXX constants, see glopf_CmdLine.
 ///////////////////////////////////////////////////////////////////////////////
type
 TRunningProcessList=class(TMasterObject)
 private
  myMode : Integer;
  myList : TStringList;
  function  GetCount:Integer;
  function  GetPid(i:Integer):TPid;
  function  GetParentPid(i:Integer):TPid;
  function  GetTaskName(i:Integer):LongString;
  function  GetPriority(i:Integer):Integer;
  function  GetState(i:Integer):Char;
  function  GetThreads(i:Integer):Integer;
  function  GetPriorityClass(i:Integer):Integer;
  function  GetCmdLine(i:Integer):LongString;
 public
  constructor Create(aMode:Integer);
  destructor  Destroy; override;
 public
  function  RefreshProcessList:Integer;
  function  IndexOfPid(aPid:TPid):Integer;
 public
  property  Count                : Integer     read GetCount;
  property  Pid[i:Integer]       : TPid        read GetPid; default;
  property  ParentPid[i:Integer] : TPid        read GetParentPid;
  property  Priority[i:Integer]  : Integer     read GetPriority;
  property  TaskName[i:Integer]  : LongString  read GetTaskName;
  property  State[i:Integer]     : Char        read GetState;
  property  Threads[i:Integer]   : Integer     read GetThreads;
  property  PriorityClass[i:Integer] : Integer read GetPriorityClass;
  property  CmdLine[i:Integer]   : LongString  read GetCmdLine;
 end;

function  NewRunningProcessList(Mode:Integer=0):TRunningProcessList;
procedure Kill(var TheObject:TRunningProcessList); overload;

 ///////////////////////////////////////////////////////////////////////////////
 // KillProcess     - Terminate process by given PID.
 // KillProcessTree - Terminate process with all descendants (child proceses).
 ///////////////////////////////////////////////////////////////////////////////
function KillProcess(aPid:TPid; aExitCode:Integer; sig:Integer=SIGTERM):Boolean;
function KillProcessTree(aPid:TPid; aExitCode:Integer; MaxLevel:Integer=100; sig:Integer=SIGTERM):Integer;

const
 markUnxSig = Low(Integer); // marker to use unix-style pidkill(pid,sig)

 ///////////////////////////////////////////////////////////////////////////////
 // PidKill(pid,sig)      - send signal (sig) to process (pid) like unix kill
 // PidKill(pid,cod,lev)  - kill proc. tree with exit code (cod) levels (lev)
 // PidKill(pid,-sig,lev) - kill proc. tree with signal    (sig) levels (lev)
 // PidKill(pid,cod,-sig) - kill proc. tree with signal    (sig) & code (cod)
 // PidKill(pid,0,0)      - kill process (pid) with SIGTERM & exit code 0
 // PidKill(pid,0)        - kill process (pid) with SIGTERM & exit code 0
 ///////////////////////////////////////////////////////////////////////////////
function PidKill(pid:TPid; cod:Integer; lev:Integer=markUnxSig):Integer;

 ///////////////////////////////////////////////////////////////////////////////
 // Easy task routines, to be use in DAQ PASCAL
 // tid          - Task index, integer value (tid>0) to identify task.
 //                Zero value of tid uses to indicate error or null task.
 // task_init    - Create empty task, initialize CmdLine, return task index.
 //                After task_init, task_ref<>nil,task_pid=0,task_wait=false.
 //                Task not attached to process, you need task_run call to do it.
 //                Return 0 if free task index not found, if task table overflow.
 // task_free    - Destroy task instance and free task index for future use.
 // task_ref     - Return task instance by task index or nil if not exists.
 //                Existing reference means that task_init call was done.
 // task_pid     - Process identifier (pid) or 0 if process not attached.
 //                task_pid will return pid<>0 after task_run call.
 // task_run     - Create and run process, return true if success.
 //                After task_run call, task_pid<>0, task_wait=true.
 //                Task now will be attached to process, even if one terminated.
 //                If process already attached, return false.
 //                So you don't call task_run two times.
 // task_wait    - Wait timeout while process running.
 //                Return true if process still running.
 //                Use task_wait(tid,0) to check immediately if process running.
 // task_send    - Send data string to process standard stdin stream.
 //                Works if only stdin was redirected to pipe.
 // task_recv    - Receive data string from process standard stdout stream.
 //                Works if only stdout was redirected to pipe.
 // task_txcount - Data count in stdin  pipe.
 // task_rxcount - Data count in stdout pipe.
 // task_txspace - Data space in stdin  pipe.
 // task_rxspace - Data space in stdout pipe.
 // task_result  - Return exit code of terminated process.
 //                If process still running, return 259=STILL_ACTIVE.
 // task_kill    - Terminate process. Argument how means how to kill.
 //                0 - TerminateProcess
 //                1 - Post WM_CLOSE to window or send SIGINT  (Unix)
 //                2 - Post WM_QUIT  to window or send SIGQUIT (Unix)
 //                3 - Kill process tree (be care!).
 // task_ctrl    - Task control, set parameters.
 //                task_ctrl('name')       - return parameter value
 //                task_ctrl('name=value') - assign parameter value
 //  AppName         = ExeName Synonym
 //  ExeName         = Executable program file name
 //  CmdLine         = Command line as ExeName CmdArgs
 //  CmdArgs         = Command line arguments not including ExeName
 //  HomeDir         = Directory where propram to run
 //  Encrypt=S       = Encrypt string S
 //  Account         = Account = User CRLF Domain CRLF Password
 //  Display         = Display mode, 0..10, or SW_XXX constants
 //  TxPipeSize      = Program's StdIn Pipe Size, byte (Tx mean Transmitter)
 //  StdInPipeSize   = TxPipeSize Synonym
 //  StdInpPipeSize  = TxPipeSize Synonym
 //  RxPipeSize      = Program's StdOut pipe size, byte (Rx mean Receiver)
 //  StdOutPipeSize  = RxPipeSize Synonym
 //  ExPipeSize      = Program's StdErr pipe size, byte (Ex mean Errors)
 //  StdErrPipeSize  = RxPipeSize Synonym
 //  TxPipeLimit     = Tx pipe FIFO grow limit, bytes
 //  StdInPipeLimit  = TxPipeLimit Synonym
 //  StdInpPipeLimit = TxPipeLimit Synonym
 //  RxPipeLimit     = Rx pipe FIFO grow limit, bytes
 //  StdOutPipeLimit = RxPipeLimit Synonym
 //  ExPipeLimit     = Ex pipe FIFO grow limit, bytes
 //  StdErrPipeLimit = ExPipeLimit Synonym
 //  TxPriority      = Tx thread priority as string (tpIdle,..,tpTimeCritical)
 //  StdInPriority   = TxPriority Synonym
 //  StdInpPriority  = TxPriority Synonym
 //  RxPriority      = Rx thread priority as string (tpIdle,..,tpTimeCritical)
 //  StdOutPriority  = RxPriority Synonym
 //  ExPriority      = Ex thread priority as string (tpIdle,..,tpTimeCritical)
 //  StdErrPriority  = ExPriority Synonym
 //  ThreadPriority  = Process thread priority
 //  ProcessPriority = Process priority
 //  Env             = Synonym Environment
 //  Environ         = Synonym Environment
 //  Environment     = Get environment variables of process
 //  Environment=e   = Set environment variables of process (e)
 //                    Environment=Inherited means inherit current environment
 //  Charset         = CodePage Synonym
 //  Encoding        = CodePage Synonym
 //  CodePage        = CodePage (866=ru_dos,1251=ru_win,65001=UTF8,0=65535=NONE)
 //  TxLost          = Tx (StdIn)  Number of bytes lost due to IO errors
 //  RxLost          = Rx (StdOut) Number of bytes lost due to IO errors
 //  ExLost          = Ex (StdErr) Number of bytes lost due to IO errors
 //  TxTotal         = Rx (StdIn)  Total number of bytes transferred to FIFO
 //  RxTotal         = Rx (StdOut) Total number of bytes transferred to FIFO
 //  ExTotal         = Ex (StdErr) Total number of bytes transferred to FIFO
 //  TxSync=t        = Tx Synchronize: wait (timeout t) & return Tx loop count
 //  StdInSync       = TxSync Synonym
 //  StdInpSync      = TxSync Synonym
 //  RxSync=t        = Rx Synchronize: wait (timeout t) & return Rx loop count
 //  StdOutSync      = RxSync Synonym
 //  ExSync=t        = Ex Synchronize: wait (timeout t) & return Ex loop count
 //  StdErrSync      = ExSync Synonym
 //  Pid             = ProcessID of task process or 0 if process not started
 //  Tid             = Task index (tid)
 //  ExitCode        = Process exit code
 //  ExitStatus      = Process exit status
 //  TxSize          = Current size of Tx (StdIn)  FIFO, bytes
 //  RxSize          = Current size of Rx (StdOut) FIFO, bytes
 //  ExSize          = Current size of Ex (StdErr) FIFO, bytes
 //  TxLimit         = Current grow limit of Tx FIFO, bytes
 //  RxLimit         = Current grow limit of Rx FIFO, bytes
 //  ExLimit         = Current grow limit of Ex FIFO, bytes
 //  TxCount         = Current Tx FIFO data count, bytes
 //  RxCount         = Current Rx FIFO data count, bytes
 //  ExCount         = Current Ex FIFO data count, bytes
 //  TxSpace         = Current Rx FIFO free space, bytes
 //  RxSpace         = Current Rx FIFO free space, bytes
 //  ExSpace         = Current Ex FIFO free space, bytes
 //  TxSend=DATA     = Send DATA to Tx (StdIn)  FIFO
 //  RxRecv=N        = Receive max.N bytes from Rx (StdOut)
 //  ExRecv=N        = Receive max.N bytes from Ex (StdErr)
 //  *               = list of all read/write parameters
 //  *=              = list of only writable  parameters
 //  ?               = list (Name=Value) all read/write parameters
 //  ?=              = list (Name=Value) only writable  parameters
 // Notes:
 // 1) Task indexes are in range of [task_ref_min,task_ref_max].
 // 2) A lot of parameters like (ExeName,CmdLine,Display,HomeDir,Charset etc)
 //    can be changed only BEFORE task_run, when task is not running yet.
 ///////////////////////////////////////////////////////////////////////////////
function task_init(const cmd_line:LongString):Integer;
function task_free(tid:Integer):Boolean;
function task_ref(tid:Integer):TTask;
function task_pid(tid:Integer):Integer;
function task_run(tid:Integer):Boolean;
function task_wait(tid,timeout:Integer):Boolean;
function task_send(tid:Integer; const data:LongString):Integer;
function task_recv(tid,maxlen:Integer):LongString;
function task_txcount(tid:Integer):Integer;
function task_rxcount(tid:Integer):Integer;
function task_txspace(tid:Integer):Integer;
function task_rxspace(tid:Integer):Integer;
function task_result(tid:Integer):Integer;
function task_kill(tid,how,exit_code,timeout:Integer):Boolean;
function task_ctrl(tid:Integer; const arg:LongString):LongString;

const                // Task reference range
 task_ref_min = 1;   // Minimal task reference
 task_ref_max = 255; // Maximal task reference

 //////////////////////////////
 // Test routine to check TTask
 //////////////////////////////
{$IFDEF Poligon}
procedure TestTask1;
procedure TestTask2;
{$ENDIF Poligon}

implementation

 /////////////////////////////////////////////////////
 // Private Dictionary for fast string identification.
 /////////////////////////////////////////////////////
type
 TStringIdentifier = (
  sid_Unknown,
  ////////////////////// Properties Writable
  sid_AppName,
  sid_ExeName,
  sid_CmdLine,
  sid_CmdArgs,
  sid_HomeDir,
  sid_Encrypt,
  sid_Account,
  sid_Display,
  sid_ConsoleMode,
  sid_Options,
  sid_TxPipeSize,
  sid_StdInPipeSize,
  sid_StdInpPipeSize,
  sid_RxPipeSize,
  sid_StdOutPipeSize,
  sid_ExPipeSize,
  sid_StdErrPipeSize,
  sid_TxPipeLimit,
  sid_StdInPipeLimit,
  sid_StdInpPipeLimit,
  sid_RxPipeLimit,
  sid_StdOutPipeLimit,
  sid_ExPipeLimit,
  sid_StdErrPipeLimit,
  sid_TxPriority,
  sid_StdInPriority,
  sid_StdInpPriority,
  sid_RxPriority,
  sid_StdOutPriority,
  sid_ExPriority,
  sid_StdErrPriority,
  sid_ThreadPriority,
  sid_ProcessPriority,
  sid_Env,
  sid_Environ,
  sid_Environment,
  sid_Charset,
  sid_Encoding,
  sid_CodePage,
  sid_TxLost,
  sid_RxLost,
  sid_ExLost,
  sid_TxTotal,
  sid_RxTotal,
  sid_ExTotal,
  sid_TxSync,
  sid_StdInSync,
  sid_StdInpSync,
  sid_RxSync,
  sid_StdOutSync,
  sid_ExSync,
  sid_StdErrSync,
  sid_RunTimeout,
  sid_SyncTimeout,
  sid_SendTimeout,
  ////////////////////// Properties ReadOnly
  sid_Pid,
  sid_Tid,
  sid_Running,
  sid_ExitCode,
  sid_ExitStatus,
  sid_TxSize,
  sid_RxSize,
  sid_ExSize,
  sid_TxLimit,
  sid_RxLimit,
  sid_ExLimit,
  sid_TxCount,
  sid_RxCount,
  sid_ExCount,
  sid_TxSpace,
  sid_RxSpace,
  sid_ExSpace,
  ////////////////////// Special IO
  sid_TxSend,
  sid_RxRecv,
  sid_ExRecv,
  ////////////////////// Properties End
  sid_Asterisk,
  sid_Question,
  sid_Unused
 );

const
 Dictionary:THashList=nil;

procedure FreeDictionary;
begin
 Kill(Dictionary);
end;

procedure InitDictionary;
 procedure AddSid(const key:LongString; sid:TStringIdentifier);
 begin
  Dictionary.KeyedLinks[key]:=Ord(sid);
 end;
begin
 if (Dictionary<>nil) then Exit;
 Dictionary:=NewHashList(false,HashList_DefaultHasher);
 Dictionary.Master:=@Dictionary;
 Dictionary.OwnsObjects:=false;
 /////////////////////////////////////////////
 // Dictionary for fast strings identification
 /////////////////////////////////////////////
 AddSid( 'AppName'             , sid_AppName);
 AddSid( 'ExeName'             , sid_ExeName);
 AddSid( 'CmdLine'             , sid_CmdLine);
 AddSid( 'CmdArgs'             , sid_CmdArgs);
 AddSid( 'HomeDir'             , sid_HomeDir);
 AddSid( 'Encrypt'             , sid_Encrypt);
 AddSid( 'Account'             , sid_Account);
 AddSid( 'Display'             , sid_Display);
 AddSid( 'ConsoleMode'         , sid_ConsoleMode);
 AddSid( 'Options'             , sid_Options);
 AddSid( 'TxPipeSize'          , sid_TxPipeSize);
 AddSid( 'StdInPipeSize'       , sid_StdInPipeSize);
 AddSid( 'StdInpPipeSize'      , sid_StdInpPipeSize);
 AddSid( 'RxPipeSize'          , sid_RxPipeSize);
 AddSid( 'StdOutPipeSize'      , sid_StdOutPipeSize);
 AddSid( 'ExPipeSize'          , sid_ExPipeSize);
 AddSid( 'StdErrPipeSize'      , sid_StdErrPipeSize);
 AddSid( 'TxPipeLimit'         , sid_TxPipeLimit);
 AddSid( 'StdInPipeLimit'      , sid_StdInPipeLimit);
 AddSid( 'StdInpPipeLimit'     , sid_StdInpPipeLimit);
 AddSid( 'RxPipeLimit'         , sid_RxPipeLimit);
 AddSid( 'StdOutPipeLimit'     , sid_StdOutPipeLimit);
 AddSid( 'ExPipeLimit'         , sid_ExPipeLimit);
 AddSid( 'StdErrPipeLimit'     , sid_StdErrPipeLimit);
 AddSid( 'TxPriority'          , sid_TxPriority);
 AddSid( 'StdInPriority'       , sid_StdInPriority);
 AddSid( 'StdInpPriority'      , sid_StdInpPriority);
 AddSid( 'RxPriority'          , sid_RxPriority);
 AddSid( 'StdOutPriority'      , sid_StdOutPriority);
 AddSid( 'ExPriority'          , sid_ExPriority);
 AddSid( 'StdErrPriority'      , sid_StdErrPriority);
 AddSid( 'ThreadPriority'      , sid_ThreadPriority);
 AddSid( 'ProcessPriority'     , sid_ProcessPriority);
 AddSid( 'Env'                 , sid_Env);
 AddSid( 'Environ'             , sid_Environ);
 AddSid( 'Environment'         , sid_Environment);
 AddSid( 'Charset'             , sid_Charset);
 AddSid( 'Encoding'            , sid_Encoding);
 AddSid( 'CodePage'            , sid_CodePage);
 AddSid( 'TxLost'              , sid_TxLost);
 AddSid( 'RxLost'              , sid_RxLost);
 AddSid( 'ExLost'              , sid_ExLost);
 AddSid( 'TxTotal'             , sid_TxTotal);
 AddSid( 'RxTotal'             , sid_RxTotal);
 AddSid( 'ExTotal'             , sid_ExTotal);
 AddSid( 'TxSync'              , sid_TxSync);
 AddSid( 'StdInSync'           , sid_StdInSync);
 AddSid( 'StdInpSync'          , sid_StdInpSync);
 AddSid( 'RxSync'              , sid_RxSync);
 AddSid( 'StdOutSync'          , sid_StdOutSync);
 AddSid( 'ExSync'              , sid_ExSync);
 AddSid( 'StdErrSync'          , sid_StdErrSync);
 AddSid( 'RunTimeout'          , sid_RunTimeout);
 AddSid( 'SyncTimeout'         , sid_SyncTimeout);
 AddSid( 'SendTimeout'         , sid_SendTimeout);
 AddSid( 'Pid'                 , sid_Pid);
 AddSid( 'Tid'                 , sid_Tid);
 AddSid( 'Running'             , sid_Running);
 AddSid( 'ExitCode'            , sid_ExitCode);
 AddSid( 'ExitStatus'          , sid_ExitStatus);
 AddSid( 'TxSize'              , sid_TxSize);
 AddSid( 'RxSize'              , sid_RxSize);
 AddSid( 'ExSize'              , sid_ExSize);
 AddSid( 'TxLimit'             , sid_TxLimit);
 AddSid( 'RxLimit'             , sid_RxLimit);
 AddSid( 'ExLimit'             , sid_ExLimit);
 AddSid( 'ExCount'             , sid_ExCount);
 AddSid( 'RxCount'             , sid_RxCount);
 AddSid( 'TxCount'             , sid_TxCount);
 AddSid( 'TxSpace'             , sid_TxSpace);
 AddSid( 'RxSpace'             , sid_RxSpace);
 AddSid( 'ExSpace'             , sid_ExSpace);
 AddSid( 'TxSend'              , sid_TxSend);
 AddSid( 'RxRecv'              , sid_RxRecv);
 AddSid( 'ExRecv'              , sid_ExRecv);
 AddSid( '*'                   , sid_Asterisk);
 AddSid( '?'                   , sid_Question);
end;

function Identify(const key:LongString):TStringIdentifier;
var sid:Integer;
begin
 if (Dictionary=nil) then InitDictionary;
 sid:=Dictionary.KeyedLinks[key];
 if (sid>=Ord(Low(TStringIdentifier))) and (sid<=Ord(High(TStringIdentifier)))
 then Result:=TStringIdentifier(sid)
 else Result:=sid_Unknown;
end;

const
 sid_Ctrl_Hidden   = [sid_TxSend,sid_RxRecv,sid_ExRecv,sid_Encrypt,
                         sid_Env,sid_Environ,sid_Environment];
 sid_Ctrl_Readable = [Succ(sid_Unknown)..Pred(sid_Asterisk)]-sid_Ctrl_Hidden;
 sid_Ctrl_Writable = [sid_Pid..Pred(sid_Asterisk)]-sid_Ctrl_Hidden;

const // DebugLog channels.
 dlc_TaskRun  : Integer = 0; // On Task.Run
 dlc_TaskKill : Integer = 0; // On Task.Terminate

 ////////////////////////
 // TTask implementation.
 ////////////////////////

constructor TTask.Create;
begin
 inherited Create;
 Exceptions:=false;
 myProcess:=TProcess.Create(nil);
 myCodePage:=CP_NONE; myTid:=0;
 with myAccount do begin
  Key:='';
  User:='';
  Domain:='';
  Password:='';
 end;
 with myStdInp do begin
  Fifo:=nil;
  PipeSize:=0;
  PipeLimit:=0;
  Polling:=nil;
  Priority:=Integer(tpNormal);
 end;
 with myStdOut do begin
  Fifo:=nil;
  PipeSize:=0;
  PipeLimit:=0;
  Polling:=nil;
  Priority:=Integer(tpNormal);
 end;
 with myStdErr do begin
  Fifo:=nil;
  PipeSize:=0;
  PipeLimit:=0;
  Polling:=nil;
  Priority:=Integer(tpNormal);
 end;
 Display:=DefTaskDisplay;
 myOptions:=DefTaskOptions;
 PollPeriod:=DefTaskPollPeriod;
 RunTimeout:=DefTaskRunTimeout;
 SyncTimeout:=DefTaskSyncTimeout;
 SendTimeout:=DefTaskSendTimeout;
 StdInpPipeLimit:=DefTaskPipeLimit;
 StdOutPipeLimit:=DefTaskPipeLimit;
 StdErrPipeLimit:=DefTaskPipeLimit;
 myThreadPriority:=Integer(tpNormal);
 myProcessPriority:=ProcessPriorityToLevel(ppNormal);
end;

function task_unlink(tid:Integer):TTask; forward;

destructor  TTask.Destroy;
begin
 Detach;
 Burn(15);
 FreeAndNil(myProcess);
 inherited Destroy;
end;

procedure TTask.AfterConstruction;
begin
 inherited AfterConstruction;
 FullTaskList.Add(Self);
end;

procedure TTask.BeforeDestruction;
begin
 task_unlink(Tid);
 FullTaskList.Remove(Self);
 inherited BeforeDestruction;
end;

function TTask.CheckOk:Boolean;
begin
 Result:=Assigned(myProcess);
end;

function TTask.GetPid:TPid;
begin
 Result:=0;
 if Assigned(Self) then
 if Assigned(myProcess) then
 Result:=myProcess.ProcessID;
end;

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

procedure TTask.SetTid(aTid:Integer);
begin
 if Assigned(Self) then myTid:=aTid;
end;

function TTask.GetProcess:TProcess;
begin
 if Assigned(Self)
 then Result:=myProcess
 else Result:=nil;
end;

function TTask.CanEdit:Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 if Assigned(myProcess) then
 Result:=(myProcess.ProcessID=0);
end;

function  TTask.GetAppName:LongString;
begin
 Result:='';
 if Assigned(Self) then
 if Assigned(myProcess) then
 Result:=myProcess.Executable;
end;

procedure TTask.SetAppName(aAppName:LongString);
begin
 if Assigned(Self) then
 if Assigned(myProcess) then
 if CanEdit then myProcess.Executable:=Trim(aAppName);
end;

function TTask.GetExeName:LongString;
begin
 Result:='';
 if Assigned(Self) then
 if Assigned(myProcess) then
 Result:=myProcess.Executable;
end;

procedure TTask.SetExeName(aExeName:LongString);
begin
 if Assigned(Self) then
 if Assigned(myProcess) then
 if CanEdit then myProcess.Executable:=Trim(aExeName);
end;

function  TTask.GetCmdLine:LongString;
var i:Integer;
begin
 Result:='';
 if Assigned(Self) then
 if Assigned(myProcess) then
 try
  Lock;
  try
   Result:=AnsiQuotedIfNeed(myProcess.Executable);
   for i:=0 to myProcess.Parameters.Count-1 do
   Result:=Result+' '+AnsiQuotedIfNeed(myProcess.Parameters[i]);
   Result:=Trim(Result);
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E,'GetCmdLine');
 end;
end;

procedure TTask.SetCmdLine(aCmdLine:LongString);
var par:LongString;
begin
 if Assigned(Self) then
 if Assigned(myProcess) then
 try
  Lock;
  try
   if CanEdit then begin
    myProcess.Parameters.Clear;
    while IsNonEmptyStr(aCmdLine) do begin
     par:=ExtractFirstParam(aCmdLine);
     if IsEmptyStr(myProcess.Executable)
     then myProcess.Executable:=Trim(par)
     else myProcess.Parameters.Add(par);
     aCmdLine:=SkipFirstParam(aCmdLine);
    end;
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E,'SetCmdLine');
 end;
end;

function  TTask.GetCmdArgs:LongString;
var i:Integer;
begin
 Result:='';
 if Assigned(Self) then
 if Assigned(myProcess) then
 try
  Lock;
  try
   for i:=0 to myProcess.Parameters.Count-1 do
   Result:=Result+' '+AnsiQuotedIfNeed(myProcess.Parameters[i]);
   Result:=Trim(Result);
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E,'GetCmdArgs');
 end;
end;

procedure TTask.SetCmdArgs(aCmdArgs:LongString);
var par:LongString;
begin
 if Assigned(Self) then
 if Assigned(myProcess) then
 try
  Lock;
  try
   if CanEdit then begin
    myProcess.Parameters.Clear;
    while IsNonEmptyStr(aCmdArgs) do begin
     par:=ExtractFirstParam(aCmdArgs);
     myProcess.Parameters.Add(par);
     aCmdArgs:=SkipFirstParam(aCmdArgs);
    end;
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E,'SetCmdArgs');
 end;
end;

function  TTask.GetHomeDir:LongString;
begin
 Result:='';
 if Assigned(Self) then
 if Assigned(myProcess) then
 Result:=myProcess.CurrentDirectory;
end;

procedure TTask.SetHomeDir(aHomeDir:LongString);
begin
 if Assigned(Self) then
 if Assigned(myProcess) then
 if CanEdit then myProcess.CurrentDirectory:=Trim(aHomeDir);
end;

function  TTask.GetAccount:LongString;
begin
 if Assigned(Self)
 then Result:=myAccount.Key
 else Result:='';
end;

procedure TTask.SetAccount(aAccount:LongString);
begin
 if Assigned(Self) and CanEdit then begin
  myAccount.Key:=Trim(aAccount);
  Burn;
 end;
end;

function  TTask.GetCodePage:Integer;
begin
 if Assigned(Self)
 then Result:=LockedGet(myCodePage)
 else Result:=0;
end;

procedure TTask.SetCodePage(aCodePage:Integer);
begin
 if Assigned(Self) then
 if CanEdit then LockedSet(myCodePage,aCodePage);
end;

function TTask.NeedEncoding:Boolean;
var cp:Integer;
begin
 if Assigned(Self) then cp:=LockedGet(myCodePage) else cp:=0;
 Result:=(cp<>0) and (cp<>CP_NONE) and (cp<>DefaultSystemCodePage);
end;

function TTask.StdInpSync(aTimeOut:Integer; aNum:Integer=1):Int64;
begin
 if Assigned(Self)
 then Result:=myStdInp.Polling.SyncLoop(aTimeOut,aNum)
 else Result:=0;
end;

function TTask.StdOutSync(aTimeOut:Integer; aNum:Integer=1):Int64;
begin
 if Assigned(Self)
 then Result:=myStdOut.Polling.SyncLoop(aTimeOut,aNum)
 else Result:=0;
end;

function TTask.StdErrSync(aTimeOut:Integer; aNum:Integer=1):Int64;
begin
 if Assigned(Self)
 then Result:=myStdErr.Polling.SyncLoop(aTimeOut,aNum)
 else Result:=0;
end;

function  TTask.GetEnvironment:LongString;
begin
 Result:='';
 if Assigned(Self) then
 if Assigned(myProcess) then
 try
  Lock;
  try
   Result:=myProcess.Environment.Text;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E,'GetEnvironment');
 end;
end;

procedure TTask.SetEnvironment(aEnvironment:LongString);
begin
 if Assigned(Self) then
 if Assigned(myProcess) then
 try
  Lock;
  try
   if CanEdit then myProcess.Environment.Text:=ValidateEol(aEnvironment);
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E,'SetEnvironment');
 end;
end;

function  TTask.GetStdInpPipeSize:Integer;
begin
 if Assigned(Self)
 then Result:=LockedGet(myStdInp.PipeSize)
 else Result:=0;
end;

procedure TTask.SetStdInpPipeSize(aPipeSize:Integer);
begin
 if Assigned(Self) then
 if Assigned(myProcess) then
 try
  Lock;
  try
   if CanEdit then
   if (aPipeSize>0) then begin
    aPipeSize:=AdjustBufferSize(aPipeSize,KiloByte);
    myProcess.Options:=myProcess.Options+[poUsePipes];
    myProcess.PipeBufferSize:=Max(myProcess.PipeBufferSize,aPipeSize);
    LockedSet(myStdInp.PipeSize,aPipeSize);
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E,'SetStdInpPipeSize');
 end;
end;

function  TTask.GetStdInpPipeLimit:Integer;
begin
 if Assigned(Self)
 then Result:=LockedGet(myStdInp.PipeLimit)
 else Result:=0;
end;

procedure TTask.SetStdInpPipeLimit(aPipeLimit:Integer);
begin
 if Assigned(Self) then begin
  if CanEdit and (aPipeLimit>0) then begin
   aPipeLimit:=EnsureRange(aPipeLimit,MinTaskPipeLimit,MaxTaskPipeLimit);
   LockedSet(myStdInp.PipeLimit,aPipeLimit);
   myStdInp.Fifo.GrowLimit:=aPipeLimit;
   myStdInp.Fifo.GrowFactor:=2;
  end;
 end;
end;

function  TTask.GetStdInpPipeFifoCount:Integer;
begin
 if Assigned(Self)
 then Result:=myStdInp.Fifo.Count
 else Result:=0;
end;

function  TTask.GetStdInpPipeFifoSpace:Integer;
begin
 if Assigned(Self)
 then Result:=myStdInp.Fifo.Space
 else Result:=0;
end;

function  TTask.StdInpPipeFifoPutText(const aText:LongString; WakeUp:Boolean=true):Boolean;
begin
 Result:=false;
 if Assigned(Self) then begin
  Result:=myStdInp.Fifo.PutText(aText);
  if Result and WakeUp then myStdInp.Polling.Awake;
 end;
end;

procedure TTask.StdInpPipeFifoClear;
begin
 if Assigned(Self) then myStdInp.Fifo.Clear;
end;

function  TTask.GetStdInpPriority:TThreadPriority;
begin
 if Assigned(Self)
 then Result:=TThreadPriority(LockedGet(myStdInp.Priority))
 else Result:=tpNormal;
end;

procedure  TTask.SetStdInpPriority(aPriority:TThreadPriority);
begin
 if Assigned(Self) then begin
  myStdInp.Polling.Priority:=aPriority;
  LockedSet(myStdInp.Priority,Integer(aPriority));
 end;
end;

function  TTask.GetStdOutPipeSize:Integer;
begin
 if Assigned(Self)
 then Result:=LockedGet(myStdOut.PipeSize)
 else Result:=0;
end;

procedure TTask.SetStdOutPipeSize(aPipeSize:Integer);
begin
 if Assigned(Self) then
 if Assigned(myProcess) then
 try
  Lock;
  try
   if CanEdit then
   if (aPipeSize>0) then begin
    aPipeSize:=AdjustBufferSize(aPipeSize,KiloByte);
    myProcess.Options:=myProcess.Options+[poUsePipes];
    myProcess.PipeBufferSize:=Max(myProcess.PipeBufferSize,aPipeSize);
    LockedSet(myStdOut.PipeSize,aPipeSize);
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E,'SetStdOutPipeSize');
 end;
end;

function  TTask.GetStdOutPipeLimit:Integer;
begin
 if Assigned(Self)
 then Result:=LockedGet(myStdOut.PipeLimit)
 else Result:=0;
end;

procedure TTask.SetStdOutPipeLimit(aPipeLimit:Integer);
begin
 if Assigned(Self) then begin
  if CanEdit and (aPipeLimit>0) then begin
   aPipeLimit:=EnsureRange(aPipeLimit,MinTaskPipeLimit,MaxTaskPipeLimit);
   LockedSet(myStdOut.PipeLimit,aPipeLimit);
   myStdOut.Fifo.GrowLimit:=aPipeLimit;
   myStdOut.Fifo.GrowFactor:=2;
  end;
 end;
end;

function  TTask.GetStdOutPipeFifoCount:Integer;
begin
 if Assigned(Self)
 then Result:=myStdOut.Fifo.Count
 else Result:=0;
end;

function  TTask.GetStdOutPipeFifoSpace:Integer;
begin
 if Assigned(Self)
 then Result:=myStdOut.Fifo.Space
 else Result:=0;
end;

function  TTask.StdOutPipeFifoGetText(aSize:Integer):LongString;
begin
 if Assigned(Self)
 then Result:=myStdOut.Fifo.GetText(aSize)
 else Result:='';
end;

procedure TTask.StdOutPipeFifoClear;
begin
 if Assigned(Self) then myStdOut.Fifo.Clear;
end;

function  TTask.GetStdOutPriority:TThreadPriority;
begin
 if Assigned(Self)
 then Result:=TThreadPriority(LockedGet(myStdOut.Priority))
 else Result:=tpNormal;
end;

procedure  TTask.SetStdOutPriority(aPriority:TThreadPriority);
begin
 if Assigned(Self) then begin
  myStdOut.Polling.Priority:=aPriority;
  LockedSet(myStdOut.Priority,Integer(aPriority));
 end;
end;

function  TTask.GetStdErrPipeSize:Integer;
begin
 if Assigned(Self)
 then Result:=LockedGet(myStdErr.PipeSize)
 else Result:=0;
end;

procedure TTask.SetStdErrPipeSize(aPipeSize:Integer);
begin
 if Assigned(Self) then
 if Assigned(myProcess) then
 try
  Lock;
  try
   if CanEdit then
   if (aPipeSize>0) then begin
    aPipeSize:=AdjustBufferSize(aPipeSize,KiloByte);
    myProcess.Options:=myProcess.Options+[poUsePipes];
    myProcess.PipeBufferSize:=Max(myProcess.PipeBufferSize,aPipeSize);
    LockedSet(myStdErr.PipeSize,aPipeSize);
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E,'SetStdErrPipeSize');
 end;
end;

function  TTask.GetStdErrPipeLimit:Integer;
begin
 if Assigned(Self)
 then Result:=LockedGet(myStdErr.PipeLimit)
 else Result:=0;
end;

procedure TTask.SetStdErrPipeLimit(aPipeLimit:Integer);
begin
 if Assigned(Self) then begin
  if CanEdit and (aPipeLimit>0) then begin
   aPipeLimit:=EnsureRange(aPipeLimit,MinTaskPipeLimit,MaxTaskPipeLimit);
   LockedSet(myStdErr.PipeLimit,aPipeLimit);
   myStdErr.Fifo.GrowLimit:=aPipeLimit;
   myStdErr.Fifo.GrowFactor:=2;
  end;
 end;
end;

function  TTask.GetStdErrPipeFifoCount:Integer;
begin
 if Assigned(Self)
 then Result:=myStdErr.Fifo.Count
 else Result:=0;
end;

function  TTask.GetStdErrPipeFifoSpace:Integer;
begin
 if Assigned(Self)
 then Result:=myStdErr.Fifo.Space
 else Result:=0;
end;

function  TTask.StdErrPipeFifoGetText(aSize:Integer):LongString;
begin
 if Assigned(Self)
 then Result:=myStdErr.Fifo.GetText(aSize)
 else Result:='';
end;

procedure TTask.StdErrPipeFifoClear;
begin
 if Assigned(Self) then myStdErr.Fifo.Clear;
end;

function  TTask.GetStdErrPriority:TThreadPriority;
begin
 if Assigned(Self)
 then Result:=TThreadPriority(LockedGet(myStdErr.Priority))
 else Result:=tpNormal;
end;

procedure  TTask.SetStdErrPriority(aPriority:TThreadPriority);
begin
 if Assigned(Self) then begin
  myStdErr.Polling.Priority:=aPriority;
  LockedSet(myStdErr.Priority,Integer(aPriority));
 end;
end;

function  TTask.GetDisplay:Integer;
begin
 Result:=0;
 if Assigned(Self) then
 if Assigned(myProcess) then
 case myProcess.ShowWindow of
  swoNone            : Result:=-1;
  swoHIDE            : Result:=SW_HIDE;
  swoMaximize        : Result:=SW_MAXIMIZE;
  swoMinimize        : Result:=SW_MINIMIZE;
  swoRestore         : Result:=SW_RESTORE;
  swoShow            : Result:=SW_SHOW;
  swoShowDefault     : Result:=SW_SHOWDEFAULT;
  swoShowMaximized   : Result:=SW_SHOWMAXIMIZED;
  swoShowMinimized   : Result:=SW_SHOWMINIMIZED;
  swoshowMinNOActive : Result:=SW_SHOWMINNOACTIVE;
  swoShowNA          : Result:=SW_SHOWNA;
  swoShowNoActivate  : Result:=SW_SHOWNOACTIVATE;
  swoShowNormal      : Result:=SW_SHOWNORMAL;
  else                 Result:=-1;
 end;
end;

procedure TTask.SetDisplay(aDisplay:Integer);
begin
 if Assigned(Self) then
 if Assigned(myProcess) then
 try
  Lock;
  try
   if CanEdit then begin
    case aDisplay of
     SW_HIDE            : myProcess.ShowWindow:=swoHIDE;
     SW_MAXIMIZE        : myProcess.ShowWindow:=swoMaximize;
     SW_MINIMIZE        : myProcess.ShowWindow:=swoMinimize;
     SW_RESTORE         : myProcess.ShowWindow:=swoRestore;
     SW_SHOW            : myProcess.ShowWindow:=swoShow;
     SW_SHOWDEFAULT     : myProcess.ShowWindow:=swoShowDefault;
 //  SW_SHOWMAXIMIZED   : myProcess.ShowWindow:=swoShowMaximized;
     SW_SHOWMINIMIZED   : myProcess.ShowWindow:=swoShowMinimized;
     SW_SHOWMINNOACTIVE : myProcess.ShowWindow:=swoshowMinNOActive;
     SW_SHOWNA          : myProcess.ShowWindow:=swoShowNA;
     SW_SHOWNOACTIVATE  : myProcess.ShowWindow:=swoShowNoActivate;
     SW_SHOWNORMAL      : myProcess.ShowWindow:=swoShowNormal;
     else                 myProcess.ShowWindow:=swoNone;
    end;
    if (myProcess.ShowWindow<>swoNone)
    then myProcess.StartupOptions:=myProcess.StartupOptions+[suoUseShowWindow];
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E,'SetDisplay');
 end;
end;

function  TTask.GetConsoleMode:Integer;
begin
 Result:=0;
 if Assigned(Self) then
 if Assigned(myProcess) then
 Result:=IfThen(poNewConsole in myProcess.Options,1,0);
end;

procedure TTask.SetConsoleMode(aConsoleMode:Integer);
begin
 if Assigned(Self) then
 if Assigned(myProcess) then
 try
  Lock;
  try
   if CanEdit then begin
    if (aConsoleMode<>0)
    then myProcess.Options:=myProcess.Options+[poNewConsole]
    else myProcess.Options:=myProcess.Options-[poNewConsole];
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E,'SetConsoleMode');
 end;
end;

function  TTask.GetOptions:Integer;
begin
 if Assigned(Self)
 then Result:=LockedGet(myOptions)
 else Result:=0;
end;

procedure TTask.SetOptions(aOptions:Integer);
begin
 if Assigned(Self) then
 if Assigned(myProcess) then
 if CanEdit then LockedSet(myOptions,aOptions);
end;

function  TTask.GetThreadPriority:TThreadPriority;
begin
 if Assigned(Self)
 then Result:=TThreadPriority(LockedGet(myThreadPriority))
 else Result:=tpNormal;
end;

procedure  TTask.SetThreadPriority(aPriority:TThreadPriority);
begin
 if Assigned(Self) then
 if Assigned(myProcess) then
 try
  // Unix: process = thread priority.
  if IsUnix then aPriority:=tpNormal;
  LockedSet(myThreadPriority,Integer(aPriority));
  {$IFDEF WINDOWS}
  if (myProcess.ThreadID<>0) then
  case aPriority of
   tpIdle         : windows.SetThreadPriority(myProcess.ThreadID,THREAD_PRIORITY_IDLE);
   tpLowest       : windows.SetThreadPriority(myProcess.ThreadID,THREAD_PRIORITY_LOWEST);
   tpLower        : windows.SetThreadPriority(myProcess.ThreadID,THREAD_PRIORITY_BELOW_NORMAL);
   tpNormal       : windows.SetThreadPriority(myProcess.ThreadID,THREAD_PRIORITY_NORMAL);
   tpHigher       : windows.SetThreadPriority(myProcess.ThreadID,THREAD_PRIORITY_ABOVE_NORMAL);
   tpHighest      : windows.SetThreadPriority(myProcess.ThreadID,THREAD_PRIORITY_HIGHEST);
   tpTimeCritical : windows.SetThreadPriority(myProcess.ThreadID,THREAD_PRIORITY_TIME_CRITICAL);
  end;
  {$ENDIF ~WINDOWS}
 except
  on E:Exception do ErrorFound(E,'SetThreadPriority');
 end;
end;

function  TTask.GetProcessPriority:Integer;
begin
 if Assigned(Self)
 then Result:=LockedGet(myProcessPriority)
 else Result:=ProcessPriorityToLevel(ppNormal);
end;

procedure  TTask.SetProcessPriority(aPriority:Integer);
var pClass:DWORD; pHandle:TLCLHandle; pLevel:Integer; pp:TProcessPriority;
begin
 if Assigned(Self) then
 if Assigned(myProcess) then
 try
  // aPriority = Priority Level [1..31].
  pp:=LevelToProcessPriority(aPriority);
  pLevel:=ProcessPriorityToLevel(pp);
  pClass:=ProcessPriorityToClass(pp);
  LockedSet(myProcessPriority,pLevel);
  if IsUnix then pHandle:=myProcess.ProcessID else
  if IsWindows then pHandle:=myProcess.ProcessHandle else pHandle:=0;
  if (pHandle<>0) and (pHandle<>TLCLHandle(INVALID_HANDLE_VALUE))
  then SetPriorityClass(pHandle,pClass);
 except
  on E:Exception do ErrorFound(E,'SetProcessPriority');
 end;
end;

function TTask.GetPollPeriod:Integer;
begin
 if Assigned(Self)
 then Result:=LockedGet(myPollPeriod)
 else Result:=0;
end;

procedure TTask.SetPollPeriod(aPeriod:Integer);
begin
 if Assigned(Self) then begin
  aPeriod:=EnsureRange(aPeriod,MinTaskPollPeriod,MaxTaskPollPeriod);
  LockedSet(myPollPeriod,aPeriod);
 end;
end;

function TTask.GetRunTimeout:Integer;
begin
 if Assigned(Self)
 then Result:=LockedGet(myRunTimeout)
 else Result:=0;
end;

procedure TTask.SetRunTimeout(aTimeout:Integer);
begin
 if Assigned(Self) and CanEdit then begin
  aTimeout:=EnsureRange(aTimeout,MinTaskRunTimeout,MaxTaskRunTimeout);
  LockedSet(myRunTimeout,aTimeout);
 end;
end;

function TTask.GetSyncTimeout:Integer;
begin
 if Assigned(Self)
 then Result:=LockedGet(mySyncTimeout)
 else Result:=0;
end;

procedure TTask.SetSyncTimeout(aTimeout:Integer);
begin
 if Assigned(Self) and CanEdit then begin
  aTimeout:=EnsureRange(aTimeout,MinTaskSyncTimeout,MaxTaskSyncTimeout);
  LockedSet(mySyncTimeout,aTimeout);
 end;
end;

function TTask.GetSendTimeout:Integer;
begin
 if Assigned(Self)
 then Result:=LockedGet(mySendTimeout)
 else Result:=0;
end;

procedure TTask.SetSendTimeout(aTimeout:Integer);
begin
 if Assigned(Self) and CanEdit then begin
  aTimeout:=EnsureRange(aTimeout,MinTaskSendTimeout,MaxTaskSendTimeout);
  LockedSet(mySendTimeout,aTimeout);
 end;
end;

function TTask.GetExitCode:Integer;
begin
 Result:=0;
 if Assigned(Self) then
 if Assigned(myProcess) then
 Result:=myProcess.ExitCode;
end;

function TTask.GetExitStatus:Integer;
begin
 Result:=0;
 if Assigned(Self) then
 if Assigned(myProcess) then
 Result:=myProcess.ExitStatus;
end;

function TTask.GetMainWnd:hWnd;
begin
 Result:=0;
 if Assigned(Self) then
 if Assigned(myProcess) then
 if myProcess.Running then begin
  {$IFDEF WINDOWS}
  Result:=GetThreadMainWindowHandle(myProcess.ThreadId);
  {$ENDIF ~WINDOWS}
  {$IFDEF UNIX}
  Result:=wmctrl.FindWindow(Pid,'','');
  {$ENDIF ~UNIX}
 end;
end;

function TTask.GetConsoleWnd:hWnd;
begin
 Result:=0;
 if Assigned(Self) then
 if Assigned(myProcess) then
 if myProcess.Running then begin
  {$IFDEF WINDOWS}
  Result:=FindWindowByPidAndClassName(myProcess.ProcessID,'ConsoleWindowClass');
  {$ENDIF ~WINDOWS}
 end;
end;

function TTask.Encrypt(const UserCrlfDomainCrlfPassword:LongString):LongString;
var t:Int64; IV,Temp,FName:LongString;
begin
 Result:='';
 if Assigned(Self) then
 if Assigned(myProcess) then
 if Length(UserCrlfDomainCrlfPassword)>0 then
 try
  FName:=ExeName;
  if IsEmptyStr(FName)
  then RAISE ETask.Create('TTask.Run: executable file is not specified.');
  if not HasExtension(FName)
  then RAISE ETask.Create('TTask.Run: executable file must include extension.');
  if IsRelativePath(FName)
  then RAISE ETask.Create('TTask.Run: executable file must include full path.');
  if not FileExists(FName)
  then RAISE ETask.Create('TTask.Run: executable file not found: '+FName);
  t:=IntMSecNow;
  IV:=Dump(Int64(t),SizeOf(Int64));
  Temp:=LeftPad(UserCrlfDomainCrlfPassword,40);
  Temp:=EncryptText(Temp,GetFileSign(FName),IV,FSign_EK,FSign_EM,df_Bin,df_Bin);
  if Length(Temp)>0
  then Result:=StringReplace(Mime_Encode(IV+Temp),'=','',[rfReplaceAll]);
 except
  on E:Exception do ErrorFound(E,'Encrypt');
 end;
end;

function TTask.Decrypt(aBuff:PChar=nil; aSize:Integer=0):Boolean;
var T:TText; IV,Temp,FName:LongString;
begin
 Result:=false;
 if Assigned(Self) then
 if Assigned(myProcess) then
 try
  T:=NewText;
  Lock;
  try
   Burn;
   FName:=ExeName;
   if IsEmptyStr(FName)
   then RAISE ETask.Create('TTask.Run: executable file is not specified.');
   if not HasExtension(FName)
   then RAISE ETask.Create('TTask.Run: executable file must include extension.');
   if IsRelativePath(FName)
   then RAISE ETask.Create('TTask.Run: executable file must include full path.');
   if not FileExists(FName)
   then RAISE ETask.Create('TTask.Run: executable file not found: '+FName);
   Temp:=Mime_Decode(myAccount.Key);
   if Length(Temp)>SizeOf(Int64) then begin
    IV:=Copy(Temp,1,SizeOf(Int64));
    Delete(Temp,1,SizeOf(Int64));
    T.Text:=DecryptText(Temp,GetFileSign(FName),IV,FSign_EK,FSign_EM,df_Bin,df_Bin);
    if T.Count>2 then begin
     myAccount.User:=TrimLeadChars(T[0],[' ']);
     myAccount.Domain:=T[1];
     myAccount.Password:=T[2];
     // Copy account with simple (shuttle) protection
     // Uses TaskShuttleDecode to decode account data
     if Assigned(aBuff) and (aSize>1) then begin
      Temp:=TaskShuttleEncode(myAccount.User+CRLF+myAccount.Domain+CRLF+myAccount.Password);
      StrPLCopy(aBuff,Temp,aSize-1);
     end;
    end;
   end;
   Result:=IsNonEmptyStr(myAccount.User);
  finally
   Unlock;
   Kill(T);
  end;
 except
  on E:Exception do ErrorFound(E,'Dectrypt');
 end;
end;

procedure BurnStr(var S:PureString);
begin
 if (S<>'') and TaskGuardParanoid
 then SafeFillChar(S[1],Length(S),0);
 S:='';
end;

procedure TTask.Burn(Who:Integer=7);
begin
 if Assigned(Self) then
 if Assigned(myProcess) then
 try
  if HasFlags(Who,1) then BurnStr(myAccount.User);
  if HasFlags(Who,2) then BurnStr(myAccount.Domain);
  if HasFlags(Who,4) then BurnStr(myAccount.Password);
  if HasFlags(Who,8) then BurnStr(myAccount.Key);
 except
  on E:Exception do ErrorFound(E,'Burn');
 end;
end;

procedure TTask.ErrorFound(E:Exception; const Note:LongString);
begin
 if Exceptions then begin
  if E is Exception
  then RAISE ETask.Create(E.Message)
  else RAISE ETask.Create(Note);
 end else ErrorReport(E,Note);
end;

function TTask.Running(aTimeOut:Integer=0):Boolean;
var Deadline:QWord;
begin
 Result:=false;
 if Assigned(Self) then
 if Assigned(myProcess) then begin
  Result:=myProcess.Running;
  if Result and (aTimeOut>0) then begin
   Deadline:=GetTickCount64+aTimeOut;
   while Result and (GetTickCount64<Deadline) do begin
    Sleep(PollPeriod); Result:=myProcess.Running;
   end;
  end;
 end;
end;

function TTask.Send(const data:LongString):Integer;
begin
 if Assigned(Self)
 then Result:=Ord(StdInpPipeFifoPutText(data,true))*Length(data)
 else Result:=0;
end;

function TTask.TxSend(const data:LongString):Integer;
begin
 Result:=Send(data);
end;

function TTask.Recv(MaxLen:Integer):LongString;
begin
 Result:='';
 if Assigned(Self) then
 if Assigned(myProcess) then begin
  if (myProcess.ProcessID<>0) and not myProcess.Running
  then StdOutSync(SyncTimeout,2); // Syncronize on stop
  Result:=StdOutPipeFifoGetText(MaxLen);
 end;
end;

function TTask.RxRecv(MaxLen:Integer):LongString;
begin
 Result:=Recv(MaxLen);
end;

function TTask.ExRecv(MaxLen:Integer):LongString;
begin
 Result:='';
 if Assigned(Self) then
 if Assigned(myProcess) then begin
  if (myProcess.ProcessID<>0) and not myProcess.Running
  then StdErrSync(SyncTimeout,2); // Syncronize on stop
  Result:=StdErrPipeFifoGetText(MaxLen);
 end;
end;

function TTask.Terminate(aHow:Integer=DefTaskTermHow;aExitCode:Integer=0;aTimeOut:Integer=0):Boolean;
var hWin:hWnd;
begin
 Result:=false;
 if Assigned(Self) then
 if Assigned(myProcess) then
 try
  if (Pid<>0) then begin
   if Running then begin
    if DebugLogEnabled(dlc_TaskKill) then begin
     DebugLog(dlc_TaskKill,Format('PID %d Mode %d Code %d',[Pid,aHow,aExitCode]));
    end;
    case aHow of
     0:   Result:=myProcess.Terminate(aExitCode);
     1:   begin
           hWin:=MainWnd;
           if (hWin=0) then hWin:=ConsoleWnd;
           if (hWin<>0) and wmctrl.IsWindow(hWin) then begin
            if not wmctrl.IsHidden(hWin) then wmctrl.ActivateWindow(hWin,False);
            Result:=wmctrl.KillWindow(hWin,SIGINT,aTimeOut);
           end;
          end;
     2:   begin
           hWin:=MainWnd;
           if (hWin=0) then hWin:=ConsoleWnd;
           if (hWin<>0) and wmctrl.IsWindow(hWin) then begin
            if not wmctrl.IsHidden(hWin) then wmctrl.ActivateWindow(hWin,False);
            Result:=wmctrl.KillWindow(hWin,SIGQUIT,aTimeOut);
           end;
          end;
     3:   Result:=(KillProcessTree(myProcess.ProcessId,aExitCode)>0);
     else Result:=myProcess.Terminate(aExitCode);
    end;
   end else Result:=true;
  end;
 except
  on E:Exception do ErrorFound(E,'Terminate');
 end;
end;

procedure TTask.Detach(aHow:Integer=DefTaskTermHow;aExitCode:Integer=0;aTimeOut:Integer=0);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   Burn;
   if HasFlags(myOptions,poTermOnDetach)
   or (HasFlags(myOptions,poTermStdInpPipeOnDetach) and (StdInpPipeSize>0))
   or (HasFlags(myOptions,poTermStdOutPipeOnDetach) and (StdOutPipeSize>0))
   or (HasFlags(myOptions,poTermStdErrPipeOnDetach) and (StdErrPipeSize>0))
   then if Running then Terminate(aHow,aExitCode,aTimeOut);
   if (Pid<>0) and Running then AddDetachedPid(Pid);
   with myStdInp do begin
    Polling.Enable(false);
    Kill(Polling);
    Kill(Fifo);
   end;
   with myStdOut do begin
    Polling.Enable(false);
    Kill(Polling);
    Kill(Fifo);
   end;
   with myStdErr do begin
    Polling.Enable(false);
    Kill(Polling);
    Kill(Fifo);
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E,'Detach');
 end;
end;

const
 CpToSys=+1; // Convert CodePage to DefaultSystemCodePage
 SysToCp=-1; // Convert DefaultSystemCodePage to CodePage

procedure TTask.ApplyEncoding(var Data:LongString; Direct:Integer);
begin
 if Assigned(Self) then
 if (Data<>'') and NeedEncoding then
 case Sign(Direct) of
  CpToSys: Data:=ConvertCP(Data,CodePage,DefaultSystemCodePage,CP_NONE);
  SysToCp: Data:=ConvertCP(Data,DefaultSystemCodePage,CodePage,CP_NONE);
 end;
end;

 // In UNIX non block I/O can return EAGAIN
 // to try complete I/O operation some later.
function CanTryDoitAgainLater:Boolean; inline;
begin
 {$IFDEF UNIX}
 Result:=(errno=ESysEAGAIN);
 {$ELSE}
 Result:=false;
 {$ENDIF}
end;

procedure FifoDataLost(Fifo:TFifo; Num:Integer);
begin
 Fifo.Lost:=Fifo.Lost+Num;
end;

procedure TTask.ReadStreamToFifo(Stream:TInputPipeStream; Fifo:TFifo;
                                 TextMode:Boolean);
var Num,Len:LongInt; Data,Buff:LongString;
begin
 if Assigned(Self) then
 if Assigned(myProcess) then
 try
  Data:='';
  if Assigned(Fifo) then
  if Assigned(Stream) then begin
   Num:=Stream.NumBytesAvailable;
   while (Num>0) do begin
    Buff:=StringBuffer(Num);
    Len:=Stream.Read(PChar(Buff)^,Length(Buff));
    if (Len<0) then begin
     // It should not happen but anyway…
     if CanTryDoitAgainLater then Break;
     FifoDataLost(Fifo,Num);
     Break;
    end;
    if (Len<Length(Buff)) then SetLength(Buff,Len);
    if (Buff='') then Break else Data:=Data+Buff;
    Num:=Stream.NumBytesAvailable;
   end;
   ApplyEncoding(Data,CpToSys);
   if (Data<>'') then Fifo.PutText(Data);
  end;
 except
  on E:Exception do BugReport(E,Self,'ReadStreamToFifo');
 end;
end;

function AdjustToLastEol(const Data:LongString; Num:Integer):Integer;
const EOLs=[ASCII_CR,ASCII_LF];
begin
 Result:=Num; if (Num>Length(Data)) then Exit(Length(Data));
 while (Num>0) do if (Data[Num] in EOLs) then Break else Dec(Num);
 if (Num>0) then Result:=Num;
end;

procedure TTask.WriteFifoToStream(Fifo:TFifo; Stream:TOutputPipeStream;
                                  TextMode,AtomicPipe:Boolean);
var Data:LongString; NonBlock,Partial,HasData,HasTime:Boolean;
var Num,Len:LongInt; Deadline:QWord;
begin
 if Assigned(Self) then
 if Assigned(myProcess) then
 try
  if Assigned(Fifo) then
  if Assigned(Stream) then begin
   // Get data from FIFO
   Data:=Fifo.GetText;
   ApplyEncoding(Data,SysToCp);
   // If has data, write it
   if (Data<>'') then begin
    NonBlock:=FileHasNonBlockFlag(Stream.Handle);
    Deadline:=High(Deadline); // Use deadline if possible
    if NonBlock then Deadline:=GetTickCount64+SendTimeout;
    while (Data<>'') do begin
     Num:=Length(Data);                              // Get data length to write
     if AtomicPipe and NonBlock                      // NonBlocking pipe can use
     then Num:=Min(Num,OS_PIPE_BUF);                 // atomic I/O - let's do it
     if TextMode and NonBlock                        // In text mode write till
     then Num:=AdjustToLastEol(Data,Num);            // EOL to send whole lines
     Partial:=(Num<Length(Data));                    // Partial write expected
     if Partial and (Deadline=High(Deadline))        // When uses partial write,
     then Deadline:=GetTickCount64+SendTimeout;      // deadline should be setup
     Len:=Stream.Write(PChar(Data)^,Num);            // Write data to stream
     case Sign(Len) of                               // Analyze result:
      0:  Break;                                     // Error: no data written
      +1: Delete(Data,1,Len);                        // Data written, erase it
      -1: if NonBlock and CanTryDoitAgainLater       // On NonBlock+EAGAIN you
          then Partial:=true                         // can try to do it later
          else Break;                                // otherwise it's error
     end;
     HasData:=(Data<>'');                            // Still has unwritten data
     if not HasData then Break;                      // No data to write - break
     HasTime:=(GetTickCount64<Deadline);             // Has time before deadline
     if HasData and Partial and HasTime              // If still has data & time
     then Sleep(PollPeriod)                          // then wait & try do later
     else Break;                                     // otherwise can break loop
    end;
    // If we still has unwritten data, it will be lost.
    if (Data<>'') then FifoDataLost(Fifo,Length(Data));
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'WriteFifoToStream');
 end;
end;

procedure TTask.ReadStdOutToFifo;
begin
 if Assigned(Self) then
 if Assigned(myProcess) then
 ReadStreamToFifo(myProcess.Output,myStdOut.Fifo,
                  HasFlags(Options,poAssumeStdOutTextMode));
end;

procedure TTask.ReadStdErrToFifo;
begin
 if Assigned(Self) then
 if Assigned(myProcess) then
 ReadStreamToFifo(myProcess.StdErr,myStdErr.Fifo,
                  HasFlags(Options,poAssumeStdErrTextMode));
end;

procedure TTask.WriteFifoToStdInp;
begin
 if Assigned(Self) then
 if Assigned(myProcess) then
 WriteFifoToStream(myStdInp.Fifo,myProcess.Input,
                   HasFlags(Options,poAssumeStdInpTextMode),
                   HasFlags(Options,poNonBlockingAtomicPipe));
end;

procedure TaskStdInpPoll(Polling:TPolling; var Terminate:Boolean);
var Obj:TObject;
begin
 Obj:=Polling.LinkObject;
 if (Obj is TTask) then TTask(Obj).WriteFifoToStdInp;
end;

procedure TaskStdOutPoll(Polling:TPolling; var Terminate:Boolean);
var Obj:TObject;
begin
 Obj:=Polling.LinkObject;
 if (Obj is TTask) then TTask(Obj).ReadStdOutToFifo;
end;

procedure TaskStdErrPoll(Polling:TPolling; var Terminate:Boolean);
var Obj:TObject;
begin
 Obj:=Polling.LinkObject;
 if (Obj is TTask) then TTask(Obj).ReadStdErrToFifo;
end;

function TTask.Run:Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 if Assigned(myProcess) then
 if (myProcess.ProcessID=0) then
 try
  Lock;
  try
   //
   // Close all previouse handles if one exists
   //
   Detach;
   //
   // Check arguments...
   //
   if IsEmptyStr(AppName+CmdLine)
   then RAISE ETask.Create('TTask.Run: command line is not specified.');
   //
   // Check Exe file name is valid...
   //
   if not IsValidExeFile(ExeName)
   then RAISE ETask.Create('TTask.Run: executable file is not valid.');
   //
   // Fill process startup information: show flags, pipes, environment, etc.
   //
   if (Display>=0)
   then myProcess.StartupOptions:=myProcess.StartupOptions+[suoUseShowWindow];
   if (StdInpPipeSize>0) or (StdOutPipeSize>0) or (StdErrPipeSize>0)
   then myProcess.Options:=myProcess.Options+[poUsePipes];
   if HasFlags(Options,poSwitchStdErrToStdOut) then
   if (StdErrPipeSize=0) and (StdOutPipeSize>0)
   then myProcess.Options:=myProcess.Options+[poStdErrToOutPut];
   if (StdInpPipeSize=0) and (StdOutPipeSize>0)
   then myProcess.Options:=myProcess.Options+[poPassInput];
   if IsUnix then
   if (myProcess.Environment.Count=0) then
   if HasFlags(Options,poInheritCurrEnviroment) then
   Environment:=ValidateEol(EnvironmentVariableList.Text);
   //
   // Create process with given parameters
   //
   if IsEmptyStr(myAccount.Key) then begin
    myProcess.Execute;
    if not Running
    then RAISE ETask.Create(Format('TTask.Run: %s',[SysErrorMessage(GetLastOsError)]));
   end else begin
    if not Decrypt
    then RAISE ETask.Create('TTask.Run: could not decrypt account.');
    myProcess.Execute;
    if not Running
    then RAISE ETask.Create(Format('TTask.Run: %s',[SysErrorMessage(GetLastOsError)]));
   end;
   //
   // Set process & thread priority if one started
   //
   if myProcess.ThreadID<>0 then SetThreadPriority(ThreadPriority);
   if myProcess.ProcessID<>0 then SetProcessPriority(ProcessPriority);
   //
   // Create I/O threads, if uses pipes
   //
   if (StdInpPipeSize>0) then begin
    // Apply NONBLOCK option if need
    if Assigned(myProcess.Input) then
    if HasFlags(Options,poNonBlockingStdInpPipe) then
    if IsUnix and not FileHasNonBlockFlag(myProcess.Input.Handle)
    then FileSetNonBlockFlag(myProcess.Input.Handle,true);
    // Create Fifo queue
    if not Assigned(myStdInp.Fifo) then begin
     myStdInp.Fifo:=NewFifo(StdInpPipeSize);
     myStdInp.Fifo.Master:=@myStdInp.Fifo;
    end;
    // Create Polling thread
    if not Assigned(myStdInp.Polling) then begin
     myStdInp.Polling:=NewPolling(TaskStdInpPoll,1000,tpNormal,false,Format('StdIn#%u',[Pid]));
     myStdInp.Polling.Master:=@myStdInp.Polling;
     myStdInp.Polling.LinkObject:=Self;
    end;
    // Apply Fifo & Polling settings
    myStdInp.Fifo.GrowFactor:=2;
    myStdInp.Fifo.Size:=StdInpPipeSize;
    myStdInp.Fifo.GrowLimit:=StdInpPipeLimit;
    myStdInp.Polling.Delay:=1000;
    myStdInp.Polling.Priority:=StdInpPriority;
    myStdInp.Polling.Awake;
    myStdInp.Polling.Enable(true,RunTimeout);
   end;
   if (StdOutPipeSize>0) then begin
    // Apply NONBLOCK option if need
    if Assigned(myProcess.Output) then
    if HasFlags(Options,poNonBlockingStdOutPipe) then
    if IsUnix and not FileHasNonBlockFlag(myProcess.Output.Handle)
    then FileSetNonBlockFlag(myProcess.Output.Handle,true);
    // Create Fifo queue
    if not Assigned(myStdOut.Fifo) then begin
     myStdOut.Fifo:=NewFifo(StdOutPipeSize);
     myStdOut.Fifo.Master:=@myStdOut.Fifo;
    end;
    // Create Polling thread
    if not Assigned(myStdOut.Polling) then begin
     myStdOut.Polling:=NewPolling(TaskStdOutPoll,1000,tpNormal,false,Format('StdOut#%u',[Pid]));
     myStdOut.Polling.Master:=@myStdOut.Polling;
     myStdOut.Polling.LinkObject:=Self;
    end;
    // Apply Fifo & Polling settings
    myStdOut.Fifo.GrowFactor:=2;
    myStdOut.Fifo.Size:=StdOutPipeSize;
    myStdOut.Fifo.GrowLimit:=StdOutPipeLimit;
    myStdOut.Polling.Delay:=PollPeriod;
    myStdOut.Polling.Priority:=StdOutPriority;
    myStdOut.Polling.Awake;
    myStdOut.Polling.Enable(true,RunTimeout);
   end;
   // StdErr stream
   if (StdErrPipeSize>0) then begin
    // Apply NONBLOCK option if need
    if Assigned(myProcess.StdErr) then
    if HasFlags(Options,poNonBlockingStdErrPipe) then
    if IsUnix and not FileHasNonBlockFlag(myProcess.StdErr.Handle)
    then FileSetNonBlockFlag(myProcess.StdErr.Handle,true);
    // Create Fifo queue
    if not Assigned(myStdErr.Fifo) then begin
     myStdErr.Fifo:=NewFifo(StdErrPipeSize);
     myStdErr.Fifo.Master:=@myStdErr.Fifo;
    end;
    // Create Polling thread
    if not Assigned(myStdErr.Polling) then begin
     myStdErr.Polling:=NewPolling(TaskStdErrPoll,1000,tpNormal,false,Format('StdErr#%u',[Pid]));
     myStdErr.Polling.Master:=@myStdErr.Polling;
     myStdErr.Polling.LinkObject:=Self;
    end;
    // Apply Fifo & Polling settings
    myStdErr.Fifo.GrowFactor:=2;
    myStdErr.Fifo.Size:=StdErrPipeSize;
    myStdErr.Fifo.GrowLimit:=StdErrPipeLimit;
    myStdErr.Polling.Delay:=PollPeriod;
    myStdErr.Polling.Priority:=StdErrPriority;
    myStdErr.Polling.Awake;
    myStdErr.Polling.Enable(true,RunTimeout);
   end;
   // DebugLog
   if DebugLogEnabled(dlc_TaskRun) then begin
    DebugLog(dlc_TaskRun,CmdLine+EOL+'PID '+IntToStr(Pid));
   end;
   //
   // Now it's Ok
   //
   Result:=true;
  finally
   Unlock;
   Burn;
  end;
 except
  on E:Exception do begin
   ErrorFound(E,'Run');
   Detach;
  end;
 end;
end;

function TTask.Ctrl(const arg:LongString):LongString;
var p,i,si,iv:Integer; sn,sv,par:LongString; lv:Int64;
begin
 Result:='';
 if Assigned(Self) then
 if Assigned(myProcess) then
 try
  Result:='?';
  sn:=''; sv:='';
  p:=ExtractNameValuePair(arg,sn,sv,'=',1);
  case Identify(sn) of
   sid_AppName: begin
    if (p>0) and (sv<>'') then AppName:=Trim(sv);
    Result:=AppName;
   end;
   sid_ExeName: begin
    if (p>0) and (sv<>'') then ExeName:=Trim(sv);
    Result:=ExeName;
   end;
   sid_CmdLine: begin
    if (p>0) and (sv<>'') then CmdLine:=Trim(sv);
    Result:=CmdLine;
   end;
   sid_CmdArgs: begin
    if (p>0) and (sv<>'') then CmdArgs:=Trim(sv);
    Result:=CmdArgs;
   end;
   sid_HomeDir: begin
    if (p>0) and (sv<>'') then HomeDir:=Trim(sv);
    Result:=HomeDir;
   end;
   sid_Encrypt: begin
    Result:=Encrypt(sv);
   end;
   sid_Account: begin
    if (p>0) and (sv<>'') then Account:=Trim(sv);
    Result:=Account;
   end;
   sid_Display: begin
    if (p>0) and IsNonEmptyStr(sv) then begin
     sv:=Trim(sv);
     if SameText(sv,'SW_HIDE')            then Display:=SW_HIDE            else
     if SameText(sv,'SW_MAXIMIZE')        then Display:=SW_MAXIMIZE        else
     if SameText(sv,'SW_MINIMIZE')        then Display:=SW_MINIMIZE        else
     if SameText(sv,'SW_RESTORE')         then Display:=SW_RESTORE         else
     if SameText(sv,'SW_SHOW')            then Display:=SW_SHOW            else
     if SameText(sv,'SW_SHOWDEFAULT')     then Display:=SW_SHOWDEFAULT     else
     if SameText(sv,'SW_SHOWMAXIMIZED')   then Display:=SW_SHOWMAXIMIZED   else
     if SameText(sv,'SW_SHOWMINIMIZED')   then Display:=SW_SHOWMINIMIZED   else
     if SameText(sv,'SW_SHOWMINNOACTIVE') then Display:=SW_SHOWMINNOACTIVE else
     if SameText(sv,'SW_SHOWNA')          then Display:=SW_SHOWNA          else
     if SameText(sv,'SW_SHOWNOACTIVATE')  then Display:=SW_SHOWNOACTIVATE  else
     if SameText(sv,'SW_SHOWNORMAL')      then Display:=SW_SHOWNORMAL      else
     Display:=StrToIntDef(sv,Display);
    end;
    Result:=IntToStr(Display);
   end;
   sid_ConsoleMode: begin
    if (p>0) then ConsoleMode:=StrToIntDef(Trim(sv),ConsoleMode);
    Result:=IntToStr(ConsoleMode);
   end;
   sid_Options: begin
    if (p>0) then Options:=StrToIntDef(Trim(sv),Options);
    Result:=IntToStr(Options);
   end;
   sid_TxPipeSize,
   sid_StdInPipeSize,
   sid_StdInpPipeSize: begin
    if (p>0) then StdInpPipeSize:=StrToIntDef(Trim(sv),StdInpPipeSize);
    Result:=IntToStr(StdInpPipeSize);
   end;
   sid_RxPipeSize,
   sid_StdOutPipeSize: begin
    if (p>0) then StdOutPipeSize:=StrToIntDef(Trim(sv),StdOutPipeSize);
    Result:=IntToStr(StdOutPipeSize);
   end;
   sid_ExPipeSize,
   sid_StdErrPipeSize: begin
    if (p>0) then StdErrPipeSize:=StrToIntDef(Trim(sv),StdErrPipeSize);
    Result:=IntToStr(StdErrPipeSize);
   end;
   sid_TxPipeLimit,
   sid_StdInPipeLimit,
   sid_StdInpPipeLimit: begin
    if (p>0) then StdInpPipeLimit:=StrToIntDef(Trim(sv),0);
    Result:=IntToStr(StdInpPipeLimit);
   end;
   sid_RxPipeLimit,
   sid_StdOutPipeLimit: begin
    if (p>0) then StdOutPipeLimit:=StrToIntDef(Trim(sv),0);
    Result:=IntToStr(StdOutPipeLimit);
   end;
   sid_ExPipeLimit,
   sid_StdErrPipeLimit: begin
    if (p>0) then StdErrPipeLimit:=StrToIntDef(Trim(sv),0);
    Result:=IntToStr(StdErrPipeLimit);
   end;
   sid_TxPriority,
   sid_StdInPriority,
   sid_StdInpPriority: begin
    if (p>0) then StdInpPriority:=GetPriorityByName(Trim(sv));
    Result:=GetPriorityName(StdInpPriority);
   end;
   sid_RxPriority,
   sid_StdOutPriority: begin
    if (p>0) then StdOutPriority:=GetPriorityByName(Trim(sv));
    Result:=GetPriorityName(StdOutPriority);
   end;
   sid_ExPriority,
   sid_StdErrPriority: begin
    if (p>0) then StdErrPriority:=GetPriorityByName(Trim(sv));
    Result:=GetPriorityName(StdErrPriority);
   end;
   sid_ThreadPriority: begin
    if (p>0) then ThreadPriority:=GetPriorityByName(Trim(sv));
    Result:=GetPriorityName(ThreadPriority);
   end;
   sid_ProcessPriority: begin
    if (p>0) then ProcessPriority:=GetPriorityClassLevel(GetPriorityClassByName(Trim(sv)));
    Result:=GetPriorityClassName(GetPriorityClassByLevel(ProcessPriority));
   end;
   sid_Env,
   sid_Environ,
   sid_Environment: begin
    if (p>0) then begin
     sv:=Trim(sv);
     if (WordIndex(sv,'Same,Inherit,Inherited',ScanSpaces)>0)
     then sv:=EnvironmentVariableList.Text;
     if (sv<>'') then sv:=ValidateEol(sv);
     if (sv<>'') then Environment:=sv;
    end;
    Result:=Environment;
   end;
   sid_Charset,
   sid_Encoding,
   sid_CodePage: begin
    if (p>0) then Codepage:=StrToIntDef(Trim(sv),0);
    Result:=IntToStr(CodePage);
   end;
   sid_TxLost: begin
    if (p>0) and TryStrToInt64(Trim(sv),lv) then myStdInp.Fifo.Lost:=lv;
    Result:=IntToStr(myStdInp.Fifo.Lost);
   end;
   sid_RxLost: begin
    if (p>0) and TryStrToInt64(Trim(sv),lv) then myStdOut.Fifo.Lost:=lv;
    Result:=IntToStr(myStdOut.Fifo.Lost);
   end;
   sid_ExLost: begin
    if (p>0) and TryStrToInt64(Trim(sv),lv) then myStdErr.Fifo.Lost:=lv;
    Result:=IntToStr(myStdErr.Fifo.Lost);
   end;
   sid_TxTotal: begin
    if (p>0) and TryStrToInt64(Trim(sv),lv) then myStdInp.Fifo.Total:=lv;
    Result:=IntToStr(myStdInp.Fifo.Total);
   end;
   sid_RxTotal: begin
    if (p>0) and TryStrToInt64(Trim(sv),lv) then myStdOut.Fifo.Total:=lv;
    Result:=IntToStr(myStdOut.Fifo.Total);
   end;
   sid_ExTotal: begin
    if (p>0) and TryStrToInt64(Trim(sv),lv) then myStdErr.Fifo.Total:=lv;
    Result:=IntToStr(myStdErr.Fifo.Total);
   end;
   sid_TxSync,
   sid_StdInSync,
   sid_StdInpSync: begin
    if (p>0) then iv:=StrToIntDef(Trim(sv),0) else iv:=0;
    Result:=IntToStr(StdInpSync(iv));
   end;
   sid_RxSync,
   sid_StdOutSync: begin
    if (p>0) then iv:=StrToIntDef(Trim(sv),0) else iv:=0;
    Result:=IntToStr(StdOutSync(iv));
   end;
   sid_ExSync,
   sid_StdErrSync: begin
    if (p>0) then iv:=StrToIntDef(Trim(sv),0) else iv:=0;
    Result:=IntToStr(StdErrSync(iv));
   end;
   sid_RunTimeout: begin
    if (p>0) and TryStrToInt(Trim(sv),iv) then RunTimeout:=iv;
    Result:=IntToStr(RunTimeout);
   end;
   sid_SyncTimeout: begin
    if (p>0) and TryStrToInt(Trim(sv),iv) then SyncTimeout:=iv;
    Result:=IntToStr(SyncTimeout);
   end;
   sid_SendTimeout: begin
    if (p>0) and TryStrToInt(Trim(sv),iv) then SendTimeout:=iv;
    Result:=IntToStr(SendTimeout);
   end;
   sid_Pid:        Result:=IntToStr(Pid);
   sid_Tid:        Result:=IntToStr(Tid);
   sid_Running:    Result:=IntToStr(Ord(Running));
   sid_ExitCode:   Result:=IntToStr(ExitCode);
   sid_ExitStatus: Result:=IntToStr(ExitStatus);
   sid_TxSize:     Result:=IntToStr(myStdInp.Fifo.Size);
   sid_RxSize:     Result:=IntToStr(myStdOut.Fifo.Size);
   sid_ExSize:     Result:=IntToStr(myStdErr.Fifo.Size);
   sid_TxLimit:    Result:=IntToStr(myStdInp.Fifo.GrowLimit);
   sid_RxLimit:    Result:=IntToStr(myStdOut.Fifo.GrowLimit);
   sid_ExLimit:    Result:=IntToStr(myStdErr.Fifo.GrowLimit);
   sid_TxCount:    Result:=IntToStr(myStdInp.Fifo.Count);
   sid_RxCount:    Result:=IntToStr(myStdOut.Fifo.Count);
   sid_ExCount:    Result:=IntToStr(myStdErr.Fifo.Count);
   sid_TxSpace:    Result:=IntToStr(myStdInp.Fifo.Space);
   sid_RxSpace:    Result:=IntToStr(myStdOut.Fifo.Space);
   sid_ExSpace:    Result:=IntToStr(myStdErr.Fifo.Space);
   sid_TxSend: begin
    if (p>0) then iv:=Send(sv) else iv:=0;
    Result:=IntToStr(iv);
   end;
   sid_RxRecv: begin
    iv:=MaxInt;
    if (p>0) then iv:=StrToIntDef(Trim(sv),iv);
    Result:=RxRecv(iv);
   end;
   sid_ExRecv: begin
    iv:=MaxInt;
    if (p>0) then iv:=StrToIntDef(Trim(sv),iv);
    Result:=ExRecv(iv);
   end;
   sid_Asterisk,
   sid_Question: begin
    Result:='';
    if Assigned(Dictionary) then
    for i:=0 to Dictionary.Count-1 do begin
     si:=Dictionary.Links[i];
     if (si<=Ord(sid_Unknown)) then continue;
     if (si>=Ord(sid_Asterisk)) then continue;
     if not (TStringIdentifier(si) in sid_Ctrl_Readable) then continue;
     if (p>0) and not (TStringIdentifier(si) in sid_Ctrl_Writable) then continue;
     par:=Dictionary.Keys[i];
     if (sn='*') then Result:=Result+par+EOL;
     if (sn='?') then Result:=Result+par+'='+ctrl(par)+EOL;
    end;
   end;
  end;
  sn:=''; sv:='';
 except
  on E:Exception do ErrorFound(E,'Ctrl');
 end;
end;

class function TTask.IsValidExeFile(FileName:LongString):Boolean;
begin
 Result:=true;
 FileName:=Trim(FileName);
 if IsEmptyStr(FileName) then Exit(false);
 if IsUnix then begin
  if (ExtractFileDir(FileName)='')
  then FileName:=file_which(FileName);
  if IsEmptyStr(FileName) then Exit(false);
  if not FileExists(FileName) then Exit(false);
  if not FileIsExecutable(FileName) then Exit(false);
 end;
end;

class function TTask.AddDetachedPid(aPid:TPid):Boolean;
var P:Pointer;
begin
 Result:=false;
 if (aPid<>0) then begin
  P:=PtrIntToPointer(aPid);
  if (DetachedPidList.IndexOf(P)<0) then begin
   DetachedPidList.Add(P);
   Result:=true;
  end;
 end;
end;

class function TTask.DelDetachedPid(aPid:TPid):Boolean;
var P:Pointer;
begin
 Result:=false;
 if (aPid<>0) then begin
  P:=PtrIntToPointer(aPid);
  Result:=(DetachedPidList.Remove(P)>=0);
 end;
end;

class procedure TTask.LogNote(const aMsg:LongString);
begin
 if (aMsg='') then Exit;
 if IsLexeme(LogNoteCommandPrefix,lex_AtCall)
 then SendToMainConsole(LogNoteCommandPrefix+' '+aMsg+EOL)
 else Echo(aMsg);
end;

function DefaultTaskPollDetachedPids(aPid:TPid):Integer;
{$IFDEF UNIX} var pid:TPid; status:cInt; {$ENDIF ~UNIX}
begin
 Result:=0;
 if (aPid=0) then Exit(0);
 if IsWindows then Exit(1);
 if IsUnix then begin
  {$IFDEF UNIX}
  status:=0;
  pid:=FpWaitPid(aPid,status,WNOHANG);
  // On normal child PID exit...
  if (pid>0) and WIFEXITED(Status) then begin
   TTask.LogNote(Format('Child PID %u stopped: exited with code %d.',[Pid,WEXITSTATUS(Status)]));
   Result:=pid;
  end;
  // On child PID terminated by signal...
  if (pid>0) and WIFSIGNALED(Status) then begin
   TTask.LogNote(Format('Child PID %u stopped: killed by signal %d.',[Pid,WTERMSIG(Status)]));
   Result:=pid;
  end;
  // On NO childs
  if (pid<0) then begin
   Result:=pid;
  end;
  {$ENDIF ~UNIX}
 end;
end;

class function TTask.PollDetachedPids(aHandler:TTaskDetachedPidHandler=nil):Integer;
var i,Code:Integer; aPid:TPid; P:Pointer;
begin
 Result:=0;
 try
  Code:=0;
  if not Assigned(aHandler) then aHandler:=DefaultTaskPollDetachedPids;
  for i:=DetachedPidList.Count-1 downto 0 do begin
   P:=DetachedPidList[i]; aPid:=PointerToPtrInt(P);
   if Assigned(aHandler) then Code:=aHandler(aPid);
   if (Code<>0) then DetachedPidList.Remove(P);
  end;
 except
  on E:Exception do BugReport(E,nil,'TTask.PollDetachedPids');
 end;
end;

const
 TheDetachedPidList:TObjectStorage=nil;

class function TTask.DetachedPidList:TObjectStorage;
begin
 if not Assigned(TheDetachedPidList) then begin
  TheDetachedPidList:=NewObjectStorage(false);
  TheDetachedPidList.Master:=@TheDetachedPidList;
  TheDetachedPidList.OwnsObjects:=false;
 end;
 Result:=TheDetachedPidList;
end;

{$IFDEF Poligon}////////////////////////////////////////////////////////////////

type
 TTestTask1Thread=class(Tthread)
 public
  procedure Execute;override;
 end;

procedure TTestTask1Thread.Execute;
var p:TTask; t,i,n:QWord; cmd:LongString;
begin
 cmd:='d:\paslib\_research\catw\cat';
 //cmd:=ExtractFilePath(getcomspec)+'\notepad.exe';
 //cmd:=GetComSpec+' /c dir';
 //cmd:='d:\crw32exe\crw32.exe';
 try
  n:=0;
  p:=NewTask('',cmd,'','','',sw_shownormal,'','',1000,1000);
  try
   p.run;
   t:=gettickcount64;
   while p.running and (gettickcount64-t<30000) do begin
    for i:=1 to 100 do begin
     if p.StdInpPipeFifo.Space>100 then begin
      p.StdInpPipeFifo.PutText(Format('%d %d%s',[n,gettickcount64-t,EOL]));
      inc(n);
     end;
    end;
    if p.StdOutPipeFifo.Count>0 then write(p.StdOutPipeFifo.GetText);
    Sleep(5);
   end;
   for i:=0 to 9 do begin
    Echo(Format('Terminate %d',[i]));
    Echo(Format('Result %d',[ord(p.Terminate(i,4,10000))]));
   end;
   Echo(Format('Task exit code = %d',[p.ExitCode]));
  finally
   Kill(p);
  end;
 except
  on E:Exception do BugReport(E,Self);
 end;
end;

procedure TestTask1;
begin
 TTestTask1Thread.Create(false).FreeOnTerminate:=true;
end;

type
 TTestTask2Thread=class(Tthread)
 public
  procedure Execute;override;
 end;

procedure TTestTask2Thread.Execute;
var p:integer; t,i,n:cardinal; cmd:LongString;
begin
 //cmd:='d:\paslib\_research\catw\cat';
 //cmd:='d:\paslib\_research\catd\cat';
 //cmd:=GetComSpec+' /c d:\paslib\_research\catd\cat';
 //cmd:='command.com /c d:\paslib\_research\catd\cat';
 //cmd:=ExtractFilePath(getcomspec)+'\notepad.exe';
 //cmd:=GetComSpec+' /c dir';
 cmd:=GetComSpec+' /c d:\paslib\_research\catw\test.bat';
 //cmd:='d:\crw32exe\crw32.exe';
 try
  n:=0;
  p:=task_init('');
  task_ctrl(p,'AppName=');
  task_ctrl(p,'CmdLine='+cmd);
  task_ctrl(p,'HomeDir='+GetCurrDir);
  //task_ctrl(p,'StdInPipeSize=1000');
  task_ctrl(p,'StdOutPipeSize=2000');
  //task_ctrl(p,'StdInFileName=crw32.map');
  //task_ctrl(p,'StdOutFileName=a.x');
  task_ctrl(p,'Display=1');
  echo('AppName='+          task_ctrl(p,'AppName'));
  echo('CmdLine='+          task_ctrl(p,'CmdLine'));
  echo('HomeDir='+          task_ctrl(p,'HomeDir'));
  echo('StdInPipeSize='+    task_ctrl(p,'StdInPipeSize'));
  echo('StdOutPipeSize='+   task_ctrl(p,'StdOutPipeSize'));
  echo('StdInFileName='+    task_ctrl(p,'StdInFileName'));
  echo('StdOutFileName='+   task_ctrl(p,'StdOutFileName'));
  echo('Display='+          task_ctrl(p,'Display'));
  Sleep(1000);
  try
   task_run(p);
   Echo(Format('Task index %d, ref %d, pid %d',[p, Integer(task_ref(p)), task_pid(p)]));
   Sleep(1000);
   t:=gettickcount64;
   while task_wait(p,0) and (gettickcount64-t<30000) do begin
    for i:=1 to 100 do begin
     if task_txspace(p)>100 then begin
      task_send(p,Format('%d %d%s',[n,gettickcount64-t,EOL]));
      inc(n);
     end;
    end;
    if task_rxcount(p)>0 then write(task_recv(p,maxint));
    Sleep(5);
   end;
   echo('Send ^C'); task_send(p,#3+EOL); Sleep(2000);
   for i:=0 to 9 do begin
    Echo(Format('Terminate %d',[i]));
    Echo(Format('Result %d',[ord(task_kill(p,i,111,10000))]));
   end;
   Echo(Format('Task exit code = %d',[task_result(p)]));
  finally
   echo('TaskFree='+d2s(ord(task_free(p))));
  end;
 except
  on E:Exception do BugReport(E,Self);
 end;
end;

procedure TestTask2;
begin
 TTestTask2Thread.Create(false).FreeOnTerminate:=true;
end;

{$ENDIF Poligon}////////////////////////////////////////////////////////////////

 ////////////////////
 // Utility functions
 ////////////////////
function NewTask(const aAppName     : LongString      = '';
                 const aCmdLine     : LongString      = '';
                 const aHomeDir     : LongString      = '';
                 const aAccount     : LongString      = '';
                 const aEnvironment : LongString      = '';
                 const aDisplay     : Cardinal        = DefTaskDisplay;
                 const aStdInpPipe  : Integer         = 0;
                 const aStdOutPipe  : Integer         = 0;
                 const aStdErrPipe  : Integer         = 0;
                 const aOptions     : Integer         = DefTaskOptions;
                 const aRunning     : Boolean         = false):TTask;
begin
 Result:=nil;
 try
  Result:=TTask.Create;
  Result.AppName:=aAppName;
  Result.CmdLine:=aCmdLine;
  Result.HomeDir:=aHomeDir;
  Result.Account:=aAccount;
  Result.Environment:=aEnvironment;
  Result.Display:=aDisplay;
  Result.StdInpPipeSize:=aStdInpPipe;
  Result.StdOutPipeSize:=aStdOutPipe;
  Result.StdErrPipeSize:=aStdErrPipe;
  Result.Options:=aOptions;
  if aRunning then Result.Run;
 except
  on E:Exception do begin
   BugReport(E,nil,'NewTask');
   Kill(Result);
  end;
 end;
end;

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

function TaskShuttleEncode(Str:LongString):LongString;
begin
 Result:=Mime_Encode(BitReverseText(Str));
end;

function TaskShuttleDecode(Str:LongString):LongString;
begin
 Result:=BitReverseText(Mime_Decode(Str));
end;

function SmartExecute(const CmdLine:LongString; Display:Integer; ShellCm:LongString):Boolean;
{$IFDEF WINDOWS}var path:TMaxPathBuffer;{$ENDIF ~WINDOWS}
{$IFDEF UNIX}var exe:LongString;{$ENDIF ~UNIX}
var task:TTask;
begin
 Result:=false;
 try
  if IsNonEmptyStr(ShellCm) then begin
   {$IFDEF WINDOWS}
   if StrLen(StrCopyBuff(path,CmdLine))>0 then
   Result:=(ShellExecute(0,PChar(ShellCm),path,nil,nil,Display)>32);
   if Result
   then TTask.LogNote('Command started: '+CmdLine)
   else TTask.LogNote('Could not start: '+CmdLine);
   {$ENDIF ~WINDOWS}
   {$IFDEF UNIX}
   if SameText(ShellCm,'open') then begin
    exe:=file_which('xdg-open');
    if (exe<>'') then Exit(SmartExecute(exe+' '+CmdLine,Display,''));
   end;
   {$ENDIF ~UNIX}
  end else begin
   task:=NewTask;
   try
    task.CmdLine:=CmdLine;
    task.Display:=Display;
    Result:=task.Run;
    if Result
    then TTask.LogNote('Child PID '+IntToStr(task.Pid)+' started: '+CmdLine)
    else TTask.LogNote('Could not start: '+CmdLine);
   finally
    task.Free;
   end;
  end;
 except
  on E:Exception do BugReport(E,nil,'SmartExecute');
 end;
end;

{$IFDEF WINDOWS}
function PidAffinity(pid:TPid; mask:Int64=0):Int64;
var h:THandle; m1,m2:PtrUInt;
begin
 Result:=0;
 try
  if (pid=0) or (pid=-1)
  then h:=GetCurrentProcess
  else h:=OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_SET_INFORMATION,False,pid);
  if h<>0 then
  try
   m1:=0; m2:=0;
   if (mask<>0) and (pid<>-1) then SetProcessAffinityMask(h,DWORD(mask));
   if Windows.GetProcessAffinityMask(h,m1,m2) then
   if pid=-1 then Result:=m2 else Result:=m1;
  finally
   if (h<>0) and (h<>GetCurrentProcess) then CloseHandle(h);
  end;
 except
  on E:Exception do BugReport(E,nil,'PidAffinity');
 end;
end;
{$ENDIF ~WINDOWS}
{$IFDEF UNIX}
function PidAffinity(pid:TPid; mask:Int64=0):Int64;
begin
 Result:=0;
 try
  if (pid=0) then pid:=GetCurrentProcessId;
  if (mask=0)
  then Result:=GetThreadAffinityMask(pid)
  else Result:=SetThreadAffinityMask(pid,Mask);
 except
  on E:Exception do BugReport(E,nil,'PidAffinity');
 end;
end;
{$ENDIF ~UNIX}

 ///////////////////////////////////////////////////////////////////////////////
 // TRunningProcessList implementation
 ///////////////////////////////////////////////////////////////////////////////
constructor TRunningProcessList.Create(aMode:Integer);
begin
 inherited Create;
 myList:=TStringList.Create;
 myMode:=aMode or glops_Threads;
 RefreshProcessList;
end;

destructor TRunningProcessList.Destroy;
begin
 Kill(myList);
 inherited Destroy;
end;

function TRunningProcessList.RefreshProcessList:Integer;
begin
 Result:=0;
 if Assigned(Self) then
 try
  myList.Text:=GetListOfProcesses(0,0,'',(myMode<>0),myMode);
  Result:=myList.Count;
 except
  on E:Exception do ErrorFound(E,'Create');
 end;
end;

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

function TRunningProcessList.GetPid(i:Integer):TPid;
begin
 if Assigned(Self) and InRange(i,0,myList.Count-1)
 then Result:=glops_fetch_pid(myList[i],myMode)
 else Result:=0;
end;

function TRunningProcessList.GetParentPid(i:Integer):TPid;
begin
 if Assigned(Self) and InRange(i,0,myList.Count-1)
 then Result:=glops_fetch_ppid(myList[i],myMode)
 else Result:=0;
end;

function TRunningProcessList.GetPriority(i:Integer):Integer;
begin
 if Assigned(Self) and InRange(i,0,myList.Count-1)
 then Result:=glops_fetch_prio(myList[i],myMode)
 else Result:=0;
end;

function TRunningProcessList.GetTaskName(i:Integer):LongString;
begin
 if Assigned(Self) and InRange(i,0,myList.Count-1)
 then Result:=glops_fetch_comm(myList[i],myMode)
 else Result:='';
end;

function TRunningProcessList.GetState(i:Integer):Char;
begin
 if Assigned(Self) and InRange(i,0,myList.Count-1)
 then Result:=glops_fetch_stat(myList[i],myMode)
 else Result:=pps_Invalid;
end;

function TRunningProcessList.GetThreads(i:Integer):Integer;
begin
 if Assigned(Self) and InRange(i,0,myList.Count-1)
 then Result:=glops_fetch_nlwp(myList[i],myMode)
 else Result:=0;
end;

function TRunningProcessList.GetCmdLine(i:Integer):LongString;
begin
 if Assigned(Self) and InRange(i,0,myList.Count-1)
 then Result:=glops_fetch_cmdl(myList[i],myMode)
 else Result:='';
end;

function TRunningProcessList.GetPriorityClass(i:Integer):Integer;
begin
 if Assigned(Self)
 then Result:=ProcessPriorityToClass(GetProcessPriority(GetPid(i)))
 else Result:=0;
end;

function TRunningProcessList.IndexOfPid(aPid:TPid):Integer;
var i:Integer;
begin
 Result:=-1;
 if Assigned(Self) and (aPid>0) then
 for i:=0 to Count-1 do if (aPid=Pid[i]) then Exit(i);
end;

function NewRunningProcessList(Mode:Integer=0):TRunningProcessList;
begin
 Result:=nil;
 try
  Result:=TRunningProcessList.Create(Mode);
 except
  on E:Exception do BugReport(E,nil,'NewRunningProcessList');
 end;
end;

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

{$IFDEF WINDOWS}
function winapi_GetClassName(Wnd:HWnd):LongString;
var buf:TMaxPathBuffer; cls:LongString;
begin
 Result:='';
 if (Wnd=0) then Exit;
 buf:=Default(TMaxPathBuffer);
 cls:=StringBuffer(@buf,GetClassName(Wnd,buf,SizeOf(buf)-1));
 cls:=Trim(cls);
 Result:=cls;
end;
{$ENDIF}

function KillProcess(aPid:TPid; aExitCode:Integer; sig:Integer=SIGTERM):Boolean;
{$IFDEF WINDOWS}
const SOFT=[SIGINT,SIGQUIT]; NORM=[SIGTERM]; HARD=[SIGABRT]; DOOM=[SIGKILL];
var hProcess,hTh:THandle; Msg:UINT; Wnd:HWND;
{$ENDIF}
begin
 Result:=false;
 if (aPid<>0) then
 if (aPid<>GetCurrentProcessId) then
 if PidLooksAsValid(aPid,plav_DefSafe) then
 try
  {$IFDEF WINDOWS}
  Msg:=0; Wnd:=0; hTh:=0;
  if InRange(sig,1,SIGRTMAX) then
  case sig of
   SIGINT:  Msg:=WM_CLOSE;
   SIGTERM: Msg:=WM_CLOSE;
   SIGABRT: Msg:=WM_QUIT;
   SIGQUIT: Msg:=WM_QUIT;
   else     Msg:=0;
  end else Exit;
  if (Msg<>0) then begin
   hTh:=winapi_find_main_thread_by_pid(aPid);
   Wnd:=winapi_find_main_window_by_pid(aPid,hTh);
   if (Wnd<>0) and (Msg=WM_QUIT) then begin
    if SameText(winapi_GetClassName(Wnd),'ConsoleWindowClass')
    then Msg:=WM_CLOSE; // Console windows require WM_CLOSE
   end;
   if (Wnd<>0) and (sig in SOFT+NORM+HARD+DOOM) then begin
    Result:=winapi_PostMessageToProcessMainWindow(aPid,Msg,0,0);
    if Result then Exit; // Message sent, wait for termination
   end;
   // Thread messages is not working. Why?
   // if (hTh<>0) and (sig in SOFT+NORM+HARD+DOOM) then begin
   //  Result:=winapi_PostMessageToProcessMainThread(aPid,Msg,0,0);
   //  if Result then Exit;
   // end;
  end;
  if not (sig in NORM+HARD+DOOM) then Exit;
  hProcess:=OpenProcess(PROCESS_TERMINATE,False,aPid);
  if hProcess<>0 then
  try
   Result:=TerminateProcess(hProcess,aExitCode);
  finally
   CloseHandle(hProcess);
  end;
  {$ENDIF ~WINDOWS}
  {$IFDEF UNIX}
  Result:=(FpKill(aPid,sig)=0);
  {$ENDIF ~UNIX}
 except
  on E:Exception do BugReport(E,nil,'KillProcess');
 end;
end;

function KillProcessTree(aPid:TPid; aExitCode:Integer; MaxLevel:Integer=100; sig:Integer=SIGTERM):Integer;
var List:TRunningProcessList;
 procedure KillPid(aPid:TPid;aLevel:Integer); // To be called recursively
 var i:Integer;
 begin
  if (aPid<>0) then
  if (aPid<>GetCurrentProcessId) then
  if PidLooksAsValid(aPid,plav_DefSafe) then begin
   if (aLevel<MaxLevel) then
   for i:=0 to List.Count-1 do
   if (List.ParentPid[i]=aPid) then KillPid(List.Pid[i],aLevel+1);
   if KillProcess(aPid,aExitCode,sig) then Inc(Result);
  end;
 end;
begin
 Result:=0;
 if (aPid<>0) then
 if (aPid<>GetCurrentProcessId) then
 try
  List:=NewRunningProcessList;
  if Assigned(List) then
  try
   KillPid(aPid,0);
  finally
   Kill(List);
  end;
 except
  on E:Exception do BugReport(E,nil,'KillProcessTree');
 end;
end;

function PidKill(pid:TPid; cod:Integer; lev:Integer=markUnxSig):Integer;
var sig:Integer;
begin
 Result:=0;
 sig:=SIGTERM;
 // Old crw style pidkill(pid,cod,lev)
 if (cod>=0) and (lev>=0) then begin
  Result:=KillProcessTree(pid,cod,lev,sig);
  Exit;
 end;
 // UNIX classic style pidkill(pid,sig) or pidkill(pid,-sig)
 if (lev=markUnxSig) and InRange(abs(cod),0,SIGRTMAX) then begin
  if InRange(abs(cod),1,SIGRTMAX) then sig:=abs(cod);
  Result:=BoolToInt(KillProcess(pid,0,sig));
  Exit;
 end;
 // Variant pidkill(pid,cod,-sig)
 if (cod>=0) and InRange(lev,-SIGRTMAX,-1) then begin
  sig:=abs(lev); // Interpret negative lev as -sig
  Result:=KillProcessTree(pid,cod,0,sig);
  Exit;
 end;
 // Variant pidkill(pid,-sig,lev)
 if InRange(cod,-SIGRTMAX,-1) and (lev>=0) then begin
  sig:=abs(cod); // Interpret negative cod as -sig
  Result:=KillProcessTree(pid,0,lev,sig);
  Exit;
 end;
end;

 //////////////////////////////////////////////
 // Easy task routines, to be use in DAQ PASCAL
 //////////////////////////////////////////////
const
 task_latch : TLatch = nil;
var
 task_array : packed array[task_ref_min..task_ref_max] of TTask;

procedure task_initialize;
begin
 task_latch:=NewLatch;
 task_latch.Master:=@task_latch;
 ZeroMemory(@task_array,sizeof(task_array));
end;

procedure task_finalize;
var i:Integer;
begin
 for i:=Low(task_array) to High(task_array) do task_free(i);
 Kill(task_latch);
end;

function task_init(const cmd_line:LongString):Integer;
var i:Integer;
begin
 Result:=0;
 try
  task_latch.Lock;
  try
   for i:=Low(task_array) to High(task_array) do
   if not Assigned(task_array[i]) then begin
    task_array[i]:=NewTask('',cmd_line);
    task_array[i].Master:=@task_array[i];
    task_array[i].SetTid(i);
    Result:=i;
    Break;
   end;
  finally
   task_latch.Unlock;
  end;
 except
  on E:Exception do BugReport(E,nil,'task_init');
 end;
end;

function task_unlink(tid:Integer):TTask;
begin
 Result:=nil;
 if (tid>=Low(task_array)) then
 if (tid<=High(task_array)) then
 try
  task_latch.Lock;
  Result:=task_array[tid];
  task_array[tid]:=nil;
  Result.SetTid(0);
 finally
  task_latch.Unlock;
 end;
end;

function task_free(tid:Integer):Boolean;
var task:TTask;
begin
 task:=task_unlink(tid);
 Result:=Assigned(task);
 Kill(task);
end;

function task_ref(tid:Integer):TTask;
begin
 Result:=nil;
 if (tid>=Low(task_array)) then
 if (tid<=High(task_array)) then Result:=task_array[tid];
end;

function task_pid(tid:Integer):Integer;
begin
 Result:=task_ref(tid).Pid;
end;

function task_run(tid:Integer):Boolean;
begin
 Result:=task_ref(tid).Run;
end;

function task_wait(tid,timeout:Integer):Boolean;
begin
 Result:=task_ref(tid).Running(timeout);
end;

function task_send(tid:Integer; const data:LongString):Integer;
begin
 Result:=task_ref(tid).Send(data);
end;

function task_recv(tid:Integer; maxlen:Integer):LongString;
begin
 Result:=task_ref(tid).Recv(maxlen);
end;

function task_txcount(tid:Integer):Integer;
begin
 Result:=task_ref(tid).StdInpPipeFifoCount;
end;

function task_rxcount(tid:Integer):Integer;
begin
 Result:=task_ref(tid).StdOutPipeFifoCount;
end;

function task_txspace(tid:Integer):Integer;
begin
 Result:=task_ref(tid).StdInpPipeFifoSpace;
end;

function task_rxspace(tid:Integer):Integer;
begin
 Result:=task_ref(tid).StdOutPipeFifoSpace;
end;

function task_result(tid:Integer):Integer;
begin
 Result:=task_ref(tid).ExitCode;
end;

function task_kill(tid,how,exit_code,timeout:Integer):Boolean;
begin
 Result:=task_ref(tid).Terminate(how,exit_code,timeout);
end;

function task_ctrl(tid:Integer; const arg:LongString):LongString;
begin
 Result:=task_ref(tid).Ctrl(arg);
end;

 //////////////////////////////
 // FullTaskList implementation
 //////////////////////////////
const
 TheFullTaskList : TObjectStorage = nil;

function FullTaskList:TObjectStorage;
begin
 if not Assigned(TheFullTaskList) then begin
  TheFullTaskList:=NewObjectStorage(false);
  TheFullTaskList.Master:=@TheFullTaskList;
  TheFullTaskList.OwnsObjects:=false;
 end;
 Result:=TheFullTaskList;
end;

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

procedure Init_crw_task;
begin
 InitDictionary;
 FullTaskList.Ok;
 task_initialize;
 TTask.DetachedPidList.Ok;
 TTask.LogNoteCommandPrefix:='';
 dlc_TaskRun:=RegisterDebugLogChannel('_TaskRun');
 dlc_TaskKill:=RegisterDebugLogChannel('_TaskKill');
end;

procedure Free_crw_task;
begin
 task_finalize;
 ResourceLeakageLog(Format('%-60s = %d',['FullTaskList.Count', TheFullTaskList.Count]));
 Kill(TheFullTaskList);
 ResourceLeakageLog(Format('%-60s = %d',['TTask.DetachedPidList.Count', TheDetachedPidList.Count]));
 Kill(TheDetachedPidList);
 FreeDictionary;
end;

initialization

 Init_crw_task;

finalization

 Free_crw_task;

end.

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

