 {
 ****************************************************************************
 CRW32 project
 Copyright (C) by Kuryakin Alexey, Sarov, Russia, 2005, <kouriakine@mail.ru>
 Asyncronous standard console input and output.
 To be used in robust multi-threaded console applications.
 ****************************************************************************
 Usage example:
  // Recognize @Exit=n command, print message on unrecognized commands
  program Demo;
  const Terminated : Boolean = false;
   procedure DoSpec(const args:LongString);
   begin
    StdOut.Put:='Could not recognize: '+args;
   end;
   procedure DoExit(const cmnd,args:LongString);
   begin
    Terminated:=true;
    System.ExitCode:=StrToIntDef(args,0);
    StdOut.Put:=Format('%s=%d',[cmnd,System.ExitCode]);
   end;
  begin
   StdIn.SpecHandler:=DoSpec;
   StdIn.AddCommand('@Exit',DoExit);
   while not Terminated do begin
    if StdIn.Count>0 then StdIn.Process(StdIn.Get);
   end;
  end;
 ****************************************************************************
 Modifications:
  20051017 - Creation, testing
  20051225 - Fully modified, add Count, Space
  20051226 - Process, AddCommand, ClearCommands, SpecHandler, TimeOut
  20080119 - DefaultStdInTimeOut, DefaultStdOutTimeOut
 ****************************************************************************
 }
unit _ASCIO; // Asynchronous Standard Console Input and Output

{$I _sysdef}

interface

uses
 SysUtils, Windows, Classes, Math, _alloc;

const
 StdIoErrorCount    : LongInt  = 0;     // I/O errors counter
 StdIoCmndPrefChars : TCharSet = ['@']; // Commands prefix chars
 DefaultStdInCapacity          = 65535; // Lines in StdIn  queue
 DefaultStdOutCapacity         = 65535; // Lines in StdOut queue
 DefaultStdInTimeOut           = 1;     // StdIn.TimeOut, ms
 DefaultStdOutTimeOut          = 0;     // StdOut.TimeOut, ms

type
 TStdIoSpecialHandler = procedure (const args:LongString);
 TStdIoCommandHandler = procedure (const cmnd,args:LongString);

 /////////////////////////////////////////////////////////////////////////
 // Asynchronous Input/Output communication thread. For internal use only.
 /////////////////////////////////////////////////////////////////////////
type
 TStdIOThread = class(TThread)
 private
  myLatch    : TLatch;
  myQueue    : TStringList;
  myCapacity : Integer;
  myTimeOut  : Cardinal;
  function    Count:Integer;
  function    Get(var Line:LongString):Boolean;
  function    Put(const Line:LongString):Boolean;
  procedure   Clear;
 public
  constructor Create(aCapacity:Integer);
  destructor  Destroy; override;
 end;

 ///////////////////////////////////////////////////////////////////////////
 // Asynchronous Standard Input communication thread. For internal use only.
 ///////////////////////////////////////////////////////////////////////////
type
 TStdInThread = class(TStdIOThread)
 public
  constructor Create;
  procedure   Execute; override;
 end;

 ////////////////////////////////////////////////////////////////////////////
 // Asynchronous Standard Output communication thread. For internal use only.
 ////////////////////////////////////////////////////////////////////////////
type
 TStdOutThread = class(TStdIOThread)
 public
  constructor Create;
  procedure   Execute; override;
 end;

 ////////////////////////////////////////////////////////////////////////////
 // Asynchronous Standard Input/Output thread wrapper. For internal use only.
 ////////////////////////////////////////////////////////////////////////////
