////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2024 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWKIT.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// Send messages to CRW-DAQ main console.                                     //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 2012xxxx - Created by A.K.                                                 //
// 20240123 - Modified for FPC (A.K.)                                         //
////////////////////////////////////////////////////////////////////////////////

program send2crwdaq; // Send to CRW-DAQ

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$R *.res}

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math,
 interfaces, lcltype, lclintf,
 _crw_alloc, _crw_cmdargs, _crw_str, _crw_fio,
 _crw_ef, _crw_rtc, _crw_base64, _crw_proc,
 _crw_sesman;

const
 CurPid            : TPid       = 0;
 ThePid            : TPid       = 0;
 Option            : LongString = '';
 CallCmd           : LongString = '';
 HomeDir           : LongString = '';
 ProgName          : LongString = '';
 ProgAlias         : LongString = '';
 CommandLine       : LongString = '';
 Arguments         : PChar      = '';
 StdIn_Line        : LongString = '';
 StartupDir        : LongString = '';
 DataToSend        : LongString = '';
 SentCharsCount    : LongInt    = 0;
 RecvCharsCount    : LongInt    = 0;
 PrintFlag         : Boolean    = True;
 PrintVerboseFlag  : Boolean    = False;
 ShowInfoFlag      : Boolean    = False;
 ShowHelpFlag      : Boolean    = False;
 CommandFlag       : Boolean    = False;
 StdinUseFlag      : Boolean    = False;
 FixTickCount      : QWord      = 0;
 ecPidNotFound                  = 1;
 ecWndNotFound                  = 2;
 ecMsgRefuse                    = 3;
 ecException                    = 4;
 sid_TFormCrw32                 = 'TFormCrw32';
 guidTFormCrw32    : TGUID      = '{6B7826DD-B281-4BA9-B32F-AF78A24DEDA6}';
 guidSysConsole    : TGUID      = '{31D8A13A-7960-4162-9158-272335902CF6}';
 VersionInfoFallback            = 'send2crwdaq v 1.2 - send message to CRW-DAQ.';
 CopyrightInfoFallback          = 'Copyrigth (c) 2016-2024 Alexey Kuryakin daqgroup@mail.ru';
