 {
 This program uses to demonstrate task_xxx functions features.
 Daq program start console application named "user_task.exe".
 Application stdin,stdout redirected to anonymouse pipe.
 Using this pipe, Daq Pascal program then send messages
 to user task and receive answer.
 }
program DemoTask;
const
 usertask  = 'user_task.exe';
var
 b         : Boolean;
 Ok        : Boolean;
 errors    : Integer;
 errorcode : Integer;
 tid       : Integer;
 Task_Buff : String;
 s         : string;
 {
 Read line from task stdout pipe with CR terminator and LF ignore.
 task_recv(tid,maxlen) uses to read data.
 task_pid(tid) uses to check if task Ok.
 }
 function Task_Readln(var s:String):boolean;
 var p,q:integer;
 begin
  s:='';
  Task_Readln:=false;
  if task_pid(tid)<>0 then begin
   if length(Task_Buff)<250 then Task_Buff:=Task_Buff+task_recv(tid,250-length(Task_Buff));
   p:=pos(chr(13),Task_Buff);
   if p>0 then begin
    Task_Readln:=true;
    if p>1 then s:=copy(Task_Buff,1,p-1);
    if length(s)>0 then begin
     q:=pos(chr(10),s);
     if q>0 then s:=copy(s,q+1,255);
    end;
    Task_Buff:=Copy(Task_Buff,p+1,255);
    if length(Task_Buff)>0 then
    if Task_Buff[1]=chr(10) then Task_Buff:=copy(Task_Buff,2,255);
   end else begin
    if length(Task_Buff)=250 then begin
     writeln(devname,': received line too long!');
     b:=fixerror(errorcode);
     Task_Buff:='';
    end;
   end;
  end;
 end;
 {
 Clear task buffer and identifiers
 }
 procedure Task_Clear;
 begin
  Task_Buff:='';
 end;
 {
 Show list of running processes
 }
 procedure ShowTaskList;
 var t,i:Integer; b:Boolean;
  function npos(c:char;n:integer;s:string):integer;
  var i,j:integer;
  begin
   j:=0;
   npos:=0;
   for i:=1 to length(s) do
   if s[i]=c then begin j:=j+1; if j=n then npos:=i; end;
  end;
 begin
  t:=pidlist(text_new);
  writeln('Process list:');
  write('      Pid':11,' ');
  write('ParentPid':11,' ');
  write('  Threads':11,' ');
  write(' Priority':11,' ');
  write('FileName');
  writeln;
  for i:=0 to text_numln(t)-1 do begin
   write(extractword(1,text_getln(t,i)):11,' ');
   write(extractword(2,text_getln(t,i)):11,' ');
   write(extractword(3,text_getln(t,i)):11,' ');
   write(extractword(4,text_getln(t,i)):11,' ');
   write(copy(text_getln(t,i),npos(',',4,text_getln(t,i))+1));
   writeln;
  end;
  b:=text_free(t);
 end;
 {
 Kill process by given *.exe file name.
 }
 function KillPidByName(exe:string):Integer;
 var t,i,n,pid:Integer; b:Boolean;
  function npos(c:char;n:integer;s:string):integer;
  var i,j:integer;
  begin
   j:=0;
   npos:=0;
   for i:=1 to length(s) do
   if s[i]=c then begin j:=j+1; if j=n then npos:=i; end;
  end;
 begin
  n:=0;
  exe:=trim(exe);
  if length(exe)>0 then begin
   t:=pidlist(text_new);
   for i:=0 to text_numln(t)-1 do
   if IsSameText(exe,copy(text_getln(t,i),npos(',',4,text_getln(t,i))+1)) then begin
    pid:=val(extractword(1,text_getln(t,i)));
    if pid<>0 then n:=n+pidkill(pid,0,0);
   end;
  end;
  b:=text_free(t);
  KillPidByName:=n;
 end;
 {
 Show directory content in system console...
 }
 procedure ShowDirList(Dir:String);
 var t,i:integer; s:string; b:Boolean;
 begin
  s:='';
  if DirExists(Dir) then begin
   writeln(Dir+' content:');
   t:=dirlist(text_new,maxint,Dir,'*.*');
   for i:=0 to text_numln(t)-1 do begin
    s:=text_getln(t,i);
    if length(s)>0 then
    if s[length(s)]<>'\' then writeln(' '+s);
   end;
   b:=text_free(t);
  end;
  s:='';
 end;
