unit form_pipeterm;

{$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 !!!
 //////////////////////////////////////////////////////
 Classes, SysUtils, StrUtils, Math, Forms, Controls, Graphics, Dialogs,
 ExtCtrls, StdCtrls, ComCtrls, Buttons, Spin, Menus, FileUtil, process,
 lcltype, ActnList, Clipbrd,
 {$IFDEF UNIX} Unix, BaseUnix, Linux, termio, {$ENDIF}
 _crw_alloc, _crw_cmdargs, _crw_environ, _crw_zm, _crw_fifo, _crw_ascio,
 _crw_base32, _crw_base64, _crw_sort, _crw_fpu, _crw_lsqpoly, _crw_ef,
 _crw_plut, _crw_fft, _crw_fft24, _crw_delauna, _crw_guiutils, _crw_svd,
 _crw_spline, _crw_proc, _crw_rtc, _crw_dynar, _crw_simplex, _crw_hash,
 _crw_crypt, _crw_utf8, _crw_str, _crw_hl, _crw_bsencode, _crw_funmin,
 _crw_lsqmin, _crw_colors, _crw_fsm, _crw_fio, _crw_polling, _crw_meta,
 _crw_daqtags, _crw_rtdtc, _crw_couple, _crw_th123, _crw_riff, _crw_snd,
 _crw_mmt, _crw_ee, _crw_syscal, _crw_curves, _crw_daqevnt, _crw_calib,
 _crw_dim, _crw_dimq, _crw_dimc, _crw_dims, _crw_az, _crw_cgi, _crw_lmd,
 _crw_spcfld, _crw_guard, _crw_spk, _crw_pio, _crw_pkk4, _crw_i8255,
 pcrelib, perlregex, _crw_regexp, _crw_serio, _crw_wine, _crw_vbox,
 _crw_uart, _crw_eldraw, _crw_uac, _crw_sysid, _crw_lm, _crw_wmctrl,
 _crw_adodb_tlb, _crw_dbcon, _crw_opc, _crw_opcc, _crw_netif,
 _crw_smirtl, _crw_smiuirtl, _crw_pipe, _crw_tcp, _crw_pipeio,
 _crw_assoc, _crw_apputils, _crw_appforms, _crw_apptools,
 _crw_sharm, _crw_task, _crw_sesman, _crw_fonts,
 form_pipeterminal;

type

  { TFormPipeTerm }

  TFormPipeTerm = class(TMasterForm)
    ActionLogCopy: TAction;
    ActionLogSelNone: TAction;
    ActionLogSelAll: TAction;
    ActionComTable: TAction;
    ActionOpenCom: TAction;
    ActionOpenTcp: TAction;
    ActionOpenPipe: TAction;
    BitBtnComTable: TBitBtn;
    BitBtnLogCopy: TBitBtn;
    BitBtnLogSelAll: TBitBtn;
    BitBtnLogSelNone: TBitBtn;
    BitBtnOpenCom: TBitBtn;
    BitBtnOpenPipe: TBitBtn;
    BitBtnOpenTcp: TBitBtn;
    BitBtnTaskRun: TBitBtn;
    CheckBoxPipeClient: TCheckBox;
    CheckBoxPipeServer: TCheckBox;
    CheckBoxTcpClient: TCheckBox;
    CheckBoxTcpServer: TCheckBox;
    CheckBoxTermOptionsV: TCheckBox;
    ComboBoxBaudRate: TComboBox;
    ComboBoxCloseTimeout: TComboBox;
    ComboBoxComPort: TComboBox;
    ComboBoxDataBits: TComboBox;
    ComboBoxLogHistory: TComboBox;
    ComboBoxOptEol: TComboBox;
    ComboBoxParity: TComboBox;
    ComboBoxPipeHost: TComboBox;
    ComboBoxStopBits: TComboBox;
    ComboBoxTaskCmdLine: TComboBox;
    ComboBoxTcpHost: TComboBox;
    EditDcbFlags: TEdit;
    GroupBoxParams: TGroupBox;
    LabelCloseTimeout: TLabel;
    LabelDataBits: TLabel;
    EditPipeName: TEdit;
    GroupBoxCom: TGroupBox;
    GroupBoxPipe: TGroupBox;
    GroupBoxTask: TGroupBox;
    GroupBoxTcp: TGroupBox;
    LabelBaudRate: TLabel;
    LabelComPort: TLabel;
    LabelDcbFlags: TLabel;
    LabelLogHistory: TLabel;
    LabelNamedPipe: TLabel;
    LabelOptEol: TLabel;
    LabelParity: TLabel;
    LabelStopBits: TLabel;
    LabelTcpPort: TLabel;
    SpinEditTcpPort: TSpinEdit;
    TabSheetParams: TTabSheet;
    TabSheetTcp: TTabSheet;
    TabSheetCom: TTabSheet;
    TabSheetPipe: TTabSheet;
    TimerPolling1000: TTimer;
    TimerPolling50: TTimer;
    ImageListCrw16: TImageList;
    ImageListCrw32: TImageList;
    ActionListPipe: TActionList;
    ActionOpenTask: TAction;
    PanelControls: TPanel;
    PanelParams: TPanel;
    PageControlParams: TPageControl;
    TabSheetTask: TTabSheet;
    TabSheetOptions: TTabSheet;
    GroupBoxTermOptions: TGroupBox;
    CheckBoxTermOptionsA: TCheckBox;
    CheckBoxTermOptionsC: TCheckBox;
    CheckBoxTermOptionsE: TCheckBox;
    CheckBoxTermOptionsH: TCheckBox;
    CheckBoxTermOptionsU: TCheckBox;
    CheckBoxTermOptionsB: TCheckBox;
    CheckBoxTermOptionsX: TCheckBox;
    CheckBoxTermOptionsL: TCheckBox;
    CheckBoxTermOptionsS: TCheckBox;
    CheckBoxTermOptionsN: TCheckBox;
    PanelPipeLog: TPanel;
    GroupBoxPipeLog: TGroupBox;
    MemoPipeLog: TMemo;
    PanelPipeLogButtons: TPanel;
    procedure ActionComTableExecute(Sender: TObject);
    procedure ActionLogCopyExecute(Sender: TObject);
    procedure ActionLogSelAllExecute(Sender: TObject);
    procedure ActionLogSelNoneExecute(Sender: TObject);
    procedure ActionOpenComExecute(Sender: TObject);
    procedure ActionOpenPipeExecute(Sender: TObject);
    procedure ActionOpenTaskExecute(Sender: TObject);
    procedure ActionOpenTcpExecute(Sender: TObject);
    procedure ComboBoxCloseTimeoutChange(Sender: TObject);
    procedure ComboBoxLogHistoryChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure TimerPolling1000Timer(Sender: TObject);
    procedure TimerPolling50Timer(Sender: TObject);
  private
    ZStamp : LongString;
    procedure PollStdIo;
    procedure AdjustComponents;
    procedure PutText(const s:LongString);
    procedure TakeOptions(var opt:LongString; list:LongString);
  public
    procedure AddLog(When:TDateTime; Msg:LongString);
  end;

var
  FormPipeTerm: TFormPipeTerm = nil;

function StartSession(arg:LongString):Boolean;

implementation

{$R *.lfm}

{ TFormPipeTerm }

procedure TFormPipeTerm.FormCreate(Sender: TObject);
begin
 inherited;
 FormCenterToScreen(Self,0,0);
 SetDefaultMonoFontName(Font);
 SetButtonCursorToHandPoint(Self);
 PageControlParams.ActivePage:=TabSheetTask;
 AdjustComponents;
end;

procedure TFormPipeTerm.FormDestroy(Sender: TObject);
begin
 inherited;
end;

procedure TFormPipeTerm.AdjustComponents;
begin
 if IsWindows then begin
  ComboBoxTaskCmdLine.Items.Clear;
  ComboBoxTaskCmdLine.Items.Add('cmd');
  ComboBoxTaskCmdLine.Items.Add('taskmgr');
  ComboBoxTaskCmdLine.Items.Add('ping /t localhost');
  ComboBoxTaskCmdLine.Items.Add('ping /t '+HostName);
  ComboBoxTaskCmdLine.Items.Add('cmd /c start notepad.exe');
  ComboBoxTaskCmdLine.Items.Add('cmd /c start mspaint.exe');
  ComboBoxTaskCmdLine.Items.Add('cmd /c net user Administrator /active:yes');
  ComboBoxTaskCmdLine.Items.Add('cmd /c net user Администратор /active:yes');
  ComboBoxTaskCmdLine.Text:='cmd';
 end;
 if IsUnix then begin
  ComboBoxTaskCmdLine.Items.Clear;
  ComboBoxTaskCmdLine.Items.Add('sh');
  ComboBoxTaskCmdLine.Items.Add('cat');
  ComboBoxTaskCmdLine.Items.Add('bash');
  ComboBoxTaskCmdLine.Text:='bash';
 end;
 ComboBoxPipeHost.Clear;
 ComboBoxPipeHost.Items.Add('.');
 ComboBoxPipeHost.Items.Add('localhost');
 ComboBoxPipeHost.Items.Add('127.0.0.1');
 ComboBoxPipeHost.Items.Add(HostName);
 ComboBoxPipeHost.Text:='localhost';
 ComboBoxTcpHost.Clear;
 ComboBoxTcpHost.Items.Add('localhost');
 ComboBoxTcpHost.Items.Add('127.0.0.1');
 ComboBoxTcpHost.Items.Add(HostName);
 ComboBoxTcpHost.Text:='localhost';
 ComboBoxComPort.Items.Text:=SerPortMap.ListComNames;
 if (ComboBoxComPort.Items.Count>0) then ComboBoxComPort.ItemIndex:=0;
 ComboBoxBaudRate.Items.Text:=SerListValidBaudRate(EOL);
 ComboBoxBaudRate.ItemIndex:=ComboBoxBaudRate.Items.IndexOf('9600');
 ComboBoxParity.Items.Text:=StringReplace(UpperCase(SerListValidParity(EOL)),'PARITY','',[rfReplaceAll]);
 ComboBoxParity.ItemIndex:=ComboBoxParity.Items.IndexOf('NONE');
 ComboBoxDataBits.Items.Text:=SerListValidByteSize(EOL);
 ComboBoxDataBits.ItemIndex:=ComboBoxDataBits.Items.IndexOf('8');
 ComboBoxStopBits.Items.Text:=SerListValidStopBits(EOL);
 ComboBoxStopBits.ItemIndex:=ComboBoxStopBits.Items.IndexOf('1');
end;

procedure TFormPipeTerm.TimerPolling1000Timer(Sender: TObject);
begin
 try
  SecondActions.Execute;
 except
  on E:Exception do BugReport(E,Self,'TimerPolling1000Timer');
 end;
end;

procedure TFormPipeTerm.TimerPolling50Timer(Sender: TObject);
begin
 try
  Tick55Actions.Execute;
  PollStdIo;
 except
  on E:Exception do BugReport(E,Self,'TimerPolling50Timer');
 end;
end;

procedure TFormPipeTerm.PollStdIo;
begin
 if (StdOutputFifo.Count>0) then PutText(StdOutputFifo.GetText);
 if (StdErrOutputFifo.Count>0) then PutText(StdErrOutputFifo.GetText);
 if (SystemCalculator.Fifo.Count>0) then PutText(SystemCalculator.Fifo.GetText);
end;

procedure TFormPipeTerm.TakeOptions(var opt:LongString; list:LongString);
begin
 if HasChars(list,'a') and CheckBoxTermOptionsA.Checked then opt:='-a '+opt;
 if HasChars(list,'c') and CheckBoxTermOptionsC.Checked then opt:='-c '+opt;
 if HasChars(list,'e') and CheckBoxTermOptionsE.Checked then opt:='-e '+opt;
 if HasChars(list,'h') and CheckBoxTermOptionsH.Checked then opt:='-h '+opt;
 if HasChars(list,'u') and CheckBoxTermOptionsU.Checked then opt:='-u '+opt;
 if HasChars(list,'b') and CheckBoxTermOptionsB.Checked then opt:='-b '+opt;
 if HasChars(list,'x') and CheckBoxTermOptionsX.Checked then opt:='-x '+opt;
 if HasChars(list,'l') and CheckBoxTermOptionsL.Checked then opt:='-l '+opt;
 if HasChars(list,'s') and CheckBoxTermOptionsS.Checked then opt:='-s '+opt;
 if HasChars(list,'v') and CheckBoxTermOptionsV.Checked then opt:='-v '+opt;
 if HasChars(list,'n') and CheckBoxTermOptionsN.Checked then opt:='-n '+opt;
 if HasChars(list,'w') and (ComboBoxOptEol.ItemIndex=1) then opt:='-w '+opt;
 if HasChars(list,'f') and (ComboBoxOptEol.ItemIndex=2) then opt:='-f '+opt;
 if HasChars(list,'r') and (ComboBoxOptEol.ItemIndex=3) then opt:='-r '+opt;
end;

procedure TFormPipeTerm.ActionOpenTaskExecute(Sender: TObject);
var opt,task:LongString;
begin
 try
  opt:=''; task:='';
  if not IsEmptyStr(ComboBoxTaskCmdLine.Text) then begin
   TakeOptions(opt,'acehubxls');
   task:='task '+Trim(ComboBoxTaskCmdLine.Text);
   OpenPipeTerminal(Trim(opt+' '+task));
   RecordComboBoxHistory(ComboBoxTaskCmdLine,MaxInt);
  end;
 except
  on E:Exception do BugReport(E,Self,'ActionOpenTaskExecute');
 end;
end;

procedure TFormPipeTerm.ActionOpenPipeExecute(Sender: TObject);
var opt,server,client:LongString;
begin
 try
  opt:=''; server:=''; client:='';
  if not IsEmptyStr(EditPipeName.Text) then begin
   TakeOptions(opt,'cehubxlsvnwfr');
   server:='pipe '+Trim(EditPipeName.Text);
   client:='pipe '+Trim(ComboBoxPipeHost.Text)+PathDelim+Trim(EditPipeName.Text);
   if CheckBoxPipeServer.Checked then OpenPipeTerminal(Trim(opt+' '+server));
   if CheckBoxPipeClient.Checked then OpenPipeTerminal(Trim(opt+' '+client));
  end;
 except
  on E:Exception do BugReport(E,Self,'ActionOpenPipeExecute');
 end;
end;

procedure TFormPipeTerm.ActionOpenTcpExecute(Sender: TObject);
var opt,server,client:LongString;
begin
 try
  opt:=''; server:=''; client:='';
  if (SpinEditTcpPort.Value>0) then begin
   TakeOptions(opt,'cehubxlsvnwfr');
   server:='tcp port '+IntToStr(SpinEditTcpPort.Value)+' server 8';
   client:='tcp port '+IntToStr(SpinEditTcpPort.Value)+' client '+Trim(ComboBoxTcpHost.Text);
   if CheckBoxTcpServer.Checked then OpenPipeTerminal(Trim(opt+' '+server));
   if CheckBoxTcpClient.Checked then OpenPipeTerminal(Trim(opt+' '+client));
   RecordComboBoxHistory(ComboBoxTcpHost,MaxInt);
  end;
 except
  on E:Exception do BugReport(E,Self,'ActionOpenTcpExecute');
 end;
end;

procedure TFormPipeTerm.ComboBoxCloseTimeoutChange(Sender: TObject);
var timeout:Integer;
begin
 if TryStrToInt(Trim(ComboBoxCloseTimeout.Text),timeout) then
 if InRange(timeout,1,300) then to_CloseTimeut:=timeout*1000;
end;

procedure TFormPipeTerm.ComboBoxLogHistoryChange(Sender: TObject);
var leng:Integer;
begin
 if TryStrToInt(Trim(ComboBoxLogHistory.Text),leng) then
 if InRange(leng,16,65536) then to_HistoryLeng:=leng;

end;

procedure TFormPipeTerm.ActionOpenComExecute(Sender: TObject);
var opt,com:LongString;
begin
 try
  opt:=''; com:='';
  if not IsEmptyStr(ComboBoxComPort.Text) then begin
   TakeOptions(opt,'cehubxlsnwfr');
   com:='com port '+StringReplace(Trim(ComboBoxComPort.Text),'COM','',[]);
   com:=com+' baudrate '+Trim(ComboBoxBaudRate.Text);
   com:=com+' parity '+Trim(ComboBoxParity.Text);
   com:=com+' databits '+Trim(ComboBoxDataBits.Text);
   com:=com+' stopbits '+Trim(ComboBoxStopBits.Text);
   com:=com+' dcbflags '+Trim(EditDcbFlags.Text);
   OpenPipeTerminal(Trim(opt+' '+com));
  end;
 except
  on E:Exception do BugReport(E,Self,'ActionOpenComExecute');
 end;
end;

procedure TFormPipeTerm.ActionComTableExecute(Sender: TObject);
begin
 AddLog(Now,'COM Ports Table:'+EOL+SerPortMap.Table);
end;

procedure TFormPipeTerm.ActionLogSelAllExecute(Sender: TObject);
begin
 MemoPipeLog.SelectAll;
end;

procedure TFormPipeTerm.ActionLogSelNoneExecute(Sender: TObject);
begin
 MemoPipeLog.SelLength:=0;
end;

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

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 TFormPipeTerm.AddLog(When:TDateTime; Msg:LongString);
begin
 if (Msg<>'') then
 try
  LogEvents(When,Msg);
 except
  on E:Exception do BugReport(E,nil,'AddLog');
 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 TFormPipeTerm.PutText(const s:LongString);
begin
 if (s<>'') then
 try
  MemoPipeLog.Lines.BeginUpdate;
  try
   ForEachStringLine(s,MemoLinesIter,MemoPipeLog);
   if (MemoPipeLog.Lines.Count>to_HistoryLeng*1.5) then
   while (MemoPipeLog.Lines.Count>to_HistoryLeng) do MemoPipeLog.Lines.Delete(0);
  finally
   MemoPipeLog.Lines.EndUpdate;
   MemoPipeLog.SelStart:=MaxInt;
   MemoPipeLog.SelLength:=0;
  end;
 except
  on E:Exception do BugReport(E,nil,'PutText');
 end;
end;

 {
 Session related routines.
 }

procedure PipeTermEcho(const Msg:LongString);
begin
 StandardEchoProcedure(Msg);
end;

procedure MyBlasterLogger(const Msg:LongString);
begin
 if (Msg<>'') then write(Msg);
end;

function PipeTermSendToMainConsole(const Msg:LongString):Integer;
begin
 Result:=Length(Msg);
 Echo(Msg);
end;

 {
 Start session:
 if StartSession('1')   then ... - run single instance - session 1.
 if StartSession('$ 1') then ... - use option --session N or run session 1.
 if StartSession('? 9') then ... - run first found free session in range [1..9].
 }
function StartSession(arg:LongString):Boolean;
begin
 Result:=SessionManager.Start(arg);
 if Result then begin
  SessionManager.RedirectStdIo;
  SessionManager.OpenLeakageLog;
  SessionManager.OpenReadIniLog;
  SessionManager.OpenDebugLog;
  SessionManager.OpenErrorLog;
  SessionManager.SetGuardIniPath;
  SessionManager.SetSystemEcho(PipeTermEcho);
  SessionManager.SetBlasterLogger(MyBlasterLogger);
  SessionManager.SetSystemSendToMainConsole(PipeTermSendToMainConsole);
  DefaultCanShowModalLimit:=3;
 end;
end;

end.