type
 TStdIOWrapper = class(TMasterObject)
 private
  myThread   : TStdIOThread;
  myCmndList : TStringList;
  mySpecHand : TStdIoSpecialHandler;
  function    GetLine:LongString;
  procedure   SetPut(const Line:LongString);
  function    GetCapacity:Integer;
  procedure   SetCapacity(const aCapacity:Integer);
  function    GetPriority:TThreadPriority;
  procedure   SetPriority(const aPriority:TThreadPriority);
  function    GetCount:Integer;
  function    GetSpace:Integer;
  function    GetTimeOut:Cardinal;
  procedure   SetTimeOut(aTimeOut:Cardinal);
  procedure   SetSpecHandler(aSpecHandler:TStdIoSpecialHandler);
 public
  constructor Create;
  destructor  Destroy; override;
  procedure   Clear;
  procedure   ClearCommands;
  function    Process(const data:LongString):Boolean;
  function    AddCommand(const cmnd:LongString; proc:TStdIoCommandHandler):Boolean;
  function    TryGet(var Line:LongString):Boolean;
  function    TryPut(const Line:LongString):Boolean;
  property    Get         : LongString      read  GetLine;
  property    Put         : LongString      write SetPut;
  property    Capacity    : Integer         read  GetCapacity write SetCapacity;
  property    Priority    : TThreadPriority read  GetPriority write SetPriority;
  property    Count       : Integer         read  GetCount;
  property    Space       : Integer         read  GetSpace;
  property    TimeOut     : Cardinal        read  GetTimeOut  write SetTimeOut;
  property    SpecHandler : TStdIoSpecialHandler              write SetSpecHandler;
 end;

 ///////////////////////////////////////////////////////////////
 // Asynchronous Standard Input communication thread wrapper.
 // Readln queue strings from stdin file.
 // Usage like:
 //  if StdIn.TryGet(Line) then Process(Line);
 // or
 //  if StdIn.Count>0 then Process(StdIn.Get);
 // You also may use StdIn.TryPut(Line) and StdIn.Put
 // to simulate input (which normally coming from System.Input).
 ///////////////////////////////////////////////////////////////
type
 TStdIn = class(TStdIOWrapper)
 public
  constructor Create;
 end;

 //////////////////////////////////////////////////////////////////
 // Asynchronous Standard Output communication thread wrapper.
 // Write queue strings into stdout file, then flush stdout buffers
 // to be sure that data really transferred to stdout file.
 // Usage like:
 //  if StdOut.TryPut(Line) then Success;
 // or
 //  if StdOut.Space>0 then StdOut.Put:=Line;
 // You also may use StdOut.TryGet(Line) and StdOut.Get
 // to free output queue (which normally coming to System.Output).
 //////////////////////////////////////////////////////////////////
type
 TStdOut = class(TStdIOWrapper)
 public
  constructor Create;
 end;

function StdIn:TStdIn;

function StdOut:TStdOut;

procedure StdOutEcho(const Msg:LongString);

implementation

 //////////////////////////////
 // TStdIOThread implementation
 //////////////////////////////

constructor TStdIOThread.Create(aCapacity:Integer);
begin
 inherited Create(true);
 myLatch:=NewLatch;
 myQueue:=TStringList.Create;
 myCapacity:=aCapacity;
 Resume;
end;

destructor TStdIOThread.Destroy;
begin
 if not Terminated and not Suspended then begin
  Terminate;
  if myTimeOut>0 then
  if WaitForSingleObject(Handle,myTimeOut)<>WAIT_OBJECT_0 then Suspend;
  if not Suspended then WaitFor;
 end;
 Kill(myQueue);
 Kill(myLatch);
 inherited Destroy;
end;

function TStdIOThread.Count:Integer;
begin
 Result:=0;
 if Assigned(Self) then
 try
  myLatch.Lock;
  try
   if Assigned(myQueue) then Result:=myQueue.Count;
  finally
   myLatch.Unlock;
  end;
 except
  on E:Exception do LockedInc(StdIoErrorCount);
 end;
end;

function TStdIOThread.Get(var Line:LongString):Boolean;
begin
 Line:='';
 Result:=false;
 if Assigned(Self) then
 try
  myLatch.Lock;
  try
   if Assigned(myQueue) then
   if myQueue.Count>0 then begin
    Line:=myQueue[0];
    myQueue.Delete(0);
    Result:=true;
   end;
  finally
   myLatch.Unlock;
  end;
 except
  on E:Exception do LockedInc(StdIoErrorCount);
 end;
end;