type
 ESend2CrwDaq = class(Exception);

 {
 Get EXE file version info.
 }
 function GetVersionInfo(const Name:LongString):LongString;
 begin
  Result:=CookieScan(GetFileVersionInfoAsText(ProgName),Name);
 end;
 function DotEnding(const S:LongString):LongString;
 const dot='.';
 begin
  Result:=S;
  if (Result<>'') then if (StrFetch(Result,Length(Result))<>dot) then Result:=Result+dot;
 end;
 function VersionInfo:LongString;
 begin
  Result:=TrimDef(GetVersionInfo('ProductName')+' version '+GetVersionInfo('ProductVersion'),VersionInfoFallback);
  Result:=DotEnding(Result);
 end;
 function CopyrightInfo:LongString;
 begin
  Result:=TrimDef(GetVersionInfo('LegalCopyright'),CopyrightInfoFallback);
  Result:=DotEnding(Result);
 end;
 {
 Return string with TGUID content dump.
 }
 function Dump(const X:TGUID):LongString; overload;
 begin
  Result:=StringBuffer(@X,SizeOf(X));
 end;
 {
 Print message
 }
 function Print(const Msg:LongString):Boolean;
 begin
  Result:=PrintFlag;
  if PrintFlag then begin
   if PrintVerboseFlag then Write(ProgAlias,'@',CurPid,': ');
   Writeln(Msg);
  end;
 end;
 {}
 function PrintVerbose(const Msg:LongString):Boolean;
 begin
  Result:= PrintVerboseFlag;
  if PrintVerboseFlag then Print(Msg);
 end;
 {}
 function ArgChar(const s:LongString):PChar;
 begin
  if (s<>'') then Result:=PChar(s) else Result:=nil;
 end;
 {}
 function GetUpTime:QWord;
 begin
  Result:=GetTickCount64-FixTickCount;
 end;
 {}
 function ParseParamStr(P: PChar; var Param: LongString): PChar; overload;
 const BuffSize = 1024*4;
 var Len:Integer; Buffer:array[0..BuffSize-1] of Char;
 begin
  while True do begin
   while (P[0] <> #0) and (P[0] <= ' ') do Inc(P);
   if (P[0] = '"') and (P[1] = '"') then Inc(P, 2) else Break;
  end;
  Len := 0;
  while (P[0] > ' ') and (Len < SizeOf(Buffer)) do
  if P[0] = '"' then begin
   Inc(P);
   while (P[0] <> #0) and (P[0] <> '"') do begin
    Buffer[Len] := P[0];
    Inc(Len);
    Inc(P);
   end;
   if P[0] <> #0 then Inc(P);
  end else begin
   Buffer[Len] := P[0];
   Inc(Len);
   Inc(P);
  end;
  while (P[0] <> #0) and (P[0] <= ' ') do Inc(P);
  SetString(Param, Buffer, Len);
  Result := P;
 end;
 {}
 function GetCommandLine:LongString;
 begin
  Result:=CmdArgs.DelimitedText;
 end;
{$IFDEF WINDOWS}
 {
 Get console window handle, for console applications.
 Requires Windows version >= Windows 2000 Pro.
 }
 function GetConsoleWindow:HWND;
 const _GetConsoleWindow:function:HWND; stdcall = nil;
 begin
  if not Assigned(_GetConsoleWindow)
  then @_GetConsoleWindow:=GetProcAddress(GetModuleHandle('kernel32.dll'),'GetConsoleWindow');
  if Assigned(_GetConsoleWindow) then Result:=_GetConsoleWindow else Result:=0;
  if (Result<>0) then if not IsWindow(Result) then Result:=0;
 end;
 {
 Get window class name by handle.
 }
 function GetWindowClassName(hWnd:HWND):LongString;
 var Buffer:array[0..255] of Char; Len:Integer;
 begin
  Len:=GetClassName(hWnd,@Buffer,SizeOf(Buffer));
  SetString(Result,Buffer,Len);
 end;
 {
 Get window owner process ID by handle.
 }
 function GetWindowProcessId(hWnd:HWND):DWORD;
 begin
  Result:=0;
  if IsWindow(hWnd) then
  GetWindowThreadProcessId(hWnd,@Result);
 end;
 {
 Types uses to find window by PID and ClassName.
 }
 type TPidClassWndRec=packed record dwPid:DWORD; lpClassName:PChar; hWnd:HWND; end;
 type PPidClassWndRec=^TPidClassWndRec;
 {
 Callback function uses to find window by PID and ClassName.
 }
 function EnumWindowsProc(hWnd:HWND; lParam:LPARAM):BOOL; stdcall;
 var wPid:DWORD; Rec:PPidClassWndRec;
 begin
  Result:=True;
  if (lParam<>0) then begin
   wPid:=GetWindowProcessId(hWnd);
   if (wPid<>0) then begin
    Rec:=PtrIntToPointer(lParam);
    if PrintVerboseFlag then PrintVerbose('EnumWindows '+IntToStr(wPid)+','+GetWindowClassName(hWnd));
    if (wPid=Rec.dwPid) then
    if IsSameText(Rec.lpClassName,GetWindowClassName(hWnd)) then begin
     Rec.hWnd:=hWnd;
     Result:=False;
    end;
   end;
  end;
 end;
 {
 Find window handle by PID and ClassName or return 0.
 }
 function FindWindowByPidAndClassName(aPid:DWORD; const aClassName:LongString):HWND;
 var Rec:TPidClassWndRec; Buffer:array[0..255] of Char;
 begin
  Rec.dwPid:=aPid; Rec.hWnd:=0;
  Rec.lpClassName:=StrCopy(Buffer,PChar(aClassName));
  EnumWindows(@EnumWindowsProc,PointerToPtrInt(@Rec));
  Result:=Rec.hWnd;
 end;
 {$ENDIF ~WINDOWS}
 {
 Find exe name by PID.
 }
 function FindExeByPid(aPid:TPid; out exe:LongString):Boolean;
 var ps:LongString;
 begin
  Result:=false; exe:='';
  if (aPid<>0) then begin
   ps:=GetListOfProcesses(aPid,0,'');
   exe:=ExtractWord(4,ps,ScanSpaces);
   exe:=ExtractFileNameExt(exe);
   Result:=(exe<>'');
  end;
 end;
 {
 Send WM_COPYDATA message to process with ID aPid, to window with aClassName.
 }
 function SendCommandToCrwDaqConsole(aPid:DWORD; const aClassName, aData:LongString):LRESULT;
 {$IFDEF WINDOWS} var hWin:HWND; DataRec:TCopyDataStruct; {$ENDIF ~WINDOWS}
 var exe,DataStr:LongString;
 begin
  Result:=0;
  if (aData<>'') then
  if FindExeByPid(aPid,exe) then begin
   if IsWindows and SameText(exe,'Crw32.exe') then begin
    {$IFDEF WINDOWS}
    hWin:=FindWindowByPidAndClassName(aPid,aClassName);
    if (hWin<>0) then begin
     DataStr:=Dump(guidTFormCrw32)+Dump(guidSysConsole)+Dump(CurPid)+aData;
     DataRec.dwData:=aPid;
     DataRec.cbData:=Length(DataStr);
     DataRec.lpData:=PChar(DataStr);
     Result:=SendMessage(hWin,WM_COPYDATA,GetConsoleWindow,PointerToPtrInt(@DataRec));
     if PrintVerboseFlag then begin
      PrintVerbose('Leng: '+IntToStr(DataRec.cbData));
      PrintVerbose('Sent: '+IntToStr(Length(aData)));
      PrintVerbose('Result: '+IntToStr(Result));
      PrintVerbose('Target: pid@'+IntToStr(aPid)+' - '+exe);
      PrintVerbose('TTY: pid@'+IntToStr(GetWindowProcessId(GetConsoleWindow)));
     end;
     SentCharsCount:=Length(aData); RecvCharsCount:=Result;
    end else begin
     if PrintVerboseFlag then PrintVerbose('Could not send: WND not found.');
     ExitCode:=ecWndNotFound;
    end;
    {$ELSE ~WINDOWS}
    raise ESend2CrwDaq.Create('send2crwdaq: internal error.');
    {$ENDIF ~WINDOWS}
   end else begin
    DataStr:=smc_Incoming+' '+aData+EOL;
    if SessionManager.SimpleIpcSendCommand(UserName,'daqgroup','crwdaq',0,aPid,DataStr)
    then Result:=Length(aData);
    if PrintVerboseFlag then begin
     PrintVerbose('Leng: '+IntToStr(Length(DataStr)));
     PrintVerbose('Sent: '+IntToStr(Length(aData)));
     PrintVerbose('Result: '+IntToStr(Result));
     PrintVerbose('Target: pid@'+IntToStr(aPid)+' - '+exe);
    end;
    SentCharsCount:=Length(aData); RecvCharsCount:=Result;
   end;
  end else begin
   if PrintVerboseFlag then PrintVerbose('Could not send: PID not found.');
   ExitCode:=ecPidNotFound;
  end;
 end;
 {}
 procedure ShowInfo;
 begin
  Print(VersionInfo);
  Print(CopyrightInfo);
  Print('Type "'+ProgAlias+' -h" or "'+ProgAlias+' --help" to get help.');
 end;
 {}
 procedure ShowHelp;
 var ech:LongString;
 begin
  ech:='';
  if IsUnix then ech:='\';
  if IsWindows then ech:='^';
  Print('');
  Print('Usage:');
  Print(' '+ProgAlias+' [Options] [Command]');
  Print('');
  Print('Options:');
  Print('  -h, --help    Show this help screen.');
  Print('  -i, --info    Show short information about program.');
  Print('  -c, --command Next arguments is a command to send to.');
  Print('  -p, --pid p   Specify PID (p) of process to send command to.');
  Print('                CRW_DAQ_SYS_EXE_PID variable uses, by default.');
  Print('  -v, --verbose Verbose mode, with a lot of details to debug.');
  Print('  -q, --quiet   Quiet (silent) mode. Skip all warnings and messages.');
  Print('');
  Print('Exit codes:');
  Print('  '+IntToStr(0)+             '  sent Ok.');
  Print('  '+IntToStr(ecPidNotFound)+ '  Receiver PID not found.');
  Print('  '+IntToStr(ecWndNotFound)+ '  Receiver WND not found.');
  Print('  '+IntToStr(ecMsgRefuse)+   '  Receiver refuse message.');
  Print('  '+IntToStr(ecException)+   '  Break by program Exception.');
  Print('');
  Print('Examples:');
  Print(' '+ProgAlias+' -p 123 -c @daq devmsg '+ech+'&CronSrv @Warning Hello, I receive the message.');
  Print(' echo "@daq devmsg &CronSrv @Shutdown Crw Exit" | '+ProgAlias);
  Print('');
 end;
 {
 Main program
 }
begin
 try
  {}
  ProgName:=ParamStr(0);
  StartupDir:=GetCurrentDir;
  CurPid:=GetCurrentProcessId;
  CommandLine:=GetCommandLine;
  FixTickCount:=GetTickCount64;
  HomeDir:=Trim(ExtractFileDir(ProgName));
  Arguments:=ParseParamStr(ArgChar(CommandLine),CallCmd);
  if IsEmptyStr(Arguments) then ShowInfoFlag:=True;
  ProgAlias:=AnsiLowerCase(ExtractBaseName(ProgName));
  ThePid:=StrToIntDef(GetEnv('CRW_DAQ_SYS_EXE_PID'),0);
  {}
  while (Arguments[0]='-') do begin
   Arguments:=ParseParamStr(Arguments,Option);
   if IsSameText(Option,'-p') or IsSameText(Option,'--pid') then begin
    Arguments:=ParseParamStr(Arguments,Option);
    ThePid:=StrToIntDef(Option,ThePid);
   end else
   if IsSameText(Option,'-s')  or IsSameText(Option,'--stdin')   then StdinUseFlag:=True else
   if IsSameText(Option,'-c')  or IsSameText(Option,'--command') then begin CommandFlag:=True; Break; end else
   if IsSameText(Option,'-v')  or IsSameText(Option,'--verbose') then PrintVerboseFlag:=True else
   if IsSameText(Option,'-q')  or IsSameText(Option,'--quiet')   then PrintFlag:=False       else
   if IsSameText(Option,'-i')  or IsSameText(Option,'--info')    then ShowInfoFlag:=True     else
   if IsSameText(Option,'-h')  or IsSameText(Option,'--help')    then ShowHelpFlag:=True     else
   if PrintVerboseFlag then begin
    PrintVerbose('Unknown option found. Ignore.');
    PrintVerbose('Arguments = '+Arguments);
    PrintVerbose('Option = '+Option);
   end;
  end;
   {}
   if ShowHelpFlag then ShowInfoFlag:=True;
   if PrintVerboseFlag then PrintFlag:=True;
   if not IsEmptyStr(Arguments) then CommandFlag:=True;
   case GetFileType(GetStdHandle(STD_INPUT_HANDLE)) of
    FILE_TYPE_DISK: StdinUseFlag:=True;
    FILE_TYPE_PIPE: StdinUseFlag:=True;
    FILE_TYPE_UNKNOWN: ;
    FILE_TYPE_CHAR: ;
   end;
   if StdinUseFlag then begin
    ShowInfoFlag:=False;
    ShowHelpFlag:=False;
   end;
   {}
   if PrintVerboseFlag then begin
    PrintVerbose('Welcome to '+ProgAlias+'.');
    PrintVerbose('CommandLine = '+GetCommandLine);
    PrintVerbose('ProgramName = '+ProgName);
    PrintVerbose('StartupDir = '+StartupDir);
    PrintVerbose('Arguments = '+Arguments);
    PrintVerbose('HomeDir = '+HomeDir);
    PrintVerbose('CallCmd = '+CallCmd);
    {$IFDEF WINDOWS}
    PrintVerbose('Console = '+IntToStr(GetConsoleWindow)+', '+GetWindowClassName(GetConsoleWindow)
                +', '+IntToStr(GetWindowProcessId(GetConsoleWindow)));
    {$ENDIF ~WINDOWS}
    PrintVerbose('Options selected:');
    PrintVerbose('--pid = '+IntToStr(ThePid));
    PrintVerbose('--verbose = '+IntToStr(Ord(PrintVerboseFlag)));
    PrintVerbose('--help = '+IntToStr(Ord(ShowHelpFlag)));
    PrintVerbose('--info = '+IntToStr(Ord(ShowInfoFlag)));
   end;
   {}
   if ShowInfoFlag then ShowInfo;
   if ShowHelpFlag then ShowHelp;
   {}
   if StdinUseFlag then
   while not Eof(Input) do begin
    Readln(StdIn_Line);
    if (DataToSend<>'')
    then DataToSend:=DataToSend+EOL+StdIn_Line
    else DataToSend:=StdIn_Line;
   end;
   {}
   if CommandFlag then
   if not IsEmptyStr(Arguments) then begin
    StdIn_Line:=Trim(Arguments);
    if (DataToSend<>'')
    then DataToSend:=DataToSend+EOL+StdIn_Line
    else DataToSend:=StdIn_Line;
   end;
   {}
   if (DataToSend<>'') then begin
    SendCommandToCrwDaqConsole(ThePid,sid_TFormCrw32,DataToSend);
    if (SentCharsCount<>RecvCharsCount) then ExitCode:=ecMsgRefuse;
    if PrintFlag then
    Print(Trim(ProgAlias)+'@'+IntToStr(CurPid)+': sent '+IntToStr(SentCharsCount)
         +' byte(s) to pid@'+IntToStr(ThePid)+', target received '+IntToStr(RecvCharsCount));
   end;
 except
  Print('Break because of Exception.');
  ExitCode:=ecException;
 end;
 if PrintVerboseFlag then begin
  PrintVerbose('ExecutionTime = '+IntToStr(GetUpTime)+' ms');
  PrintVerbose('ExitCode = '+IntToStr(ExitCode));
  PrintVerbose('Good bye.');
 end;
end.

//////////////
// END OF FILE
//////////////

