%%ID=DEMO
 {
 %ID% client to use with %ID% console driver.
 Client configuration should contain something like:
 [DeviceList]
 &%ID% = device software program
 [&%ID%]
 Comment = Demo program
 InquiryPeriod = 10
 DevicePolling = 10, tpNormal
 ProgramSource = .\%ID%_Client.pas
 %ID%_EXE_PATH = .\%ID%_Server.exe
 OpenConsole   = 1
 DebugFlags    = 11
 StdInPipe     = 128
 StdOutPipe    = 128
 ProcessPriority = Normal   ; Idle,Normal,High,RealTime
 ThreadPriority  = tpNormal ; tpIdle,tpLowest,tpLower,tpNormal,tpHigher,tpHighest,tpTimeCritical
 ...etc
 []
 }
program %ID%_Client;
const
 MaxLeng      = 1024;    { max. length of I/O string  }
 SendTimeOut  = 100;     { timeout on message send,ms }
 TimerPeriod  = 1000;    { poll period to restart     }
 borlndmm_dll = 'borlndmm.dll'; { needed dll library  }
 dfTrouble    = 1;       { DebugFlags - Trouble       }
 dfSuccess    = 2;       { DebugFlags - Success       }
 dfViewInp    = 4;       { DebugFlags - ViewInp       }
 dfViewOut    = 8;       { DebugFlags - ViewOut       }
