unit Form_PipeTerminal;

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math, lclintf, lcltype, lmessages, Clipbrd,
 graphics, controls, forms, dialogs, stdctrls, extctrls, ActnList, Buttons,
 _crw_alloc, _crw_rtc, _crw_crypt, _crw_str, _crw_ef, _crw_bsencode,
 _crw_utf8, _crw_wmctrl, _crw_pipeio, _crw_pipe, _crw_task, _crw_tcp,
 _crw_uart, _crw_fonts, _crw_appforms, _crw_apptools, _crw_apputils,
 _crw_guiutils;

type

  { TFormPipeTerminal }

  TFormPipeTerminal = class(TMasterForm)
    ActionSend: TAction;
    ActionPipeInfo: TAction;
    ActionOutCopy: TAction;
    ActionOutSelNone: TAction;
    ActionOutSelAll: TAction;
    ActionListTerm: TActionList;
    BitBtnOutCopy: TBitBtn;
    BitBtnOutSelAll: TBitBtn;
    BitBtnOutSelNone: TBitBtn;
    BitBtnPipeInfo: TBitBtn;
    BitBtnSend: TBitBtn;
    ImageListCrw16: TImageList;
    ImageListCrw32: TImageList;
    PanelButtons: TPanel;
    PanelMain: TPanel;
    GroupBoxInput: TGroupBox;
    ComboBoxInput: TComboBox;
    GroupBoxOutput: TGroupBox;
    MemoOutput: TMemo;
    Timer55: TTimer;
    procedure ActionOutCopyExecute(Sender: TObject);
    procedure ActionOutSelAllExecute(Sender: TObject);
    procedure ActionOutSelNoneExecute(Sender: TObject);
    procedure ActionPipeInfoExecute(Sender: TObject);
    procedure ActionSendExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer55Timer(Sender: TObject);
    procedure ComboBoxInputDblClick(Sender: TObject);
    procedure ComboBoxInputKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    myPipe    : Integer;
    myCaption : ShortString;
    myOptions : Integer;
    myClosing : Integer;
    myUpdate  : Double;
    procedure HandleInputLine;
    procedure PutText(const s:LongString);
  public
    { Public declarations }
    function UsesEol:LongString;
  end;

procedure OpenPipeTerminal(const Params:LongString);

const
 to_CloseTimeut : Integer = 7000;        // Delay to auto close window
 to_HistoryLeng : Integer = 1024;        // Maximal number of lines

implementation

{$R *.lfm}

const                          // Term options
 to_Oem2AnsiRx  = $00000001;   // a - Convert Rx from Oem to Ansi
 to_Ansi2OemTx  = $00000002;   // a - Convert Tx from Ansi to Oem
 to_Display     = $00000004;   // d - Display piped window
 to_Verbose     = $00000008;   // v - Verbose mode
 to_CheckSum    = $00000010;   // n - Use check sum DCON
 to_AutoClose   = $00000020;   // c - Auto close window on connection lost
 to_HexDump     = $00000040;   // x - Output as HEX dump
 to_UrlDump     = $00000080;   // l - Output as URL dump
 to_BShDump     = $00000100;   // s - Output as B\S dump
 to_HexConv     = $00000200;   // h - Input  as HEX encoded
 to_UrlConv     = $00000400;   // u - Input  as URL encoded
 to_BshConv     = $00000800;   // b - Input  as B\S encoded
 to_EolCrLf     = $00001000;   // w - Use EOL as CRLF (Windows like)
 to_EolLf       = $00002000;   // f - Use EOL as LF   (Unix like)
 to_EolCr       = $00004000;   // r - Use EOL as CR   (MAC like)
 to_EchoMode    = $10000000;   // e - Echo Input->Uutput

function LoggerIter(n:SizeInt; Line:LongString; Custom:Pointer):Boolean;
begin
 Result:=true;
 if not Assigned(Custom) then Exit(false);
 writeln(ShortString(Custom^),Line);
 if (n=0) and (ShortString(Custom^)<>'')
 then ShortString(Custom^):=StringOfChar('=',Length(StdDateTimeFormatMs))+' => ';
end;

procedure LogEvents(When:Double; What:LongString);
var prompt:ShortString;
begin
 if IsEmptyStr(What) then Exit; prompt:='';
 if (When>0) then prompt:=FormatDateTime(StdDateTimeFormatMs,When) else
 if (When=0) then prompt:=StringOfChar('=',Length(StdDateTimeFormatMs));
 if (prompt<>'') then prompt:=prompt+' => ';
 ForEachStringLine(What,LoggerIter,@prompt);
end;

procedure myPipeReporter(Pipe:TPipe; When:Double; const What:LongString; Code:Integer);
begin
 if (When>0) then When:=MsToOleTime(When);
 LogEvents(When,Pipe.Polling.Name+': '+What+', '+SysErrorMessage(Code));