begin
 {
 Initialization actions on Start
 }
 if runcount=1 then begin
  errors:=0;
  errorcode:=registererr(devname+'-'+progname);
  Task_Clear;
  s:='';
  {
  Open console window
  }
  b:=winshow(ParamStr('Console '+devname));
  b:=windraw(ParamStr('Console '+devname)+'|top=0|left=180|Width=600|Height=400');
  b:=winselect(ParamStr('Console '+devname));
  writeln(devname+' start');
  {
  Simple command execution with command processor example.
  Note that we don't call task_kill to terminate process before task_free.
  So application continue working after task_free.
  To run program as another user, we should write something like that:
  s:=task_ctrl(tid,'Account=a/Tc84Y5AAD+lmxO4Tq438dlRzx5367M9RSNgjw/kMVJNdWEXF/a14kp6aF7rDev');
  Account key provided by CRW-DAQ secret service.
  }
  writeln('Command processor ComSpec=',GetComSpec);
  tid:=task_init(GetComSpec+' /c '+paramstr('DaqConfigPath')+'\user_task.bat');
  b:=task_run(tid);
  b:=task_free(tid);
  {
  Initialize task
  task_init uses to create task index
  task_ctrl uses to setup or readback task parameters
  Note we are use StdInPipeSize,StdOutPipeSize redirection.
  }
  tid:=task_init('');
  if pos('?',task_ctrl(tid,'AppName=')
            +task_ctrl(tid,'CmdLine='+paramstr('DaqConfigPath')+'\'+usertask)
            +task_ctrl(tid,'HomeDir='+paramstr('DaqConfigPath'))
            +task_ctrl(tid,'Display=1')
            +task_ctrl(tid,'StdInPipeSize=1000')
            +task_ctrl(tid,'StdOutPipeSize=1000')
            +task_ctrl(tid,'StdInpFileName=')
            +task_ctrl(tid,'StdOutFileName=')
            +task_ctrl(tid,'StdInPriority=tpTimeCritical')
            +task_ctrl(tid,'StdOutPriority=tpTimeCritical')
            +task_ctrl(tid,'ThreadPriority=tpTimeCritical')
            +task_ctrl(tid,'ProcessPriority=RealTime')
        )>0
  then begin
   writeln('Task setup error!');
   b:=task_free(tid);
   tid:=0;
  end;
  {
  Run task and write some information
  task_run(tid)          - create process and start application execution
  task_pid(tid)          - process identifier
  task_wait(tid,timeout) - wait timeout white process terminate,
                           return true if still runnung.
  task_wait(tid,0)       - uses to check immediately if process still running
  task_result(tid)       - uses to check result code; 259=STILL_RUNNING
  }
  writeln('Run=',task_run(tid));
  if task_pid(tid)<>0 then begin
   writeln('TaskId=',tid);
   writeln('Pid=',task_pid(tid));
   writeln('Ref=',task_ref(tid));
   writeln('AppName=',task_ctrl(tid,'AppName'));
   writeln('CmdLine=',task_ctrl(tid,'CmdLine'));
   writeln('HomeDir=',task_ctrl(tid,'HomeDir'));
   writeln('StdInPipeSize=',task_ctrl(tid,'StdInPipeSize'));
   writeln('StdOutPipeSize=',task_ctrl(tid,'StdOutPipeSize'));
   writeln('StdInFileName=',task_ctrl(tid,'StdInFileName'));
   writeln('StdOutFileName=',task_ctrl(tid,'StdOutFileName'));
   writeln('StdInPriority=',task_ctrl(tid,'StdInPriority'));
   writeln('StdOutPriority=',task_ctrl(tid,'StdOutPriority'));
   writeln('ThreadPriority=',task_ctrl(tid,'ThreadPriority'));
   writeln('ProcessPriority=',task_ctrl(tid,'ProcessPriority'));
   writeln('Display=',task_ctrl(tid,'Display'));
   writeln('Wait=',task_wait(tid,0));
   writeln('Result=',task_result(tid));
  end else begin
   writeln('Task error found!');
   b:=task_free(tid);
   tid:=0;
  end;
  if errors<>0 then b:=fixerror(errorcode);
  Ok:=(errors=0);
 end else
 {
 Finalization actions on Stop
 }
 if isinf(runcount) then begin
  writeln(devname+' stop');
  {
  We should kill process, because we should close pipes.
  task_kill(tid,how,exitcode,timeout) - uses to kill prosess
  task_free(tid) - uses to destroy task instance and free task index
  Note that we send @Exit command and wait some time till task die    
  }
  if task_pid(tid)<>0 then begin
   if task_send(tid,'@Exit'+crlf)>0 then b:=task_wait(tid,500);
   if task_wait(tid,0) then writeln('TaskKill=',task_kill(tid,0,0,1000));
   writeln('ExitCode=',task_result(tid));
  end;
  if task_ref(tid)<>0 then
  writeln('TaskFree=',task_free(tid));
  { Kill all cmd.exe instances... }
  writeln('Kill all cmd.exe : ',KillPidByName('cmd.exe'):1,' killed.');
  { Show list of running processes... }
  ShowTaskList;
  { Show directory list... }
  ShowDirList(ExtractFilePath(ParamStr('DaqConfigFile')));
  Task_Clear;
  tid:=0;
  s:='';
 end else
 {
 Actions on Poll
 }
 if Ok then begin
  {
  task_pid(tid)       - uses to check if process created or not
  task_wait(tid,0)    - uses to check if process still running
  task_send(tid,data) - uses to send data to stdin pipe
  task_recv(tid,leng) - uses to receive data from stdout pipe
  task_rxcount(tid)   - uses to check pipe data received count
  task_rxspace(tid)   - uses to check pipe free space
  In given case, we send "RunCount=..." to user_task.exe application.
  This application then return it back, so we should see this in console.
  Note we are use mime_encode and dump to send binary data to text pipe.
  Receiver should use mime_decode and dump2r to get data...
  }
  if task_pid(tid)<>0 then
  if task_wait(tid,0) then begin
   if task_txspace(tid)>100 then
   if task_send(tid,'@RunCount='+mime_encode(dump(RunCount)+dump(Time))+crlf)=0 
   then b:=fixerror(errorcode);
   while (task_rxcount(tid)>0) and Task_Readln(s) do writeln(s);
  end else begin
   writeln('Program terminated with exit code:',task_result(tid));
  end;
 end;
end.