var
 b            : Boolean; { Temporary variable         }
 Ok           : Boolean; { Is initialization Ok ?     }
 errors       : Integer; { Error count                }
 errorcode    : Integer; { Error code for this device }
 errorterm    : Integer; { Error code for host death  }
 erroriobug   : Integer; { Error code for %ID% errors }
 fixmaxavail  : Integer; { String manager leak test   }
 DebugFlags   : Integer; { see dfXXX constants        }
 StdIn_Line   : String;  { Temporary variable         }
 winConsole   : String;  { Console window name        }
 %ID%         : record
  Server      : String;  { %ID% server path           }
  Timer       : Integer; { Timer to check %ID% task   }
  Buff        : String;  { %ID% task input buffer     }
  Line        : String;  { Temporary variable         }
  Tid         : Integer; { %ID% task identifier       }
  IPipeSize   : Integer; { StdInPipeSize              }
  OPipeSize   : Integer; { StdOutPipeSize             }
 end;
 {
 Report on host terminated.
 }
 procedure HostTerm(msg:String);
 var b:boolean;
 begin
  if iand(DebugFlags,dfTrouble)>0 then
  if Length(msg)>0 then writeln(devname+' ! '+msg);
  if runcount=1 then errors:=errors+1 else b:=fixerror(errorterm);
 end;
 {
 Report on trouble.
 }
 procedure Trouble(msg:String);
 var b:boolean;
 begin
  if iand(DebugFlags,dfTrouble)>0 then
  if Length(msg)>0 then writeln(devname+' ! '+msg);
  if runcount=1 then errors:=errors+1 else b:=fixerror(errorcode);
 end;
 {
 Report on success.
 }
 procedure Success(msg:String);
 begin
  if iand(DebugFlags,dfSuccess)>0 then
  if Length(msg)>0 then writeln(devname+' : '+msg);
 end;
 {
 Report on data input.
 }
 procedure ViewInp(msg:String);
 begin
  if iand(DebugFlags,dfViewInp)>0 then
  if Length(msg)>0 then writeln(devname+' > '+msg);
 end;
 {
 Report on data output.
 }
 procedure ViewOut(msg:String);
 begin
  if iand(DebugFlags,dfViewOut)>0 then
  if Length(msg)>0 then writeln(devname+' < '+msg);
 end;
 {
 Check I/O status.
 }
 function IoError:boolean;
 begin
  IoError:=false;
  if ioresult<>0 then begin
   Trouble('I/O error.');
   IoError:=true;
  end;
 end;
 {
 Read string line from standard input.
 }
 function StdIn_Readln(var s:string):boolean;
 begin
  StdIn_Readln:=false;
  if not IoError then 
  if not eof then begin
   readln(s);
   if not IoError then StdIn_Readln:=true;
  end;
 end;
 {
 Read line from %ID% task stdout pipe with CR terminator and LF ignore.
 }
 function %ID%_Readln(var s:String):boolean;
 var p,q:integer;
 begin
  s:='';
  %ID%_Readln:=false;
  if task_pid(%ID%.Tid)<>0 then begin
   if Length(%ID%.Buff)<MaxLeng
   then %ID%.Buff:=%ID%.Buff+task_recv(%ID%.Tid,MaxLeng-Length(%ID%.Buff));
   p:=Pos(chr(13),%ID%.Buff);
   if p>0 then begin
    %ID%_Readln:=true;
    if p>1 then s:=Copy(%ID%.Buff,1,p-1);
    if Length(s)>0 then begin
     q:=Pos(chr(10),s);
     if q>0 then s:=Copy(s,q+1,MaxLeng);
    end;
    %ID%.Buff:=Copy(%ID%.Buff,p+1,MaxLeng);
    if Length(%ID%.Buff)>0 then
    if %ID%.Buff[1]=chr(10) then %ID%.Buff:=Copy(%ID%.Buff,2,MaxLeng);
   end else begin
    if Length(%ID%.Buff)=MaxLeng then begin
     Trouble('Received line is too long!');
     %ID%.Buff:='';
    end;
   end;
  end;
 end;
 {
 Clear %ID% table.
 }
 procedure %ID%_Clear(ForceFree:boolean);
 var i,j:integer;
 begin
  if ForceFree then begin
   if %ID%.Timer<>0 then b:=tm_free(%ID%.Timer);
  end;
  %ID%.Tid:=0;
  %ID%.Buff:='';
  %ID%.Line:='';
  %ID%.Timer:=0;
  %ID%.Server:='';
 end;
 {
 Initialize %ID% table.
 }
 procedure %ID%_Init;
 begin
  {---Clear %ID%---}
  %ID%_Clear(false);
  {---Read FIFO size---}
  %ID%.IPipeSize:=val(ReadIni('StdInPipe'));
  %ID%.OPipeSize:=val(ReadIni('StdOutPipe'));
  if (%ID%.IPipeSize<=0) or (%ID%.IPipeSize>64*1024) then %ID%.IPipeSize:=64;
  if (%ID%.OPipeSize<=0) or (%ID%.OPipeSize>64*1024) then %ID%.OPipeSize:=64;
  %ID%.IPipeSize:=%ID%.IPipeSize*1024;
  %ID%.OPipeSize:=%ID%.OPipeSize*1024;
  {---Find %ID% server executable---}
  %ID%.Server:=DaqFileRef(ReadIni('%ID%_EXE_PATH'),'.EXE');
  if FileExists(%ID%.Server)
  then Success('%ID%_EXE_PATH='+%ID%.Server)
  else Trouble('Could not find %ID%_EXE_PATH: '+%ID%.Server);
  {---Check borlndmm.dll presence---}
  if not FileExists(AddBackSlash(ExtractFilePath(%ID%.Server))+borlndmm_dll)
  then b:=FileCopy(AddBackSlash(ParamStr('HomeDir'))+borlndmm_dll+' '+
                   AddBackSlash(ExtractFilePath(%ID%.Server))+borlndmm_dll);
  if not FileExists(AddBackSlash(ExtractFilePath(%ID%.Server))+borlndmm_dll)
  then Trouble('Could not find '+borlndmm_dll);
  {---Initialize timer---}
  %ID%.Timer:=tm_new;
  if not tm_addint(%ID%.Timer,TimerPeriod) then Trouble('tm_addint fails.');
  if not tm_start(%ID%.Timer) then Trouble('tm_start fails.');
 end;
 {
 Send message to %ID% task.
 Wait for some time if transmitter FIFO is over.
 }
 procedure %ID%_Send(msg:string);
 var ms:real;
 begin
  if %ID%.Tid<>0 then
  if Length(msg)>0 then begin
   if task_txspace(%ID%.Tid)<Length(msg) then begin
    ms:=msecnow;
    while(msecnow-ms<SendTimeOut) and (task_txspace(%ID%.Tid)<Length(msg)) do b:=Sleep(1);
   end;
   if task_send(%ID%.Tid,msg+CrLf)=0
   then Trouble('Send error!')
   else ViewInp(msg);
  end;
 end;
 {
 Analyse data coming from %ID% task stdout.
 }
 procedure %ID%_Process(var s:string);
 var b:Boolean; cmnd,args,buff:String;
     i,p,n,wc:integer;
 begin
  cmnd:='';
  args:='';
  buff:='';
  if length(s)>0 then begin
   ViewOut(s);
   if s[1]='@' then begin
    p:=pos('=',s);
    if p>0 then begin
     cmnd:=Copy(s,1,p-1);
     args:=Copy(s,p+1,Length(s)-p);
    end else begin
     cmnd:=s;
     args:='';
    end;
    wc:=wordcount(args);
    {---@exit=n statement---}
    if IsSameText(cmnd,'@exit') then begin
     Success('Exit with code '+Trim(args));
    end;
    {---@errors=n statement---}
    if IsSameText(cmnd,'@errors') then begin
     if (wc=1) and (val(args)>0) then b:=fixerror(erroriobug);
    end;
    {---@memory=n statement---}
    if IsSameText(cmnd,'@memory') then begin
     n:=val(args);
    end;
   end;
  end;
  buff:='';
  cmnd:='';
  args:='';
 end;
 {
 Stop %ID% server task if one started.
 }
 procedure %ID%_Stop;
 var b:Boolean;
 begin
  if %ID%.Tid>0 then begin
   if task_wait(%ID%.Tid,0) then begin
    Success('%ID%.EXE termination will take some time.');
    Success('You should wait about 5 sec...');
    %ID%_Send('@stop');
    %ID%_Send('@exit');
    b:=task_wait(%ID%.tid,500);
    if task_wait(%ID%.Tid,0) then b:=task_kill(%ID%.Tid,0,1,0);
    if task_rxcount(%ID%.Tid)>0 then
    while %ID%_Readln(%ID%.Line) do %ID%_Process(%ID%.Line);
    Success('%ID% Server exit code = '+str(task_result(%ID%.Tid)));
   end;
   b:=task_free(%ID%.Tid);
  end;
  %ID%.Tid:=0;
  %ID%.Buff:='';
  %ID%.Line:='';
 end;
 {
 Finalize %ID% table.
 }
 procedure %ID%_Free;
 begin
  %ID%_Stop;
  %ID%_Clear(true);
 end;
 {
 Start %ID% server if one not started.
 }
 procedure %ID%_Start;
 var i,j:Integer; b:Boolean;
 begin
  if %ID%.Tid=0 then begin
   {
   Initialize separate user task, run it invisible...
   }
   %ID%.Tid:=task_init(%ID%.Server);
   if pos('?',task_ctrl(%ID%.Tid,'HomeDir='+ExtractFilePath(%ID%.Server))
             +task_ctrl(%ID%.Tid,'StdInPipeSize='+str(%ID%.IPipeSize))
             +task_ctrl(%ID%.Tid,'StdOutPipeSize='+str(%ID%.OPipeSize))
             +task_ctrl(%ID%.Tid,'Display=0')
          )>0
   then begin
    Trouble('User task setup error!');
    %ID%_Stop;
   end;
   {
   Run task if one was created...
   }
   if %ID%.Tid>0 then
   if task_run(%ID%.Tid) then begin
    Success('TaskId  = '+str(%ID%.Tid));
    Success('TaskPid = '+str(task_pid(%ID%.Tid)));
    Success('TaskRef = '+str(task_ref(%ID%.Tid)));
    Success('CmdLine = '+task_ctrl(%ID%.Tid,'CmdLine'));
    Success('HomeDir = '+task_ctrl(%ID%.Tid,'HomeDir'));
    Success('PipeIn  = '+task_ctrl(%ID%.Tid,'StdInPipeSize'));
    Success('PipeOut = '+task_ctrl(%ID%.Tid,'StdOutPipeSize'));
    Success('Display = '+task_ctrl(%ID%.Tid,'Display'));
   end else begin
    Trouble('Could not start %ID% Server!');
    %ID%_Stop;
   end;
   {
   Is it Ok with user task? Send preset parameters.
   }
   if %ID%.Tid>0 then
   if task_wait(%ID%.Tid,0) then begin
    %ID%.Line:='';
    %ID%_Send('@ThreadPriority='+ReadIni('ThreadPriority'));
    %ID%_Send('@ProcessPriority='+ReadIni('ProcessPriority'));
    %ID%_Send('@start');
    %ID%.Line:='';
   end else b:=fixerror(errorcode);
  end;
 end;
 {
 %ID% polling.
 }
 procedure %ID%_Poll;
 begin
  { %ID% timer actions... }
  if tm_event(%ID%.Timer) then begin
   %ID%_Send('@memory');
   %ID%_Send('@errors=0');
  end;
 end;
 {
 Analyse data coming from standard input.
 }
 procedure StdIn_Process(s:string);
 begin
  if Length(s)>0 then %ID%_Send(s);
 end;
 {
 Clear all strings
 }
 procedure ClearStrings;
 begin
  StdIn_Line:='';
  winConsole:='';
  %ID%_Clear(false);
  if runcount=1 then fixmaxavail:=maxavail;
  if isinf(runcount) then
  if maxavail<>fixmaxavail then Trouble('String Manager Leak = '+str(fixmaxavail-maxavail));
 end;
 {
 Initialize and check tag
 }      
 procedure InitTag(var tag:integer; name:string; typ:integer);
 begin
  tag:=findtag(name);
  if (typ>0) and (typetag(tag)<>typ) then errors:=errors+1;
 end;