end;

procedure mySockReporter(Pipe:TSocketPipe; When:Double; What:PChar; Code:Integer);
begin
 if (When>0) then When:=MsToOleTime(When);
 LogEvents(When,Pipe.Polling.Name+': '+What+', '+SysErrorMessage(Code));
end;

procedure OpenPipeTerminal(const Params:LongString);
var FormPipeTerminal:TFormPipeTerminal;
var opt:Integer; arg,w1,msg:LongString;
var sr:TSocketReporter;
var pr:TPipeReporter;
begin
 arg:=Trim(Params);
 Application.CreateForm(TFormPipeTerminal, FormPipeTerminal);
 FormPipeTerminal.myCaption:=arg;
 if not IsEmptyStr(arg) then begin
  opt:=0;
  while IsOption(arg) do begin
   w1:=ExtractWord(1,arg,ScanSpaces);
   if HasChars(w1,'a') then opt:=opt or to_Oem2AnsiRx;
   if HasChars(w1,'a') then opt:=opt or to_Ansi2OemTx;
   if HasChars(w1,'c') then opt:=opt or to_AutoClose;
   if HasChars(w1,'e') then opt:=opt or to_EchoMode;
   if HasChars(w1,'n') then opt:=opt or to_CheckSum;
   if HasChars(w1,'d') then opt:=opt or to_Display;
   if HasChars(w1,'v') then opt:=opt or to_Verbose;
   if HasChars(w1,'h') then opt:=opt or to_HexConv;
   if HasChars(w1,'u') then opt:=opt or to_UrlConv;
   if HasChars(w1,'b') then opt:=opt or to_BshConv;
   if HasChars(w1,'x') then opt:=opt or to_HexDump;
   if HasChars(w1,'l') then opt:=opt or to_UrlDump;
   if HasChars(w1,'s') then opt:=opt or to_BshDump;
   if HasChars(w1,'w') then opt:=opt or to_EolCrLf;
   if HasChars(w1,'f') then opt:=opt or to_EolLf;
   if HasChars(w1,'r') then opt:=opt or to_EolCr;
   arg:=SkipWords(1,arg,ScanSpaces);
  end;
  FormPipeTerminal.myOptions:=opt;
 end;
 if HasFlags(FormPipeTerminal.myOptions,to_Verbose) then pr:=myPipeReporter else pr:=nil;
 if HasFlags(FormPipeTerminal.myOptions,to_Verbose) then sr:=mySockReporter else sr:=nil;
 FormPipeTerminal.myPipe:=pipe_init(arg,pr,sr);
 pipe_run(FormPipeTerminal.myPipe);
 msg:='Run: '+arg;
 if SameText(ExtractWord(1,arg,ScanSpaces),'task')
 then msg:=msg+EOL+'PID '+IntToStr(pipe_pid(FormPipeTerminal.myPipe));
 LogEvents(Now,msg);
 FormPipeTerminal.Show;
 FormPipeTerminal.BringToFront;
 if (pipe_ref(FormPipeTerminal.myPipe) is TSocketPipe) then begin
  FormPipeTerminal.ComboBoxInput.Items.Add('GET / HTTP/1.0%0D%0AAccept: text/html%0D%0A%0D%0A');
  FormPipeTerminal.ComboBoxInput.Items.Add('GET /index.htm HTTP/1.0%0D%0AAccept: text/html%0D%0A%0D%0A');
  FormPipeTerminal.ComboBoxInput.Items.Add('GET /index.html HTTP/1.0%0D%0AAccept: text/html%0D%0A%0D%0A');
 end;
end;

function AddAdamCheckSumm(const s:LongString):LongString;
var i,L:Integer; b:Byte;
begin
 Result:='';
 try
  b:=0; L:=Length(s);
  for i:=1 to L do
  case s[i] of
   ASCII_CR: begin Result:=Result+HexB(b)+Copy(s,i,L-i+1); Break; end;
   ASCII_LF: begin Result:=Result+HexB(b)+Copy(s,i,L-i+1); Break; end;
   else      begin Result:=Result+s[i]; b:=b+ord(s[i]); end;
  end;
 except
  on E:Exception do BugReport(E,nil,'AddAdamCheckSumm');
 end;
end;

function HexDump(const s:LongString):LongString;
var i,j,k:Integer;
 function GoodChar(c:Char):Char;
 begin
  if c<' ' then Result:=' ' else Result:=c;
 end;