function TStdIOThread.Put(const Line:LongString):Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 try
  myLatch.Lock;
  try
   if Assigned(myQueue) then
   if myQueue.Count<myCapacity then begin
    myQueue.Add(Line);
    Result:=true;
   end;
  finally
   myLatch.Unlock;
  end;
 except
  on E:Exception do LockedInc(StdIoErrorCount);
 end;
end;

procedure TStdIOThread.Clear;
begin
 if Assigned(Self) then
 try
  myLatch.Lock;
  try
   if Assigned(myQueue) then myQueue.Clear;
  finally
   myLatch.Unlock;
  end;
 except
  on E:Exception do LockedInc(StdIoErrorCount);
 end;
end;

 //////////////////////////////
 // TStdInThread implementation
 //////////////////////////////

constructor TStdInThread.Create;
begin
 inherited Create(DefaultStdInCapacity);
 myTimeOut:=DefaultStdInTimeOut;
end;

procedure TStdInThread.Execute;
var
 DataS : LongString;
begin
 while not Terminated do
 try
  DataS:='';
  if System.IOResult<>0 then LockedInc(StdIoErrorCount) else
  while not System.Eof(System.Input) and not Terminated do begin
   System.Readln(System.Input,DataS);
   if (System.IOResult<>0) or not Put(DataS) then begin
    LockedInc(StdIoErrorCount);
    Break;
   end;
  end;
  DataS:='';
  Sleep(1);
 except
  on E:Exception do begin
   LockedInc(StdIoErrorCount);
   Sleep(1);
  end;
 end;
end;

 ///////////////////////////////
 // TStdOutThread implementation
 ///////////////////////////////

constructor TStdOutThread.Create;
begin
 inherited Create(DefaultStdOutCapacity);
 myTimeOut:=DefaultStdOutTimeOut;
end;

procedure TStdOutThread.Execute;
var
 nLine : Integer;
 DataS : LongString;
begin
 while not Terminated do
 try
  nLine:=0;
  DataS:='';
  if System.IOResult<>0 then LockedInc(StdIoErrorCount) else
  while Get(DataS) and not Terminated do begin
   System.Writeln(System.Output,DataS);
   if System.IOResult<>0 then begin
    LockedInc(StdIoErrorCount);
    Break;
   end;
   Inc(nLine);
  end;
  if nLine>0 then begin
   System.Flush(System.Output);
   if System.IOResult<>0 then LockedInc(StdIoErrorCount);
  end; 
  DataS:='';
  Sleep(1);
 except
  on E:Exception do begin
   LockedInc(StdIoErrorCount);
   Sleep(1);
  end;
 end;
end;

 ///////////////////////////////
 // TStdIOWrapper implementation
 ///////////////////////////////

constructor TStdIoWrapper.Create;
begin
 inherited Create;
 myCmndList:=TStringList.Create;
 myCmndList.Duplicates:=dupIgnore;
 myCmndList.Sorted:=true;
end;

destructor TStdIOWrapper.Destroy;
begin
 Kill(TObject(myThread));
 Kill(TObject(myCmndList));
 inherited Destroy;
end;

procedure TStdIOWrapper.Clear;
begin
 if Assigned(Self) then myThread.Clear;
end;

procedure TStdIOWrapper.ClearCommands;
begin
 if Assigned(Self) then
 if Assigned(myCmndList) then myCmndList.Clear;
end;

function TStdIOWrapper.Process(const data:LongString):Boolean;
var i,p:Integer; cmnd,args:LongString; proc:Pointer;
begin
 Result:=false;
 if Assigned(Self) then
 try
  if Length(data)>0 then
  if Assigned(myCmndList) then
  if data[1] in StdIoCmndPrefChars then begin
   p:=pos('=',data);
   if p>0 then begin
    cmnd:=Copy(data,1,p-1);
    args:=Copy(data,p+1,Length(data)-p);
   end else begin
    cmnd:=data;
    args:='';
   end;
   i:=myCmndList.IndexOf(cmnd);
   if i>=0 then begin
    proc:=myCmndList.Objects[i];
    if Assigned(proc) then begin
     TStdIoCommandHandler(proc)(cmnd,args);
     Result:=true;
    end;
   end;
  end;
  if not Result then
  if Assigned(mySpecHand) then begin
   mySpecHand(data);
   Result:=true;
  end;
 except
  on E:Exception do begin
   LockedInc(StdIoErrorCount);
   StdOut.Put:=E.Message;
  end;
 end;