begin
 {
 Initialization actions on Start...
 }
 if runcount=1 then begin
  {
  Initialize errors...
  }
  errors:=0;
  errorcode:=registererr(devname);
  errorterm:=registererr(devname+': terminated.');
  erroriobug:=registererr(devname+': I/O error.');
  {
  Clear and initialize variables...
  }
  ClearStrings;
  DebugFlags:=val(ReadIni('DebugFlags'));
  {
  Open console window...
  }
  if val(ReadIni('OpenConsole'))>0 then begin
   winConsole:=ParamStr('Console '+devname);
   b:=winshow(winConsole);
   b:=windraw(winConsole+'|top=317|left=167|Width=600|Height=317');
   b:=winselect(winConsole);
   if val(ReadIni('OpenConsole'))>1 then b:=winhide(winConsole);
  end;
  {
  Initialize %ID% server...
  }
  Success('%ID% server initialization:');
  %ID%_Init;
  {
  Is it Ok?
  }
  if errors=0 then Success('Start Ok.') else Trouble('Start Fails.');
  if errors<>0 then b:=fixerror(errorcode);
  Ok:=(errors=0);
 end else
 {
 Finalization actions on Stop...
 }
 if isinf(runcount) then begin
  %ID%_Free;
  ClearStrings;
  Success('Stop.');
 end else
 {
 Actions on Poll
 }
 if Ok then begin
  {
  Check standard I/O errors...
  }
  if ioresult<>0 then b:=fixerror(errorcode);
  {
  Process standard input...
  }
  while StdIn_Readln(StdIn_Line) do StdIn_Process(StdIn_Line);
  {
  If %ID% server is not still running,
  try to start %ID% server periodically.
  }
  if %ID%.Tid=0 then
  if tm_event(%ID%.Timer) then %ID%_Start;
  {
  Communicate with %ID% server if one still running...
  }
  if %ID%.Tid>0 then
  if task_wait(%ID%.Tid,0) then begin
   {
   If has data coming from Task StdOut, analyse it...
   }
   if task_rxcount(%ID%.Tid)>0 then
   while %ID%_Readln(%ID%.Line) do %ID%_Process(%ID%.Line);
   {
   %ID% polling.
   }
   %ID%_Poll;
  end else begin
   HostTerm('%ID% terminated, exit code = '+str(task_result(%ID%.Tid)));
   %ID%_Stop;
  end;
 end;
end.