begin
 Result:='';
 try
  for i:=1 to AdjustBufferSize(Length(s),16) div 16 do begin
   for j:=1 to 16 do begin
    k:=1+(i-1)*16+(j-1);
    if k<=Length(s)
    then Result:=Result+' '+HexB(ord(s[k]))
    else Result:=Result+'   ';
   end;
   Result:=Result+' | ';
   for j:=1 to 16 do begin
    k:=1+(i-1)*16+(j-1);
    if k<=Length(s)
    then Result:=Result+GoodChar(s[k])
    else Result:=Result+' ';
   end;
   Result:=Result+EOL;
  end;
 except
  on E:Exception do BugReport(E,nil,'HexDump');
 end;
end;

function UrlDump(const s:LongString):LongString;
begin
 Result:=url_packed(s);
end;

function BshDump(const s:LongString):LongString;
begin
 Result:=backslash_encode(s);
end;

function HexConv(const s:LongString):LongString;
begin
 Result:='';
 try
  Result:=hex_decode(s);
 except
  on E:Exception do BugReport(E,nil,'HexConv');
 end;
end;

function UrlConv(const s:LongString):LongString;
begin
 Result:='';
 try
  Result:=url_decode(s);
 except
  on E:Exception do BugReport(E,nil,'UrlConv');
 end;
end;

function BshConv(const s:LongString):LongString;
begin
 Result:='';
 try
  Result:=backslash_decode(s);
 except
  on E:Exception do BugReport(E,nil,'BshConv');
 end;
end;

procedure InputFilter(aConsole:TFormPipeTerminal; aText:LongString);
var i,p,e:Integer; s:LongString;
begin
 try
  if Length(aText)>0 then
  if (aConsole is TFormPipeTerminal) then
  with TFormPipeTerminal(aConsole) do begin
   e:=0;
   s:=aText;
   if HasFlags(myOptions,to_UrlConv) then s:=UrlConv(s) else
   if HasFlags(myOptions,to_HexConv) then s:=HexConv(s) else
   if HasFlags(myOptions,to_BshConv) then s:=BshConv(s);
   if HasFlags(myOptions,to_Ansi2OemTx) then s:=StrAnsiToOem(s);
   if HasFlags(myOptions,to_CheckSum) then s:=AddAdamCheckSumm(s);
   for i:=0 to pipe_count(myPipe)-1 do begin
    p:=pipe_stream(myPipe,i);
    if (pipe_connected(p)>0) then Inc(e,ord(pipe_send(p,s)<Length(s)));
   end;
   if (e>0) then PutText('Send error!)'+EOL);
  end;
 except
  on E:Exception do BugReport(E,nil,'InputFilter');
 end;
end;

function MemoLinesIter(n:SizeInt; Line:LongString; Custom:Pointer):Boolean;
begin
 Result:=true;
 if not Assigned(Custom) then Exit(false);
 if (Line<>'') and not IsLexeme(Line,lex_utf8)
 then Line:=utf8_fixbroken(Line);
 TMemo(Custom).Lines.Add(Line);
end;

procedure TFormPipeTerminal.PutText(const s:LongString);
begin
 if (s<>'') then
 try
  MemoOutput.Lines.BeginUpdate;
  try
   ForEachStringLine(s,MemoLinesIter,MemoOutput);
   if (MemoOutput.Lines.Count>to_HistoryLeng*1.5) then
   while (MemoOutput.Lines.Count>to_HistoryLeng) do MemoOutput.Lines.Delete(0);
  finally
   MemoOutput.Lines.EndUpdate;
   MemoOutput.SelStart:=MaxInt;
   MemoOutput.SelLength:=0;
  end;
 except
  on E:Exception do BugReport(E,nil,'PutText');
 end;
end;

procedure TFormPipeTerminal.FormCreate(Sender: TObject);
begin
 inherited;
 SetDefaultMonoFontName(Font);
 SetButtonCursorToHandPoint(Self);
end;

procedure TFormPipeTerminal.FormDestroy(Sender: TObject);
begin
 pipe_free(myPipe);
 myPipe:=0;
 inherited;
end;