end;

function TStdIOWrapper.AddCommand(const cmnd:LongString; proc:TStdIoCommandHandler):Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 if Length(cmnd)>0 then
 if Assigned(myCmndList) then
 if cmnd[1] in StdIoCmndPrefChars then
 if myCmndList.IndexOf(Trim(cmnd))<0 then
 Result:=myCmndList.AddObject(Trim(cmnd),@proc)>=0;
end;

function TStdIOWrapper.TryGet(var Line:LongString):Boolean;
begin
 if Assigned(Self)
 then Result:=myThread.Get(Line)
 else Result:=False;
end;

function TStdIOWrapper.TryPut(const Line:LongString):Boolean;
begin
 if Assigned(Self)
 then Result:=myThread.Put(Line)
 else Result:=False;
end;

procedure TStdIOWrapper.SetPut(const Line:LongString);
begin
 if Assigned(Self) then
 if not myThread.Put(Line) then LockedInc(StdIoErrorCount);
end;

function TStdIOWrapper.GetLine:LongString;
begin
 if Assigned(Self)
 then myThread.Get(Result)
 else Result:='';
end;

function TStdIOWrapper.GetCapacity:Integer;
begin
 if Assigned(Self)
 then Result:=myThread.myCapacity
 else Result:=0;
end;

procedure TStdIOWrapper.SetCapacity(const aCapacity:Integer);
begin
 if Assigned(Self)
 then myThread.myCapacity:=Max(1,aCapacity);
end;

function TStdIOWrapper.GetPriority:TThreadPriority;
begin
 if Assigned(Self)
 then Result:=myThread.Priority
 else Result:=tpNormal;
end;

procedure TStdIOWrapper.SetPriority(const aPriority:TThreadPriority);
begin
 if Assigned(Self)
 then myThread.Priority:=aPriority;
end;

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

function TStdIOWrapper.GetSpace:Integer;
begin
 if Assigned(Self)
 then Result:=Capacity-Count
 else Result:=0;
end;

function TStdIOWrapper.GetTimeOut:Cardinal;
begin
 if Assigned(Self) and Assigned(myThread)
 then Result:=myThread.myTimeOut
 else Result:=0;
end;

procedure TStdIOWrapper.SetTimeOut(aTimeOut:Cardinal);
begin
 if Assigned(Self) and Assigned(myThread)
 then myThread.myTimeOut:=aTimeOut;
end;

procedure TStdIOWrapper.SetSpecHandler(aSpecHandler:TStdIoSpecialHandler);
begin
 if Assigned(Self) then mySpecHand:=aSpecHandler;
end;

 ////////////////////////
 // TStdIn implementation
 ////////////////////////

constructor TStdIn.Create;
begin
 inherited Create;
 myThread:=TStdInThread.Create;
end;

 /////////////////////////
 // TStdOut implementation
 /////////////////////////

constructor TStdOut.Create;
begin
 inherited Create;
 myThread:=TStdOutThread.Create;
end;

 ////////////////////////
 // StdIn implementation
 ////////////////////////

const
 TheStdIn : TStdIn = nil;

function StdIn:TStdIn;
begin
 if not Assigned(TheStdIn) then begin
  TheStdIn:=TStdIn.Create;
  TheStdIn.Master:=TheStdIn;
 end;
 Result:=TheStdIn;
end;

 ////////////////////////
 // StdOut implementation
 ////////////////////////

const
 TheStdOut : TStdOut = nil;

function StdOut:TStdOut;
begin
 if not Assigned(TheStdOut) then begin
  TheStdOut:=TStdOut.Create;
  TheStdOut.Master:=TheStdOut;
 end;
 Result:=TheStdOut;
end;

procedure StdOutEcho(const Msg:LongString);
begin
 StdOut.Put:=TrimRight(Msg);
end;

initialization
 
finalization

 TheStdIn.Free;
 TheStdOut.Free;

end.