procedure TFormPipeTerminal.Timer55Timer(Sender: TObject);
var i,p,n,nmax:Integer; s:LongString;
begin
 if Assigned(Self) then
 try
  for i:=0 to pipe_count(myPipe)-1 do begin
   p:=pipe_stream(myPipe,i);
   s:=pipe_recv(p,pipe_rxcount(p));
   if (s<>'') then begin
    if HasFlags(myOptions,to_Oem2AnsiRx) then s:=StrOemToAnsi(s);
    if HasFlags(myOptions,to_HexDump) then s:=HexDump(s) else
    if HasFlags(myOptions,to_UrlDump) then s:=UrlDump(s) else
    if HasFlags(myOptions,to_BshDump) then s:=BshDump(s);
    PutText(s);
   end;
  end;
  if (msecnow-myUpdate>TSocketPipe.DefTimeout) then begin
   myUpdate:=msecnow;
   n:=pipe_connected(myPipe);
   s:=Format('%d',[n]);
   if (n>0) then begin
    if (pipe_ref(myPipe) is TTask) then begin
     s:=Format('task#%d',[pipe_pid(myPipe)]);
    end else
    if (pipe_ref(myPipe) is TSocketPipe) then begin
     if (n<4) then begin
      s:='';
      for i:=0 to pipe_count(myPipe)-1 do
      if (pipe_connected(pipe_stream(myPipe,i))>0) then begin
       if Length(s)>0 then s:=s+',';
       s:=s+pipe_ctrl(pipe_stream(myPipe,i),'PeerIP');
      end;
     end;
    end;
   end;
   Caption:=Format('PipeTerminal %s - [Connected: %s]',[myCaption,s]);
  end;
  if HasFlags(myOptions,to_AutoClose) then begin
   nmax:=(to_CloseTimeut div Max(1,Timer55.Interval));
   if (pipe_connected(myPipe)>0) then myClosing:=0 else Inc(myClosing);
   if (myClosing>nmax) then Close;
  end; 
 except
  on E:Exception do BugReport(E,nil,'Timer55Timer');
 end;
end;

function TFormPipeTerminal.UsesEol:LongString;
begin
 if HasFlags(myOptions,to_EolCrLf) then Result:=CRLF     else
 if HasFlags(myOptions,to_EolLf)   then Result:=ASCII_LF else
 if HasFlags(myOptions,to_EolCr)   then Result:=ASCII_CR else
 Result:=EOL;
end;

procedure TFormPipeTerminal.HandleInputLine;
var Line:LongString;
begin
 try
  Line:=ComboBoxInput.Text;
  RecordComboBoxHistory(ComboBoxInput,MaxInt);
  if HasFlags(myOptions,to_EchoMode) then begin
   if (pipe_ref(myPipe) is TTask)
   then PutText(':> '+Line)
   else PutText(':> '+Line);
  end;
  InputFilter(Self,Line+UsesEOL);
  ComboBoxInput.Text:='';
 except
  on E:Exception do BugReport(E,nil,'HandleInputLine');
 end;
end;

procedure TFormPipeTerminal.ActionSendExecute(Sender: TObject);
begin
 HandleInputLine;
end;

procedure TFormPipeTerminal.ComboBoxInputDblClick(Sender: TObject);
begin
 inherited;
 HandleInputLine;
end;

procedure TFormPipeTerminal.ComboBoxInputKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
 case Key of
  VK_RETURN : HandleInputLine;
 end;
end;

procedure TFormPipeTerminal.ActionOutSelAllExecute(Sender: TObject);
begin
 MemoOutput.SelectAll;
end;

procedure TFormPipeTerminal.ActionOutCopyExecute(Sender: TObject);
begin
 if (MemoOutput.Lines.Count>0) then
 try
  if (MemoOutput.SelLength>0)
  then MemoOutput.CopyToClipboard
  else Clipboard.AsText:=MemoOutput.Text;
 except
  on E:Exception do BugReport(E,nil,'ActionOutCopyExecute');
 end;
end;

procedure TFormPipeTerminal.ActionOutSelNoneExecute(Sender: TObject);
begin
 MemoOutput.SelLength:=0;
end;

procedure TFormPipeTerminal.ActionPipeInfoExecute(Sender: TObject);
var txt:TText;
begin
 if (myPipe<>0) then
 try
  txt:=NewText;
  try
   if (pipe_ref(myPipe) is TTask) then begin
    LogEvents(Now,Caption+EOL+SortTextLines(pipe_ctrl(myPipe,'?')));
   end;
   if (pipe_ref(myPipe) is TPipe) then begin
    LogEvents(Now,Caption+EOL+SortTextLines(pipe_ctrl(myPipe,'?')));
    LogEvents(Now,'Properties:'+EOL+TPipe(pipe_ref(myPipe)).GetProperties);
   end;
   if (pipe_ref(myPipe) is TSocketPipe) then begin
    LogEvents(Now,Caption+EOL+SortTextLines(pipe_ctrl(myPipe,'?')));
    LogEvents(Now,'Properties:'+EOL+TSocketPipe(pipe_ref(myPipe)).GetProperties);
   end;
   if (pipe_ref(myPipe) is TUartPort) then begin
    LogEvents(Now,Caption+EOL+SortTextLines(pipe_ctrl(myPipe,'?')));
    LogEvents(Now,'Properties:'+EOL+TUartPort(pipe_ref(myPipe)).GetProperties(txt).Text);
   end;
  finally
   Kill(txt);
  end;
 except
  on E:Exception do BugReport(E,nil,'ActionPipeInfoExecute');
 end;
end;

procedure TFormPipeTerminal.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 LogEvents(Now,'Closed: '+Caption);
 Action:=caFree;
end;

end.
