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

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

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// Application level routines and tools.                                      //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20230702 - Created by A.K. from _stdapp                                    //
////////////////////////////////////////////////////////////////////////////////

unit _crw_apptools; //  Application tools.

{$I _crw_sysdef}

{$IFDEF FPC}{$mode Delphi}{$ENDIF}{$H+}

{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}
{$WARN 5023 off : Unit "$1" not used in $2}

interface

uses
 _crw_sharemem, // NB: THIS UNIT MUST BE FIRST !!!
 {$IFDEF UNIX} cthreads, dl, {$ENDIF}
 {$IFDEF WINDOWS} windows, {$ENDIF}
 sysutils, classes, math, types, lcltype, rtlconsts, lmessages, lclproc,
 forms, controls, stdctrls, comctrls, dialogs, menus, buttons, actnlist,
 process, printers, lclintf, gettext,
 _crw_alloc, _crw_cmdargs, _crw_environ, _crw_fpu, _crw_ef,
 _crw_str, _crw_fio, _crw_rtc, _crw_proc, _crw_riff, _crw_snd,
 _crw_plut, _crw_eldraw, _crw_base64, _crw_hl, _crw_uart,
 _crw_polling, _crw_guard, _crw_pio, _crw_uac, _crw_calib,
 _crw_couple, _crw_sysid, _crw_wmctrl, _crw_assoc,
 _crw_apputils, _crw_appforms;

{$IFNDEF WINDOWS}
 //////////////////////////////////
 // Windows compatibility constants
 //////////////////////////////////
const
 MB_TOPMOST            = $00040000;

const
 HKEY_CLASSES_ROOT     = HKEY($80000000);
 HKEY_CURRENT_USER     = HKEY($80000001);
 HKEY_LOCAL_MACHINE    = HKEY($80000002);
 HKEY_USERS            = HKEY($80000003);
 HKEY_PERFORMANCE_DATA = HKEY($80000004);
 HKEY_CURRENT_CONFIG   = HKEY($80000005);
 HKEY_DYN_DATA         = HKEY($80000006);
{$ENDIF ~WINDOWS}

const
 SM_CMETRICS            = 83;              // D5 MultiMon.pas

function  GetMainFormTitle:LongString;
function  MessageDlgApplyParamsPos(const Params:LongString):TPoint;

 {
 ****************
 Standard dialogs
 ****************
 }
function  MessageDlg(const Msg:LongString; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint; Params:LongString=''): Integer;
function  Warning(const Msg:LongString; Params:LongString=''):Integer;
function  Information(const Msg:LongString; Params:LongString=''):Integer;
function  YesNo(const Msg:LongString; Params:LongString=''):Integer;
function  YesNoCancel(const Msg:LongString; Params:LongString=''):Integer;
function  Error(const Msg:LongString; Params:LongString=''):Integer;
function  Trouble(Check:boolean; const Msg:LongString; Params:LongString=''):Boolean;
function  NoProblem(Check:boolean; const Msg:LongString; Params:LongString=''):Boolean;
function  mrVoice(Code:TModalResult):TModalResult;
function  mrCaption(Code:TModalResult):LongString;
function  StandardExitConfirmation:Boolean;
procedure UpdateStatusLine(const aMessage:LongString);
procedure ShouldBeDone;

const
 UseSystemMessageBox : Boolean = true; // Use system MessageBox for MessageDlg
 UseEditSettings     : Boolean = true; // Use edit('@set ...'), i.e. Params

const
 OnUpdateStatusLine: procedure(const aMessage:LongString) = nil;
 mrError = mrYesToAll + 1;

function MenuRightSpace:String;

const MenuRightSpaceWidth : Integer = 1;

 {
 ************************
 General purpose utilites
 ************************
 }
type
 TForEachMdiChildAction = procedure(Form      : TForm;
                                    Index     : Integer;
                                var Terminate : Boolean;
                                    Custom    : Pointer);
procedure ForEachMdiChild(Action:TForEachMdiChildAction; Custom:Pointer; Backward:Boolean=false);

type
 TForEachComponentAction = procedure(Component : TComponent;
                                     Index     : Integer;
                                 var Terminate : Boolean;
                                     Custom    : Pointer);
procedure ForEachComponent(Component:TComponent; Action:TForEachComponentAction; Custom:Pointer; Backward:Boolean=false);

type
 TForEachFormAction = procedure(Form      : TForm;
                                Index     : Integer;
                            var Terminate : Boolean;
                                Custom    : Pointer);
procedure ForEachForm(Action:TForEachFormAction; Custom:Pointer; Backward:Boolean=false);

function  FindRelativePos(const Pos:TPoint; Window:TForm; Control:TControl):TPoint; overload;
function  FindRelativePos(const Pos:TPoint; const WindowTitle,ControlName:LongString):TPoint; overload;
function  FindRelativeSize(const P:TPoint; Window:TForm; Control:TControl):TPoint; overload;
function  FindRelativeSize(const P:TPoint; const WindowTitle,ControlName:LongString):TPoint; overload;
function  GetFormBounds(Form:TForm):TRect;
function  GetScreenDesktopBounds:TRect;
function  GetValidFormPosition(Form:TForm):TPoint;
procedure ValidateFormPosition(Form:TForm);
function  SelectMDIChildDialog(const Caption,Title:LongString):TForm;
function  ActivateMDIChild(aForm:TForm):Boolean;
procedure UpdateAllMdiForms;
procedure SetEnabledActions(Enabled:Boolean; const Actions:array of TAction);
procedure SetVisibleControls(Visible:Boolean; const Controls:array of TControl);
procedure SetEnabledControls(Enabled:Boolean; const Controls:array of TControl);
procedure ShowControls(const Controls:array of TControl);
procedure HideControls(const Controls:array of TControl);
procedure UpdateMenu(aMenu:TMenuItem; const aCaption,aHint:LongString; aShortCut:TShortCut);
procedure SetAllButtonsCursor(Form:TForm; Cursor:TCursor);
procedure RecordComboBoxHistory(aComboBox:TComboBox; HistoryLength:Integer);
procedure OpenDialogTypeChangeStdExecute(OpenDialog:TOpenDialog);
procedure OpenDialogSelectType(OpenDialog:TOpenDialog; const FileName:LongString; SetInitialDir:Boolean=True);
procedure LocateFormToCenterOfScreen(Form:TForm);
procedure LocateFormToCenterOfMouse(Form:TForm);
function  StdDateTimeStr(ms:Double=0):ShortString;
function  StdDateTimePrompt(ms:Double=0; Prompt:PChar=nil):ShortString;
function  HasPrinters:Boolean;
function  HasPrintersDialog:Boolean;
function  SubSystemTurnOn(const SubSystemSectionName:LongString):Boolean;
function  SubSystemIniFile(const SubSystemSectionName:LongString):LongString;
function  SubSystemDataPath(const SubSystemSectionName:LongString):LongString;
function  GetBackUpName(const FileName,NewExtension:LongString):LongString;
function  IsControlContainsClientPos(Control:TControl; const ClientPos:TPoint):Boolean;
function  IsControlContainsScreenPos(Control:TControl; const ScreenPos:TPoint):Boolean;
function  IsMainThread:Boolean;
function  IsModalFormActive:Boolean;
function  NumberOfModalFormsNow:Cardinal;
function  GetFormModalResult(Form:TForm):TModalResult;
function  CanShowModal(aForm:TForm=nil; aLimit:Cardinal=High(Cardinal)):Boolean;
function  IsAdministrator(aError:PShortString=nil):Boolean;
function  GetRootKeyByName(const Name:LongString):HKey;
function  GetDieselPascalExe:LongString;
function  HasDieselPascalExe:Boolean;
procedure EchoBriefSystemInfo;
procedure EchoBriefSystemInfoEx(verbose:Boolean);
function  GetSystemParamStr(const Category,ParamName:LongString):LongString;
function  GetWordUnderCursor(const aText:LongString; aCursor:Integer; const SpecChars:LongString=''):LongString;
function  GuardOpenDialog(OpenDialog:TOpenDialog):TOpenDialog;
function  CheckEditPasswordChar(Edit:TEdit; aPasswordChar:Char):Char;
{$IFDEF WINDOWS}
function  IsWindowTopMost(Handle:HWND):Boolean; overload;
function  IsWindowTopMost(Form:TForm):Boolean; overload;
procedure MakeWindowTopMost(Handle:HWND); overload;
{$ENDIF ~WINDOWS}
procedure MakeWindowTopMost(Form:TForm; aSysWide:Boolean=false); overload;
function  GetAppFormBounds:TRect;
function  GetAppFormBoundsStr(delim:Char=' '):LongString;
function  GetAppClientBounds:TRect;
function  GetAppClientBoundsStr(delim:Char=' '):LongString;

const     TheUnixExe     : LongString = '';
const     TheFpQuiTipExe : LongString = '';
const     PreferTooltip  : Boolean    = false;
function  ShowTooltip(const arg:LongString):Integer;
procedure InitTooltip;
procedure FreeTooltip;

function GetScreenColorDepth:Integer;

{$IFDEF WINDOWS}
const                             // Get/SetProcessShutdownParameters
 SHUTDOWN_NORETRY    = 1;         // The system terminates the process without displaying a retry dialog box for the user. 

const                             // GetSystemMetrics
 SM_SHUTTINGDOWN     = $2000;     // System is shutting down.

const                             // WM_QUERYENDSESSION, WM_ENDSESSION:
 ENDSESSION_CLOSEAPP = $00000001; // Application must shut down.
 ENDSESSION_CRITICAL = $40000000; // The application is forced to shut down.
 ENDSESSION_LOGOFF   = $80000000; // The user is logging off.
 
function IsSystemShuttingDown:Boolean;
function SetProcessShutdownParameters(dwLevel,dwFlags:DWORD):BOOL; stdcall;
function GetProcessShutdownParameters(lpdwLevel,lpdwFlags:LPDWORD):BOOL; stdcall;
{$ENDIF ~WINDOWS}

const
 ThePasswordChar = '*';

const
 DefaultCanShowModalLimit : Cardinal = 0;

{$IFDEF SKIP_DRAFT}
type
 EHelpError = class(ESoftException);

function  OpenWinHelpTopic(const Path:LongString; const Topic:LongString=''):Boolean;
function  OpenWinHelpTopicByLink(const HomeDir,IniFile,Section,Link:LongString; const Topic:LongString=''):Boolean;
{$ENDIF ~SKIP_DRAFT}

 {
 *******************************************************************************
 RIFF file utilities
 *******************************************************************************
 }

 {
 Utility dialog to select ITEM object from RIFF CRWF file.
 }
function SelectRiffItemDialog(const FileName:LongString):TRiffChunk;

 {
 *******************************************************************************
 MUI support functions
 *******************************************************************************
 }
function GetACP:LANGID;
function GetOEMCP:LANGID;
{$IFDEF SKIP_DRAFT}
function GetSystemDefaultUILanguage:LANGID;
function GetUserDefaultUILanguage:LANGID;
function GetThreadUILanguage:LANGID;
function GetSystemDefaultLCID:LCID;
function GetUserDefaultLCID:LCID;
function GetThreadLocale:LCID;
function GetSystemDefaultLocaleName(lpLocaleName:PWideChar; cchLocaleName:Integer):Integer stdcall;
function GetSystemDefaultLocaleNameStr:String;
{$ENDIF ~SKIP_DRAFT}

const // List of language options, like "program --lang ru"
 ListLanguageOptionNames:LongString='-l;-lng;-lang;-language;--lng;--lang;--language';

 { Get default language (lng_English/Russian) by CodePage or $LANG. }
function GetDefLanguage:Integer;

 { Get language from options. }
function GetOptLanguage(def:Integer; LangOpts:LongString=''):Integer;

 {
 *******************************************************************************
 Initialize standard subsystems, standard timer actions
 *******************************************************************************
 }
const
  SayTimeInterval : LongInt = 15;
  CpuFrequencyMHz : Double  = 0;

procedure Init_CpuFrequencyMHz;
procedure Init_Sound_SubSystem;
procedure Done_Sound_SubSystem;
procedure Init_Calculator_SubSystem;
procedure Done_Calculator_SubSystem;
procedure Init_Thermocouple_SubSystem;
procedure Done_Thermocouple_SubSystem;
procedure Init_IOPM_SubSystem;
procedure Done_IOPM_SubSystem;
procedure Timer_CheckConfigCache;
procedure Timer_SayTime;
procedure SayTimeHhMm(const t:TSystemTime; const Prefix:LongString='теквремя');

implementation

uses
 Form_Calculator,
 Form_ListBoxSelection;

 // @set Form.Left 400  relative WindowName ComponentName
 // @set Form.Top  400  relative WindowName ComponentName
function MessageDlgApplyParamsPos(const Params:LongString):TPoint;
var pars:TText; i,l,t:Integer; line:LongString;
begin
 Result:=Point(Low(Integer),Low(Integer));
 if (SysUtils.Trim(Params)<>'') then
 try
  pars:=NewText;
  try
   pars.Text:=SysUtils.Trim(Params);
   for i:=0 to pars.Count-1 do begin
    line:=Trim(pars[i]);
    if (StrFetch(line,1)='@') then begin
     if SameText(ExtractWord(1,line,ScanSpaces),'@set') then begin
      if SameText(ExtractWord(2,line,ScanSpaces),'Form.Left') then begin
       if Str2Int(ExtractWord(3,line,ScanSpaces),l) then begin
        if SameText(ExtractWord(4,line,ScanSpaces),'relative')
        then Result.x:=FindRelativePos(Point(l,0),ExtractWord(5,line,ScanSpaces),ExtractWord(6,line,ScanSpaces)).x;
       end;
      end;
      if SameText(ExtractWord(2,line,ScanSpaces),'Form.Top') then begin
       if Str2Int(ExtractWord(3,line,ScanSpaces),t) then begin
        if SameText(ExtractWord(4,line,ScanSpaces),'relative')
        then Result.y:=FindRelativePos(Point(0,t),ExtractWord(5,line,ScanSpaces),ExtractWord(6,line,ScanSpaces)).y;
       end;
      end;
     end;
    end;
   end;
  finally
   Kill(pars);
  end;
 except
  on E:Exception do BugReport(E,nil,'ApplyParamsPos');
 end;
end;

const
 MessageDlgRec : record
  Pid    : Cardinal;
  Pos    : TPoint;
  wClass : LongString;
  wTitle : LongString;
 end = ( Pid:0; Pos:(X:0; Y:0); wClass:''; wTitle:'');

procedure MessageDlgPosUpdate;
var wnd:HWND; R:TRect; arg,sg,sx,sy,sw,sh:LongString; gravity:Integer;
begin
 try
  with MessageDlgRec do
  if (Pid>0) and ((wClass<>'') or (wTitle<>'')) and ((Pos.x<>Low(Integer)) or (Pos.y<>Low(Integer))) then begin
   wnd:=wmctrl.FindWindow(Pid,wClass,wTitle);
   if not wmctrl.IsWindow(wnd) then Exit;
   R:=wmctrl.WindowBounds(wnd);
   if R.IsEmpty then Exit;
   gravity:=0;
   sg:=IntToStr(gravity);
   sx:=IntToStr(Pos.x);
   sy:=IntToStr(Pos.y);
   sw:=IntToStr(R.Width);
   sh:=IntToStr(R.Height);
   if (Pos.x=Low(Integer)) then sx:='*';
   if (Pos.y=Low(Integer)) then sy:='*';
   arg:=Format('%s,%s,%s,%s,%s',[sg,sx,sy,sw,sh]);
   if not wmctrl.MoveResizeWindow(wnd,arg) then Exit;
   Pid:=0; Pos:=Point(0,0); wClass:=''; wTitle:='';
  end;
 except
  on E:Exception do BugReport(E,nil,'MessageDlgPosUpdate');
 end;
end;

procedure MessageDlgRecInit(Pid:Cardinal; Pos:TPoint; wClass,wTitle:String);
begin
 MessageDlgRec.Pid:=Pid;       MessageDlgRec.Pos:=Pos;
 MessageDlgRec.wClass:=wClass; MessageDlgRec.wTitle:=wTitle;
 if (Pid>0) then Tick55Actions.Add(MessageDlgPosUpdate) else Tick55Actions.Remove(MessageDlgPosUpdate);
end;

function MsgDlgCaption(DlgType:TMsgDlgType; Mode:Integer):LongString;
const MsgDlgCaptions: array[TMsgDlgType] of Pointer =
      (@SMsgDlgWarning,@SMsgDlgError,@SMsgDlgInformation,@SMsgDlgConfirm,nil);
begin
 Result:='';
 if HasFlags(Mode,1) then begin
  case DlgType of
   mtWarning:      Result:=RusEng('Предупреждение','Warning');
   mtInformation:  Result:=RusEng('Информация','Information');
   mtConfirmation: Result:=RusEng('Подтверждение','Confirmation');
   mtError:        Result:=RusEng('Ошибка','Error');
  end;
 end;
 if (Result='') then
 if (DlgType<>mtCustom)
 then Result:=LoadResString(MsgDlgCaptions[DlgType])
 else Result:=Application.Title;
 if HasFlags(Mode,2) then begin
  if (DlgType<>mtCustom) then
  Result:=GetMainFormTitle+' - '+Result;
 end;
end;

function GetMainFormTitle:LongString;
begin
 if (Application=nil) then Result:=SysUtils.ExtractFileName(ParamStr(0)) else
 if (Application.MainForm=nil) then Result:=Application.Title else Result:=Application.MainForm.Caption;
end;

 {
 *******************************
 Standard dialogs implementation
 *******************************
 }
function MessageDlgClass:LongString;
begin
 Result:='';
 if IsWindows then begin
  Result:='TMessageForm';
  Exit;
 end;
 if IsUnix then begin
  Result:=wmctrl.IcccmClass;
  Exit;
 end;
end;

function MessageDlg(const Msg:LongString; DlgType:TMsgDlgType; Buttons:TMsgDlgButtons; HelpCtx:Longint; Params:LongString=''): Integer;
var Flags:LongInt; Cap:LongString; SysMsgBox:Boolean;
begin
 Result:=mrCancel;
 try
  Params:=SysUtils.Trim(Params);
  if not UseEditSettings then Params:='';
  try
   SysMsgBox:=UseSystemMessageBox and IsWindows;
   Flags:=MB_TOPMOST;
   Cap:=MsgDlgCaption(DlgType,1+2);
   case DlgType of
    mtWarning:      Flags:=Flags or MB_ICONWARNING;
    mtInformation:  Flags:=Flags or MB_ICONINFORMATION;
    mtConfirmation: Flags:=Flags or MB_ICONQUESTION;
    mtError:        Flags:=Flags or MB_ICONERROR;
   end;
   if Buttons = [mbOk]                then Flags:=Flags or MB_OK          else
   if Buttons = [mbOk,mbCancel]       then Flags:=Flags or MB_OKCANCEL    else
   if Buttons = [mbYes,mbNo]          then Flags:=Flags or MB_YESNO       else
   if Buttons = [mbYes,mbNo,mbCancel] then Flags:=Flags or MB_YESNOCANCEL else SysMsgBox:=false;
   if SysMsgBox then begin
    if (Params<>'') then MessageDlgRecInit(GetCurrentProcessId,MessageDlgApplyParamsPos(Params),swc_DialogBox,Cap);
    Result:=mrVoice(Application.MessageBox(PChar(Msg),PChar(Cap),Flags))
   end else begin
    if (Params<>'') then MessageDlgRecInit(GetCurrentProcessId,MessageDlgApplyParamsPos(Params),MessageDlgClass,Cap);
    Result:=mrVoice(Dialogs.MessageDlg(Cap,Msg,DlgType,Buttons,HelpCtx));
   end;
  finally
   if (Params<>'') then MessageDlgRecInit(0,Point(0,0),'','');
  end;
 except
  on E:Exception do BugReport(E,nil,'MessageDlg');
 end;
end;

function Warning(const Msg:LongString; Params:LongString=''):Integer;
begin
 Result:=MessageDlg(Msg, mtWarning, [mbOk,mbCancel], 0, Params);
end;

function Information(const Msg:LongString; Params:LongString=''):Integer;
begin
 Result:=MessageDlg(Msg, mtInformation, [mbOk,mbCancel], 0, Params);
end;

function YesNo(const Msg:LongString; Params:LongString=''):Integer;
begin
 Result:=MessageDlg(Msg, mtConfirmation, [mbYes,mbNo], 0, Params);
end;

function YesNoCancel(const Msg:LongString; Params:LongString=''):Integer;
begin
 Result:=MessageDlg(Msg, mtConfirmation, [mbYes,mbNo,mbCancel], 0, Params);
end;

function Error(const Msg:LongString; Params:LongString=''):Integer;
begin
 Result:=MessageDlg(Msg, mtError, [mbOk], 0, Params);
end;

function Trouble(Check:boolean; const Msg:LongString; Params:LongString=''):Boolean;
begin
 if Check and (Msg<>'') then Error(Msg,Params);
 Result:=Check;
end;

function NoProblem(Check:boolean; const Msg:LongString; Params:LongString=''):Boolean;
begin
 Result:=not Trouble(not Check,Msg,Params);
end;

function mrVoice(Code:TModalResult):TModalResult;
const
 sayOk     : ShortString  = '';
 sayCancel : ShortString  = '';
 sayAbort  : ShortString  = '';
 sayYes    : ShortString  = '';
 sayNo     : ShortString  = '';
 sayRetry  : ShortString  = '';
 sayIgnore : ShortString  = '';
 sayError  : ShortString  = '';
 IsLoaded  : Boolean      = false;
begin
 Result:=Code;
 if EnableSystemVoice then begin
  if not IsLoaded then begin
   ReadIniFileVariable(SysIniFile, '[SysVoice]', 'ClickOk%a',     sayOk);
   ReadIniFileVariable(SysIniFile, '[SysVoice]', 'ClickCancel%a', sayCancel);
   ReadIniFileVariable(SysIniFile, '[SysVoice]', 'ClickAbort%a',  sayAbort);
   ReadIniFileVariable(SysIniFile, '[SysVoice]', 'ClickYes%a',    sayYes);
   ReadIniFileVariable(SysIniFile, '[SysVoice]', 'ClickNo%a',     sayNo);
   ReadIniFileVariable(SysIniFile, '[SysVoice]', 'ClickRetry%a',  sayRetry);
   ReadIniFileVariable(SysIniFile, '[SysVoice]', 'ClickIgnore%a', sayIgnore);
   ReadIniFileVariable(SysIniFile, '[SysVoice]', 'ClickError%a',  sayError);
   IsLoaded:=true;
  end;
  case Code of
   mrNone   : ;
   mrOk     : SysVoice(sayOk);
   mrCancel : SysVoice(sayCancel);
   mrAbort  : SysVoice(sayAbort);
   mrYes    : SysVoice(sayYes);
   mrNo     : SysVoice(sayNo);
   mrRetry  : SysVoice(sayRetry);
   mrIgnore : SysVoice(sayIgnore);
   mrError  : SysVoice(sayError);
  end;
 end;
end;

function mrCaption(Code:TModalResult):LongString;
begin
 case Code of
  mrNone     : Result:='';
  mrOk       : Result:=RusEng('Ладно','Ok');
  mrCancel   : Result:=RusEng('Отмена','Cancel');
  mrAbort    : Result:=RusEng('Прервать','Abort');
  mrYes      : Result:=RusEng('Да','Yes');
  mrNo       : Result:=RusEng('Нет','No');
  mrRetry    : Result:=RusEng('Повтор','Retry');
  mrIgnore   : Result:=RusEng('Пропустить','Ignore');
  mrError    : Result:=RusEng('Ошибка','Error');
  mrAll      : Result:=RusEng('Все','All');
  mrNoToAll  : Result:=RusEng('Нет для Всех','No to All');
  mrYesToAll : Result:=RusEng('Да для Всех','Yes to All');
  else         Result:='';
 end;
end;

function StandardExitConfirmation:Boolean;
begin
 Result:=YesNo(RusEng('Вы действительно хотите выйти из программы?',
                      'Do you really want to exit program now?'))=mrYes;
end;

procedure UpdateStatusLine(const aMessage:LongString);
begin
 if Assigned(OnUpdateStatusLine) then OnUpdateStatusLine(aMessage);
end;

procedure ShouldBeDone;
begin
 Warning('Should be done.');
end;

function MenuRightSpace:String;
begin
 Result:=StringOfChar(' ',MenuRightSpaceWidth);
end;

 {
 ************************
 General purpose utilites
 ************************
 }
procedure ForEachMdiChild(Action:TForEachMdiChildAction; Custom:Pointer; Backward:Boolean=false);
var
 Index     : Integer;
 MainForm  : TForm;
 ChildForm : TCustomForm;
 Terminate : Boolean;
begin
 try
  Terminate:=false;
  if Assigned(Action) then
  if Application is TApplication then begin
   MainForm:=Application.MainForm;
   if MainForm is TForm then begin
    if Backward then begin
     for Index:=MainForm.MDIChildCount-1 downto 0 do begin
      ChildForm:=MainForm.MDIChildren[Index];
      if (ChildForm is TForm) then Action(TForm(ChildForm),Index,Terminate,Custom);
      if Terminate then break;
     end;
    end else begin
     for Index:=0 to MainForm.MDIChildCount-1 do begin
      ChildForm:=MainForm.MDIChildren[Index];
      if (ChildForm is TForm) then Action(TForm(ChildForm),Index,Terminate,Custom);
      if Terminate then break;
     end;
    end;
   end;
  end;
 except
  on E:Exception do BugReport(E,nil,'ForEachMdiChild');
 end;
end;

procedure ForEachComponent(Component:TComponent; Action:TForEachComponentAction; Custom:Pointer; Backward:Boolean=false);
var
 Item      : TComponent;
 Index     : Integer;
 Terminate : Boolean;
begin
 try
  Terminate:=false;
  if (Component is TComponent) and Assigned(Action) then
  if Backward then begin
   for Index:=Component.ComponentCount-1 downto 0 do begin
    Item:=Component.Components[Index];
    if Item is TComponent then Action(Item,Index,Terminate,Custom);
    if Terminate then break;
   end;
  end else begin
   for Index:=0 to Component.ComponentCount-1 do begin
    Item:=Component.Components[Index];
    if Item is TComponent then Action(Item,Index,Terminate,Custom);
    if Terminate then break;
   end;
  end;
 except
  on E:Exception do BugReport(E,nil,'ForEachComponent');
 end;
end;

type
 TFEF_Rec = packed record
  Action : TForEachFormAction;
  Custom : Pointer;
  Index  : Integer;
 end;

procedure FEF_Action(Component:TComponent; Index:Integer; var Terminate:Boolean; Custom:Pointer);
begin
 if Component is TForm then begin
  TFEF_Rec(Custom^).Action(Component as TForm, TFEF_Rec(Custom^).Index,
                           Terminate,          TFEF_Rec(Custom^).Custom);
  inc(TFEF_Rec(Custom^).Index);
 end;
end;

procedure ForEachForm(Action:TForEachFormAction; Custom:Pointer; Backward:Boolean=false);
var
 FEF_Rec : TFEF_Rec;
begin
 if Assigned(Action) then
 if Application is TApplication then begin
  FEF_Rec.Action:=Action;
  FEF_Rec.Custom:=Custom;
  FEF_Rec.Index:=0;
  ForEachComponent(Application, FEF_Action, @FEF_Rec, Backward);
 end;
end;

type
 TFRP_Rec = packed record     // Uses by FindRelativePos, FindRelativeSize
   Window      : TForm;       // Window  reference
   Control     : TControl;    // Control reference
   WindowTitle : ShortString; // Window Caption or CLASS::NAME
   ControlName : ShortString; // The name of control to find
 end;

function HasWindowClassAndName(const S:LongString):Boolean;
var p:Integer;
begin
 p:=Pos('::',S); Result:=(p>1) and (p+2<=Length(S));
end;
function ExtractWindowClass(const S:LongString):LongString;
var p:Integer;
begin
 p:=Pos('::',S); if (p>0) then Result:=Copy(S,1,p-1) else Result:='';
end;
function ExtractWindowName(const S:LongString):LongString;
var p:Integer;
begin
 p:=Pos('::',S); if (p>0) then Result:=Copy(S,p+2,MaxInt) else Result:=S;
end;

function FRP_FormMatch(Form:TForm; const WindowTitle:ShortString):Boolean;
var wc,wn:LongString;
begin
 Result:=false;
 if (Form is TForm) then
 if SameText(Form.Caption,WindowTitle) then Result:=true else
 if HasWindowClassAndName(WindowTitle) then begin
  wc:=ExtractWindowClass(WindowTitle);
  wn:=ExtractWindowName(WindowTitle);
  if SameText(wc,'*') or SameText(wc,Form.ClassName) then
  if SameText(wn,'*') or SameText(wn,Form.Name) then Result:=true;
 end;
end;

procedure FRP_FormProc(Form:TForm; Index:Integer; var Terminate:Boolean; Custom:Pointer);
begin
 if (Form is TForm) then
 if (Custom<>nil) then with TFRP_Rec(Custom^) do
 if FRP_FormMatch(Form,WindowTitle) then begin
  Terminate:=true;
  Window:=Form;
 end;
end;

procedure FRP_ContProc(Component:TComponent; Index:Integer; var Terminate:Boolean; Custom:Pointer);
begin
 if (Component is TControl) then
 if (Custom<>nil) then with TFRP_Rec(Custom^) do
 if SameText(Component.Name,ControlName) then begin
  Control:=TControl(Component);
  Terminate:=true;
 end;
end;

function FindRelativePos(const Pos:TPoint; Window:TForm; Control:TControl):TPoint; overload;
begin
 if (Control<>nil) then Result:=Control.ClientToScreen(Pos) else
 if (Window<>nil) then Result:=Window.ClientToScreen(Pos) else
 Result:=Pos;
end;

function FindRelativePos(const Pos:TPoint; const WindowTitle,ControlName:LongString):TPoint; overload;
var R:TFRP_Rec;
begin
 Result:=Pos;
 R.Window:=nil; R.Control:=nil;
 R.WindowTitle:=Trim(WindowTitle);
 R.ControlName:=Trim(ControlName);
 if (R.WindowTitle='') then Exit;
 if SameText(R.WindowTitle,'Screen') then Exit;
 if SameText(R.WindowTitle,'Desktop') then begin
  Inc(Result.x,Screen.DesktopLeft);
  Inc(Result.y,Screen.DesktopTop);
  Exit;
 end;
 if (R.Window=nil) then ForEachMdiChild(FRP_FormProc,@R);
 if (R.Window=nil) then ForEachForm(FRP_FormProc,@R);
 if (R.Window=nil) then Exit;
 if (R.ControlName<>'') then ForEachComponent(R.Window,FRP_ContProc,@R);
 Result:=FindRelativePos(Pos,R.Window,R.Control);
end;

function RelativeSize(const p,s:TPoint; base:Integer=100):TPoint;
begin
 if (base=0)
 then Result:=p
 else Result:=Point((Int64(p.x)*s.x) div base,(Int64(p.y)*s.y) div base);
end;

function FindRelativeSize(const P:TPoint; Window:TForm; Control:TControl):TPoint; overload;
begin
 if (Control<>nil) then Result:=RelativeSize(P,Point(Control.Width,Control.Height)) else
 if (Window<>nil) then Result:=RelativeSize(P,Point(Window.Width,Window.Height)) else
 Result:=P;
end;

function FindRelativeSize(const P:TPoint; const WindowTitle,ControlName:LongString):TPoint; overload;
var R:TFRP_Rec;
begin
 Result:=P;
 R.Window:=nil; R.Control:=nil;
 R.WindowTitle:=Trim(WindowTitle);
 R.ControlName:=Trim(ControlName);
 if (R.WindowTitle='') then Exit;
 if SameText(R.WindowTitle,'Screen') then begin
  Result:=RelativeSize(P,Point(Screen.Width,Screen.Height));
  Exit;
 end;
 if SameText(R.WindowTitle,'Desktop') then begin
  Result:=RelativeSize(P,Point(Screen.DesktopWidth,Screen.DesktopHeight));
  Exit;
 end;
 if (R.Window=nil) then ForEachMdiChild(FRP_FormProc,@R);
 if (R.Window=nil) then ForEachForm(FRP_FormProc,@R);
 if (R.Window=nil) then Exit;
 if (R.ControlName<>'') then ForEachComponent(R.Window,FRP_ContProc,@R);
 Result:=FindRelativeSize(P,R.Window,R.Control);
end;

function GetFormBounds(Form:TForm):TRect;
begin
 if (Form=nil)
 then Result:=Rect(0,0,0,0)
 else with Form do Result:=Rect(Left,Top,Left+Width,Top+Height);
end;

function GetScreenDesktopBounds:TRect;
begin
 Result.Left:=Screen.DesktopLeft;
 Result.Top:=Screen.DesktopTop;
 Result.Right:=Result.Left+Screen.DesktopWidth;
 Result.Bottom:=Result.Top+Screen.DesktopHeight;
end;

function GetValidFormPosition(Form:TForm):TPoint;
var RF,RS:TRect;
begin
 if (Form=nil) then Result:=Point(0,0) else begin
  RF:=GetFormBounds(Form); RS:=GetScreenDesktopBounds;
  Result.x:=Max(RS.Left,Min(RF.Left,RS.Right-(RF.Right-RF.Left)));
  Result.y:=Max(RS.Top,Min(RF.Top,RS.Bottom-(RF.Bottom-RF.Top)));
 end;
end;

procedure ValidateFormPosition(Form:TForm);
begin
 if (Form<>nil) then
 with GetValidFormPosition(Form) do begin
  Form.Left:=x; Form.Top:=y;
 end;
end;

procedure AddToMdiList(Form:TForm; Index:Integer; var Terminate:Boolean; Custom:Pointer);
begin
 TText(Custom).Addln(Form.Caption);
end;

function SelectMDIChildDialog(const Caption,Title:LongString):TForm;
var List:TText; Index:Integer; aForm:TCustomForm;
begin
 Result:=nil;
 try
  List:=NewText;
  try
   ForEachMdiChild(AddToMdiList,List);
   if List.Count>0 then begin
    Index:=0; aForm:=nil;
    if ListBoxSelection(Caption,Title,List.Text,Index)=mrOk then
    if (Index>=0) and (Index<Application.MainForm.MDIChildCount)
    then aForm:=Application.MainForm.MDIChildren[Index];
    if (aForm is TForm) then Result:=TForm(aForm);
   end;
  finally
   Kill(List);
  end;
 except
  on E:Exception do BugReport(E,nil,'SelectMDIChildDialog');
 end;
end;

function ActivateMDIChild(aForm:TForm):Boolean;
var i:integer;
begin
 Result:=false;
 try
  if aForm is TForm then
  if aForm.FormStyle=fsMDIChild then
  if Application is TApplication then
  if Application.MainForm is TForm then
  with Application.MainForm do
  if FormStyle=fsMDIForm then
  for i:=0 to MDIChildCount-1 do begin
   if ActiveMDIChild=aForm then begin
    Result:=true;
    break;
   end;
   Next;
   if ActiveMDIChild=aForm then begin
    Result:=true;
    break;
   end;
  end;
 except
  on E:Exception do BugReport(E,nil,'ActivateMDIChild');
 end;
end;

procedure UpdateTheForm(Form:TForm; Index:Integer; var Terminate:Boolean; Custom:Pointer);
begin
 if Form is TForm then Form.Update;
end;

procedure UpdateAllMdiForms;
begin
 ForEachMdiChild(UpdateTheForm,nil);
end;

procedure SetEnabledActions(Enabled:Boolean; const Actions:array of TAction);
var i:Integer;
begin
 for i:=Low(Actions) to High(Actions) do
 if Actions[i] is TAction then
 if Actions[i].Enabled<>Enabled then Actions[i].Enabled:=Enabled;
end;

procedure SetVisibleControls(Visible:Boolean; const Controls:array of TControl);
var i:Integer;
begin
 for i:=Low(Controls) to High(Controls) do
 if Controls[i] is TControl then Controls[i].Visible:=Visible;
end;

procedure SetEnabledControls(Enabled:Boolean; const Controls:array of TControl);
var i:Integer;
begin
 for i:=Low(Controls) to High(Controls) do
 if Controls[i] is TControl then
 if Controls[i].Enabled<>Enabled then Controls[i].Enabled:=Enabled;
end;

procedure ShowControls(const Controls:array of TControl);
begin
 SetVisibleControls(true,Controls);
end;

procedure HideControls(const Controls:array of TControl);
begin
 SetVisibleControls(false,Controls);
end;

function IsValidShortcut(sc:Integer):Boolean;
begin
 Result:=(sc>=0) and (sc<=MaxWord);
end;

const
 VirtualKeys   : THashList = nil;
 MenuShortcuts : THashList = nil;

procedure InitMenuShortcuts;
var Lines:TText; i:Integer; Line,id,sk,ss:ShortString; sc,Key:Integer; Shift:TShiftState;
begin
 if (MenuShortcuts<>nil) then Exit;
 try
  {
  VirtualKeys from [Virtual.Key.Codes]
  }
  Kill(VirtualKeys);
  VirtualKeys:=NewHashList(false,HashList_DefaultHasher);
  VirtualKeys.Master:=@VirtualKeys;
  Lines:=ExtractListSection(SysIniFile,'[Virtual.Key.Codes]',efConfigNC);
  try
   for i:=0 to Lines.Count-1 do begin
    Line:=Trim(Lines[i]); if IsEmptyStr(Line) then continue;
    id:=ExtractWord(1,Line,ScanSpaces); sk:=ExtractWord(2,Line,ScanSpaces);
    if (Length(id)<4) or not SameText(Copy(id,1,3),'VK_') then continue;
    if Str2Int(sk,Key) then VirtualKeys.KeyedLinks[id]:=Key;
   end;
   DebugOut(stdfDebug,LineEnding+'[Virtual.Key.Codes]');
   for i:=0 to VirtualKeys.Count-1 do begin
    id:=VirtualKeys.Keys[i]; sc:=VirtualKeys.KeyedLinks[id];
    DebugOut(stdfDebug,Format('%-12s = %d',[id,sc]));
   end;
   DebugOut(stdfDebug,'[]');
  finally
   Kill(Lines);
  end;
  {
  MenuShortcuts from [System.Menu.ShortCut.Table]
  }
  Kill(MenuShortcuts);
  MenuShortcuts:=NewHashList(false,HashList_DefaultHasher);
  MenuShortcuts.Master:=@MenuShortcuts;
  Lines:=ExtractListSection(SysIniFile,'[System.Menu.ShortCut.Table]',efConfigNC);
  try
   for i:=0 to Lines.Count-1 do begin
    Line:=Trim(Lines[i]); if IsEmptyStr(Line) then continue;
    if not SameText(ExtractWord(2,Line,ScanSpaces),'ShortCut') then continue;
    id:=ExtractWord(1,Line,ScanSpaces); sk:=ExtractWord(3,Line,ScanSpaces);
    ss:=Trim(SkipWords(3,Line,ScanSpaces)); if IsEmptyStr(sk) then continue;
    Shift:=[]; Key:=-1; sc:=-1;
    if Str2Int(sk,Key) and IsEmptyStr(ss) then sc:=Key else begin
     if (Length(sk)=3) and (StrFetch(sk,1)=Apostrophe) and (StrFetch(sk,3)=Apostrophe) then Key:=Ord(StrFetch(sk,2)) else
     if (VirtualKeys.IndexOf(sk)>=0) then Key:=VirtualKeys.KeyedLinks[sk] else continue;
     if (WordIndex('Alt',ss,ScanSpaces)>0) then Include(Shift,ssAlt);
     if (WordIndex('Ctrl',ss,ScanSpaces)>0) then Include(Shift,ssCtrl);
     if (WordIndex('Shift',ss,ScanSpaces)>0) then Include(Shift,ssShift);
     if (sc<0) and (Key>=0) then sc:=ShortCut(Key,Shift);
    end;
    if IsValidShortcut(sc) then MenuShortcuts.KeyedLinks[id]:=sc;
   end;
   DebugOut(stdfDebug,LineEnding+'[System.Menu.ShortCut.Table]');
   for i:=0 to MenuShortcuts.Count-1 do begin
    id:=MenuShortcuts.Keys[i]; sc:=MenuShortcuts.KeyedLinks[id];
    DebugOut(stdfDebug,Format('%-60s ShortCut %s',[id,ShortCutToText(sc)]));
   end;
   DebugOut(stdfDebug,'[]');
  finally
   Kill(Lines);
  end;
 except
  on E:Exception do BugReport(E,nil,'InitMenuShortcuts');
 end;
end;

procedure FreeMenuShortcuts;
begin
 Kill(MenuShortcuts);
 Kill(VirtualKeys);
end;

procedure ApplyMenuShortcut(aMenu:TMenuItem; aShortCut:TShortCut);
var ClassRef:TClass;
 function Found(const arg:LongString):Boolean;
 var sc:Integer;
 begin
  Result:=(MenuShortcuts.IndexOf(arg)>=0);
  if Result then sc:=MenuShortcuts.KeyedLinks[arg] else sc:=-1;
  if IsValidShortcut(sc) then aMenu.ShortCut:=sc;
 end;
begin
 try
  InitMenuShortcuts;
  if (aMenu=nil) then Exit;
  if Found(aMenu.Name) then Exit;
  if (aMenu.Owner=nil) then Exit;
  ClassRef:=aMenu.Owner.ClassType;
  while (ClassRef<>nil) do begin
   if Found(ClassRef.ClassName+'.'+aMenu.Name) then Exit;
   ClassRef:=ClassRef.ClassParent;
  end;
  if aShortCut<>0 then aMenu.ShortCut:=aShortCut;
 except
  on E:Exception do BugReport(E,nil,'ApplyMenuShortcut');
 end;
end;

procedure UpdateMenu(aMenu:TMenuItem; const aCaption,aHint:LongString; aShortCut:TShortCut);
begin
 if (aMenu=nil) then Exit;
 aMenu.Caption:=aCaption;
 aMenu.Hint:=aHint;
 ApplyMenuShortcut(aMenu,aShortCut);
 if aMenu.Action is TAction then with aMenu.Action as TAction do begin
  ShortCut:=aMenu.ShortCut;
  Hint:=aMenu.Hint;
 end;
end;

procedure SetButtonCursor(Component:TComponent; Index:Integer; var Terminate:Boolean; Custom:Pointer);
begin
 if (Component is TButton)
 then (Component as TButton).Cursor:=TCursor(PointerToPtrInt(Custom));
 if (Component is TToolButton)
 then (Component as TToolButton).Cursor:=TCursor(PointerToPtrInt(Custom));
 if (Component is TBitBtn)
 then (Component as TBitBtn).Cursor:=TCursor(PointerToPtrInt(Custom));
 if (Component is TSpeedButton)
 then (Component as TSpeedButton).Cursor:=TCursor(PointerToPtrInt(Custom));
end;

procedure SetAllButtonsCursor(Form:TForm; Cursor:TCursor);
begin
 if Form is TForm then ForEachComponent(Form,SetButtonCursor,PtrIntToPointer(Cursor));
end;

procedure RecordComboBoxHistory(aComboBox:TComboBox; HistoryLength:Integer);
var i,j:Integer; s:LongString;
begin
 if aComboBox is TComboBox then
 with aComboBox do begin
  s:=Text;
  j:=-1;
  for i:=0 to Items.Count-1 do if Items[i]=s then begin
   j:=i;
   break;
  end;
  if j>=0 then Items.Delete(j);
  Items.Insert(0,s);
  while Items.Count>max(HistoryLength,0) do Items.Delete(Items.Count-1);
  Text:=s;
 end;
end;

procedure OpenDialogTypeChangeStdExecute(OpenDialog:TOpenDialog);
var Ext:LongString;
begin
 Ext:=ExtractFilterExt(OpenDialog.Filter,OpenDialog.FilterIndex);
 Ext:=TrimLeadChars(Ext,['.',' ']);
 if IsEmptyStr(Ext) or IsWildCard(Ext) then Ext:='';
 OpenDialog.DefaultExt:=Ext;
end;

procedure OpenDialogSelectType(OpenDialog:TOpenDialog; const FileName:LongString; SetInitialDir:Boolean=True);
var T:TText; i:Integer;
begin
 if OpenDialog is TOpenDialog then
 try
  OpenDialog.FilterIndex:=1;
  OpenDialog.DefaultExt:='';
  T:=NewText;
  try
   T.Text:=StringReplace(OpenDialog.Filter,'|',EOL,[rfReplaceAll]);
   for i:=1 to T.Count div 2 do begin
    if WordIndex(UnifyAlias(ExtractFileExt(FileName)),UnifyAlias(T[i*2-1]),[' ',#9,'*',';'])>0 then begin
     OpenDialog.DefaultExt:=TrimLeadChars(UnifyAlias(ExtractFileExt(FileName)),['.',' ']);
     OpenDialog.FilterIndex:=i;
     Break;
    end;
    if UnifyAlias(T[i*2-1])='*.*' then begin
     OpenDialog.FilterIndex:=i;
     Break;
    end;
   end;
   if SetInitialDir then begin
    if not IsEmptyStr(ExtractFilePath(FileName)) then
    if DirExists(ExtractFilePath(FileName)) then OpenDialog.InitialDir:=ExtractFilePath(UnifyFileAlias(FileName));
    if IsEmptyStr(OpenDialog.InitialDir) then OpenDialog.InitialDir:=HomeDir;
   end;
  finally
   Kill(T);
  end;
 except
  on E:Exception do BugReport(E,nil,'OpenDialogSelectType');
 end;
end;

procedure LocateFormToCenterOfScreen(Form:TForm);
begin
 if Form is TForm then begin
  Form.Left := Screen.DesktopLeft + ((Screen.DesktopWidth  - Form.Width)  div 2);
  Form.Top  := Screen.DesktopTop  + ((Screen.DesktopHeight - Form.Height) div 2);
 end;
end;

procedure LocateFormToCenterOfMouse(Form:TForm);
begin
 if Form is TForm then begin
  Form.Top  := max(Screen.DesktopTop,  min(Mouse.CursorPos.Y-(Form.Height div 2),Screen.DesktopHeight-Form.Height));
  Form.Left := max(Screen.DesktopLeft, min(Mouse.CursorPos.X-(Form.Width div 2),Screen.DesktopWidth-Form.Width));
 end;
end;

function StdDateTimeStr(ms:Double=0):ShortString;
begin
 if (ms=0) then ms:=mSecNow;
 Result:=GetDateStr(ms,'.',true)+'-'+GetTimeStr(ms);
end;

function StdDateTimePrompt(ms:Double=0; Prompt:PChar=nil):ShortString;
begin
 if (ms=0) then ms:=mSecNow;
 if (Prompt=nil) then Prompt:=' => ';
 Result:=GetDateStr(ms,'.',true)+'-'+GetTimeStr(ms)+Prompt;
end;

function HasPrinters;
begin
 Result:=(Printers.Printer.Printers.Count>0);
end;

function HasPrintersDialog:Boolean;
begin
 Result:=NoProblem(HasPrinters,RusEng('Нет доступных принтеров!','No printers available!'));
end;

function SubSystemTurnOn(const SubSystemSectionName:LongString):Boolean;
var IsTurnOn:Boolean;
begin
 IsTurnOn:=false;
 Result:=ReadIniFileVariable(SysIniFile, SubSystemSectionName, 'TurnOn%b',
                             IsTurnOn) and IsTurnOn;
end;

function SubSystemIniFile(const SubSystemSectionName:LongString):LongString;
var Path:ShortString;
begin
 Path:='';
 ReadIniFilePath(SysIniFile, SubSystemSectionName, 'IniFile',
                 ExtractFilePath(SysIniFile), Path);
 Result:=Path;
end;

function SubSystemDataPath(const SubSystemSectionName:LongString):LongString;
var Path:ShortString;
begin
 Path:='';
 ReadIniFilePath(SysIniFile, SubSystemSectionName, 'DataPath',
                 ExtractFilePath(SysIniFile), Path);
 Result:=Path;
 if not IsEmptyStr(Result) then
 if not FileExists(Result,faDirectory) then MkDir(Result);
end;

function GetBackUpName(const FileName,NewExtension:LongString):LongString;
begin
 if not IsEmptyStr(TempDir)
 then Result:=ForceExtension(AddBackSlash(TempDir)+ExtractFileName(FileName), NewExtension)
 else Result:=ForceExtension(FileName, NewExtension);
end;

function  IsControlContainsClientPos(Control:TControl; const ClientPos:TPoint):Boolean;
begin
 if Control is TControl
 then Result:=RectContainsPoint(Rect2I(Control.ClientRect),Point2I(ClientPos))
 else Result:=false;
end;

function IsControlContainsScreenPos(Control:TControl; const ScreenPos:TPoint):Boolean;
begin
 if Control is TControl
 then Result:=RectContainsPoint(Rect2I(Control.ClientRect),Point2I(Control.ScreenToClient(ScreenPos)))
 else Result:=false;
end;

function IsMainThread:Boolean;
begin
 Result:=(GetCurrentThreadID = MainThreadID);
end;

function IsModalFormActive:Boolean;
begin
 Result:=false;
 try
  Result:=(Screen is TScreen) and
          (Screen.ActiveCustomForm is TCustomForm) and
          (fsModal in Screen.ActiveCustomForm.FormState);
 except
  on E:Exception do BugReport(E,nil,'IsModalFormActive');
 end;
end;

procedure NumberOfModalFormsNowCallback(Form:TForm; Index:Integer; var Terminate:Boolean; Custom:Pointer);
begin
 if fsModal in Form.FormState then Inc(Cardinal(Custom^));
end;

function NumberOfModalFormsNow:Cardinal;
begin
 Result:=0;
 ForEachForm(NumberOfModalFormsNowCallback,@Result);
end;

function  GetFormModalResult(Form:TForm):TModalResult;
begin
 if Assigned(Form) then Result:=Form.ModalResult else Result:=0;
end;

function CanShowModal(aForm:TForm; aLimit:Cardinal):Boolean;
begin
 Result:=false;
 if aLimit=High(Cardinal) then aLimit:=DefaultCanShowModalLimit;
 try
  if not IsMainThread then Exit;
  if NumberOfModalFormsNow>aLimit then Exit;
  if aLimit=High(Cardinal) then if IsModalFormActive then Exit;
  if Assigned(aForm) then begin
   if aForm.Visible then Exit;
   if not aForm.Enabled then Exit;
   if fsModal in aForm.FormState then Exit;
   if aForm.FormStyle = fsMDIChild then Exit;
  end;
  Result:=true;
 except
  on E:Exception do BugReport(E,nil,'CanShowModal');
 end;
end;

{$IFDEF WINDOWS}
function IsAdministrator(aError:PShortString):Boolean;
const
 DOMAIN_ALIAS_RID_ADMINS      = $00000220;
 SECURITY_BUILTIN_DOMAIN_RID  = $00000020;
 SECURITY_NT_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5));
var
 I         : Integer;
 Count     : DWORD;
 Token     : THandle;
 psidAdmin : Pointer;
 TokenInfo : PTokenGroups;
 HaveToken : Boolean;
begin
 Result:=False;
 if Win32Platform<VER_PLATFORM_WIN32_NT then Result:=True else
 try
  psidAdmin:=nil;
  TokenInfo:=nil;
  HaveToken:=False;
  if SupportsCheckTokenMembership then Result:=IsUserAnAdmin else
  try
   Token:=0; Count:=0;
   HaveToken:=OpenThreadToken(GetCurrentThread, TOKEN_QUERY,True,Token);
   if (not HaveToken) and (GetLastError=ERROR_NO_TOKEN)
   then HaveToken:=OpenProcessToken(GetCurrentProcess,TOKEN_QUERY,Token);
   if HaveToken then begin
    Win32Check(AllocateAndInitializeSid(SECURITY_NT_AUTHORITY,2,
     SECURITY_BUILTIN_DOMAIN_RID,DOMAIN_ALIAS_RID_ADMINS,0,0,0,0,0,0,psidAdmin));
    if GetTokenInformation(Token, TokenGroups,nil,0,Count)
    or (GetLastError<>ERROR_INSUFFICIENT_BUFFER)
    then RaiseLastWin32Error;
    TokenInfo := PTokenGroups(AllocMem(Count));
    Win32Check(GetTokenInformation(Token,TokenGroups,TokenInfo,Count,Count));
    for I:=0 to TokenInfo^.GroupCount-1 do begin
     Result:=EqualSid(psidAdmin,TokenInfo^.Groups[I].Sid);
     if Result then Break;
    end;
   end;
  finally
   if TokenInfo <> nil then FreeMem(TokenInfo);
   if HaveToken then CloseHandle(Token);
   if psidAdmin <> nil then FreeSid(psidAdmin);
  end;
 except
  on E:Exception do if Assigned(aError) then aError^:=E.Message;
 end;
end;
{$ENDIF ~WINDOWS}

{$IFDEF UNIX}
function IsAdministrator(aError:PShortString):Boolean;
begin
 Result:=IsIamRoot;
end;
{$ENDIF ~UNIX}

function GetRootKeyByName(const Name:LongString):HKey;
begin
 if SameText(Name,'HKEY_LOCAL_MACHINE')  or SameText(Name,'HKLM') then Result:=HKEY_LOCAL_MACHINE  else
 if SameText(Name,'HKEY_CURRENT_USER')   or SameText(Name,'HKCU') then Result:=HKEY_CURRENT_USER   else
 if SameText(Name,'HKEY_CLASSES_ROOT')   or SameText(Name,'HKCR') then Result:=HKEY_CLASSES_ROOT   else
 if SameText(Name,'HKEY_USERS')          or SameText(Name,'HKU')  then Result:=HKEY_USERS          else
 if SameText(Name,'HKEY_CURRENT_CONFIG') or SameText(Name,'HKCC') then Result:=HKEY_CURRENT_CONFIG else
 Result:=0;
end;

function GetDieselPascalExe:LongString;
begin
 Result:='';
 {$IFDEF WINDOWS}
 if IsWindows then Result:=GetSystemAssocExe('.lm9');
 {$ENDIF ~WINDOWS}
 if IsUnix then Result:=Trim(FileSearch('CrossMachine',GetEnv('PATH'),false));
end;

function HasDieselPascalExe:Boolean;
begin
 Result:=false;
 {$IFDEF WINDOWS}
 if IsWindows then Result:=HasSystemAssocExe('.lm9');
 {$ENDIF ~WINDOWS}
 if IsUnix then Result:=(GetDieselPascalExe<>'');
end;

{$IFDEF SKIP_DRAFT}
function LanguageInfoStr(id:Cardinal):LongString;
var Lang:TLanguages; i:Integer;
begin
 Lang:=Languages;
 Result:=Format('$%X',[id]);
 if Assigned(Lang) then
 for i:=0 to Lang.Count-1 do
 if Lang.LocaleID[i]=id then begin
  Result:=Format('%s,%s,%s',[Result,Lang.Ext[i],Lang.Name[i]]);
  break;
 end;
end;
{$ENDIF ~SKIP_DRAFT}

procedure EchoBriefSystemInfo;
begin
 EchoBriefSystemInfoEx(false);
end;

procedure EchoBriefSystemInfoEx(verbose:Boolean);
const
 Rights : array[Boolean] of PChar=('user','root');
var
 s1,s2 : ShortString;
 verb  : Integer;
 i,j   : Integer;
 pid   : DWORD;
 prc   : DWORD;
 aff   : QWORD;
begin
 try
  if verbose then verb:=1 else verb:=0;
  Echo(RusEng('Краткая системная информация:','Brief system information:'));
  //
  // OS info
  //
  Echo(Format(' Computer   : %s',[ComputerName]));
  Echo(Format(' OS version : %s',[GetOSVersionString]));
  Echo(Format(' SystemRoot : %s',[SystemRootDir]));
  Echo(Format(' ComSpec    : %s',[GetComSpec]));
  Echo(Format(' CrwRoot    : %s',[HomeDir]));
  Echo(Format(' CurrentDir : %s',[GetCurrDir]));
  //
  // RAM info
  //
  Echo(Format(' RAM        : %d MB total, %d MB free, %d MB = %d %% used',
      [ReadProcMemInfo('MemTotal') shr 20,
       (ReadProcMemInfo('MemAvailable')+ReadProcMemInfo('MemFree')) shr 20,
       ReadProcMemInfo('MemUsed') shr 20,
       ReadProcMemInfo('MemLoad') ]));
  Echo(Format(' SWAP       : %d MB total, %d MB free, %d MB = %d %% used',
      [ReadProcMemInfo('SwapTotal') shr 20,
       ReadProcMemInfo('SwapFree') shr 20,
       ReadProcMemInfo('SwapUsed') shr 20,
       ReadProcMemInfo('SwapLoad') ]));
  //
  // Model info
  //
  s1:=GetSystemModelInfo;
  if (Length(s1)>0) then
  Echo(Format(' Model      : %s',[s1]));
  //
  // System info
  //
  s1:=GetSystemVersionString;
  if (Length(s1)>0) then
  Echo(Format(' System     : %s',[s1]));
  //
  // VideoBios info
  //
  s1:=GetVideoBiosInfo;
  if (Length(s1)>0) then
  Echo(Format(' VideoBios  : %s',[s1]));
  //
  // Video system info
  //
  s1:=wmctrl.WindowManagerName;
  if (Length(s1)>0) then
  Echo(Format(' WinMan     : %s',[s1]));
  s1:=wmctrl.XLibInfo;
  if (Length(s1)>0) then
  Echo(Format(' XServer    : %s',[s1]));
  s1:=wmctrl.DisplayInfo;
  if (Length(s1)>0) then
  Echo(Format(' Display    : %s',[s1]));
  //
  // SystemBios info
  //
  s1:=GetSystemBiosInfo;
  if (Length(s1)>0) then
  Echo(Format(' SystemBios : %s',[s1]));
  //
  // CPU info
  //
  if (cpu_count>1) then begin
   j:=0; s1:='';
   aff:=GetProcessAffinityMask;
   for i:=0 to cpu_count-1 do
   if HasFlags(aff shr i,1) then begin
    if j>0
    then s1:=Format('%s,%d',[s1,i])
    else s1:=Format('%d',[i]);
    inc(j);
   end;
   s1:=Format('(%s)',[s1]);
  end else s1:='(0)';
  Echo(Format(' CPU Info   : Count:%d, List:%s, Arch:%s, Ident:%s',
      [cpu_count,s1,GetCpuVersionInfo(0,'Architecture'),
      GetCpuVersionInfo(0,'Identifier')]));
  for i:=0 to cpu_count-1 do begin
   s1:=Trim(GetCpuVersionInfo(i,'ProcessorNameString')); if Length(s1)=0 then continue;
   s2:=Trim(GetCpuVersionInfo(i,'VendorIdentifier'));    if Length(s2)>0 then s1:=Format('%s, %s',[s1,s2]);
   s2:=Trim(GetCpuVersionInfo(i,'Identifier'));          if Length(s2)>0 then s1:=Format('%s, %s',[s1,s2]);
   Echo(Format(' CPU %-2d     : %s',[i,s1]));
  end;
  if (CpuFrequencyMHz>0) or (GetCpuFreqMHzNominal>0) then
  Echo(Format(' CPU Freq   : %1.3f MHz (eastimated), %d MHz (nominal)',[CpuFrequencyMHz,GetCpuFreqMHzNominal]));
  //
  // Clock Resolution info
  //
  Echo(Format(' ClockRes   : Std=%1.3f,Max=%1.3f,Min=%1.3f,Act=%1.3f ms',
             [GetClockResolution(cr_StdRes)/FileTimesPerMSec,
              GetClockResolution(cr_MinRes)/FileTimesPerMSec,
              GetClockResolution(cr_MaxRes)/FileTimesPerMSec,
              GetClockResolution(cr_ActRes)/FileTimesPerMSec]));
  //
  // COM ports info
  //
  s1:=EnumComPorts(',');
  if IsEmptyStr(s1) then s1:='NONE';
  Echo(Format(' COM ports  : %s',[s1]));
  //
  //  Language information.
  //
  Echo(Format(' CodePage   : ANSI CP%d, OEM CP%d.',[GetACP,GetOEMCP]));
  {$IFDEF SKIP_DRAFT}
  Echo(Format(' Language   : System=%s; User=%s.',[LanguageInfoStr(GetSystemDefaultUILanguage),LanguageInfoStr(GetUserDefaultUILanguage)]));
  Echo(Format(' Locale     : System=%s; User=%s.',[LanguageInfoStr(GetSystemDefaultLCID),LanguageInfoStr(GetUserDefaultLCID)]));
  {$ENDIF ~SKIP_DRAFT}
  //
  // Process info
  //
  Echo(Format(' User       : %s',[GetListOfUserMembership(',',true)]));
  Echo(Format(' Login      : %s@%s on %s, as %s',[UserName,UserDomain(UserName,HostName),ComputerName,Rights[IsAdministrator]]));
  {$IFDEF SKIP_DRAFT}
  pid:=GetCurrentProcessID;
  prc:=GetPriorityClass(GetCurrentProcess);
  Echo(Format(' Process    : PID %u, with %s priority (%d)',[pid,GetPriorityClassName(prc),GetPriorityClassLevel(prc)]));
  {$ENDIF ~SKIP_DRAFT}
  Echo(Format(' Network    : %s %s %s',[HostName(verb),GetIPAddresses,GetMacAddresses]));
  Echo(Format(' CmdLine    : %s',[GetCommandLine]));
 except
  on E:Exception do BugReport(E,nil,'EchoBriefSystemInfoEx');
 end;
end;

function GetSystemParamStr(const Category,ParamName:LongString):LongString;
 function GetSystemOsStr(const ParamName:LongString):LongString;
 begin
  Result:='';
  if IsSameText(ParamName,'Platform') then begin
   if IsWindows then Result:='Windows' else
   if IsLinux   then Result:='Linux'   else
   if IsUnix    then Result:='Unux'    else
   Result:='Unknown';
  end else
  if IsSameText(ParamName,'Version') then Result:=GetOSVersionString else
  if IsSameText(ParamName,'SysRoot') then Result:=SystemRootDir      else
  if IsSameText(ParamName,'ComSpec') then Result:=GetComSpec         else
  if IsSameText(ParamName,'Shell')   then Result:=GetShell           else
  Result:='Unknown';
 end;
 function GetSystemRamStr(const ParamName:LongString):LongString;
 {$IFDEF WINDOWS}
 var ms:TMemoryStatus;
 {$ENDIF WINDOWS}
 begin
  Result:='';
  if IsSameText(ParamName,'MemTotal')      then Result:=IntToStr(ReadProcMemInfo('MemTotal'))     else
  if IsSameText(ParamName,'TotalPhys')     then Result:=IntToStr(ReadProcMemInfo('MemTotal'))     else
  if IsSameText(ParamName,'MemAvailable')  then Result:=IntToStr(ReadProcMemInfo('MemAvailable')) else
  if IsSameText(ParamName,'AvailPhys')     then Result:=IntToStr(ReadProcMemInfo('MemAvailable')) else
  if IsSameText(ParamName,'MemLoad')       then Result:=IntToStr(ReadProcMemInfo('MemLoad'))      else
  if IsSameText(ParamName,'MemoryLoad')    then Result:=IntToStr(ReadProcMemInfo('MemLoad'))      else
  if IsSameText(ParamName,'SwapTotal')     then Result:=IntToStr(ReadProcMemInfo('SwapTotal'))    else
  if IsSameText(ParamName,'TotalPageFile') then Result:=IntToStr(ReadProcMemInfo('SwapTotal'))    else
  if IsSameText(ParamName,'SwapFree')      then Result:=IntToStr(ReadProcMemInfo('SwapFree'))     else
  if IsSameText(ParamName,'AvailPageFile') then Result:=IntToStr(ReadProcMemInfo('SwapFree'))     else
  {$IFDEF WINDOWS}
  SafeFillChar(ms,sizeof(ms),0); ms.dwLength:=sizeof(ms); GlobalMemoryStatus(ms);
  if IsSameText(ParamName,'TotalVirtual')  then Result:=IntToStr(ms.dwTotalVirtual)  else
  if IsSameText(ParamName,'AvailVirtual')  then Result:=IntToStr(ms.dwAvailVirtual)  else
  {$ENDIF ~WINDOWS}
  Result:='';
 end;
 function GetSystemProcessStr(const ParamName:LongString):LongString;
 var pc,pe,pk,pu,tc,te,tk,tu:Int64; {$IFDEF WINDOWS}var hCnt:DWORD;{$ENDIF}
 begin
  Result:='';
  if IsSameText(ParamName,'Id')                  then Result:=IntToStr(GetCurrentProcessId) else
  if IsSameText(ParamName,'ParentId')            then Result:=IntToStr(GetParentProcessId)  else
  if IsSameText(ParamName,'ParentExe')           then Result:=GetParentProcessName          else
  if IsSameText(ParamName,'AllocMemSize')        then Result:=IntToStr(GetAllocMemSize)     else
  if IsSameText(ParamName,'AllocMemCount')       then Result:=IntToStr(GetAllocMemCount)    else
  {$IFDEF WINDOWS}
  if IsSameText(ParamName,'GdiObjectsQuota')     then Result:=IntToStr(GetGdiProcessHandleQuota)    else
  if IsSameText(ParamName,'UserObjectsQuota')    then Result:=IntToStr(GetUserProcessHandleQuota)   else
  if IsSameText(ParamName,'KernelObjectsQuota')  then Result:=IntToStr(GetKernelProcessHandleQuota) else
  if IsSameText(ParamName,'GdiObjects')          then Result:=IntToStr(GetGuiResources(GetCurrentProcess,GR_GDIOBJECTS))       else
  if IsSameText(ParamName,'UserObjects')         then Result:=IntToStr(GetGuiResources(GetCurrentProcess,GR_USEROBJECTS))      else
  if IsSameText(ParamName,'GdiObjects_Peak')     then Result:=IntToStr(GetGuiResources(GetCurrentProcess,GR_GDIOBJECTS_PEAK))  else
  if IsSameText(ParamName,'UserObjects_Peak')    then Result:=IntToStr(GetGuiResources(GetCurrentProcess,GR_USEROBJECTS_PEAK)) else
  if IsSameText(ParamName,'KernelObjects') then begin
   hCnt:=0;
   if GetProcessHandleCount(GetCurrentProcess,hCnt)
   then Result:=IntToStr(hCnt) else Result:='0';
  end else
  if IsSameText(ParamName,'Times') then begin
   pc:=0;pe:=0;pk:=0;pu:=0;tc:=0;te:=0;tk:=0;tu:=0;
   if GetProcessTimes(GetCurrentProcess,TFileTime(pc),TFileTime(pe),TFileTime(pk),TFileTime(pu))
   and GetThreadTimes(GetCurrentThread, TFileTime(tc),TFileTime(te),TFileTime(tk),TFileTime(tu))
   then Result:=Format('%d,%d,%d,%d,%d,%d,%d,%d',[pc,pe,pk,pu,tc,te,tk,tu]);
  end else
  {$ENDIF ~WINDOWS}
  {$IFDEF UNIX}
  if IsSameText(ParamName,'Times') then begin
   pc:=GetProcessStartTimeAsFileTime;
   pe:=0;pk:=0;pu:=0;tc:=0;te:=0;tk:=0;tu:=0;
   if GetProcessTimesAsFileTime(pk,pu) and GetThreadTimesAsFileTime(tk,tu)
   then Result:=Format('%d,%d,%d,%d,%d,%d,%d,%d',[pc,pe,pk,pu,tc,te,tk,tu]);
  end else
  {$ENDIF ~UNIX}
  Result:='';
 end;
 function GetSystemMetricsStr(const ParamName:LongString):LongString;
 var Code:Integer;
  function GetSystemMetricsName(Code:Integer):LongString;
  begin
   case Code of
    SM_CXSCREEN          : Result:='SM_CXSCREEN';
    SM_CYSCREEN          : Result:='SM_CYSCREEN';
    SM_CXVSCROLL         : Result:='SM_CXVSCROLL';
    SM_CYHSCROLL         : Result:='SM_CYHSCROLL';
    SM_CYCAPTION         : Result:='SM_CYCAPTION';
    SM_CXBORDER          : Result:='SM_CXBORDER';
    SM_CYBORDER          : Result:='SM_CYBORDER';
    SM_CXDLGFRAME        : Result:='SM_CXDLGFRAME';
    SM_CYDLGFRAME        : Result:='SM_CYDLGFRAME';
    SM_CYVTHUMB          : Result:='SM_CYVTHUMB';
    SM_CXHTHUMB          : Result:='SM_CXHTHUMB';
    SM_CXICON            : Result:='SM_CXICON';
    SM_CYICON            : Result:='SM_CYICON';
    SM_CXCURSOR          : Result:='SM_CXCURSOR';
    SM_CYCURSOR          : Result:='SM_CYCURSOR';
    SM_CYMENU            : Result:='SM_CYMENU';
    SM_CXFULLSCREEN      : Result:='SM_CXFULLSCREEN';
    SM_CYFULLSCREEN      : Result:='SM_CYFULLSCREEN';
    SM_CYKANJIWINDOW     : Result:='SM_CYKANJIWINDOW';
    SM_MOUSEPRESENT      : Result:='SM_MOUSEPRESENT';
    SM_CYVSCROLL         : Result:='SM_CYVSCROLL';
    SM_CXHSCROLL         : Result:='SM_CXHSCROLL';
    SM_DEBUG             : Result:='SM_DEBUG';
    SM_SWAPBUTTON        : Result:='SM_SWAPBUTTON';
    SM_RESERVED1         : Result:='SM_RESERVED1';
    SM_RESERVED2         : Result:='SM_RESERVED2';
    SM_RESERVED3         : Result:='SM_RESERVED3';
    SM_RESERVED4         : Result:='SM_RESERVED4';
    SM_CXMIN             : Result:='SM_CXMIN';
    SM_CYMIN             : Result:='SM_CYMIN';
    SM_CXSIZE            : Result:='SM_CXSIZE';
    SM_CYSIZE            : Result:='SM_CYSIZE';
    SM_CXFRAME           : Result:='SM_CXFRAME';
    SM_CYFRAME           : Result:='SM_CYFRAME';
    SM_CXMINTRACK        : Result:='SM_CXMINTRACK';
    SM_CYMINTRACK        : Result:='SM_CYMINTRACK';
    SM_CXDOUBLECLK       : Result:='SM_CXDOUBLECLK';
    SM_CYDOUBLECLK       : Result:='SM_CYDOUBLECLK';
    SM_CXICONSPACING     : Result:='SM_CXICONSPACING';
    SM_CYICONSPACING     : Result:='SM_CYICONSPACING';
    SM_MENUDROPALIGNMENT : Result:='SM_MENUDROPALIGNMENT';
    SM_PENWINDOWS        : Result:='SM_PENWINDOWS';
    SM_DBCSENABLED       : Result:='SM_DBCSENABLED';
    SM_CMOUSEBUTTONS     : Result:='SM_CMOUSEBUTTONS';
    SM_SECURE            : Result:='SM_SECURE';
    SM_CXEDGE            : Result:='SM_CXEDGE';
    SM_CYEDGE            : Result:='SM_CYEDGE';
    SM_CXMINSPACING      : Result:='SM_CXMINSPACING';
    SM_CYMINSPACING      : Result:='SM_CYMINSPACING';
    SM_CXSMICON          : Result:='SM_CXSMICON';
    SM_CYSMICON          : Result:='SM_CYSMICON';
    SM_CYSMCAPTION       : Result:='SM_CYSMCAPTION';
    SM_CXSMSIZE          : Result:='SM_CXSMSIZE';
    SM_CYSMSIZE          : Result:='SM_CYSMSIZE';
    SM_CXMENUSIZE        : Result:='SM_CXMENUSIZE';
    SM_CYMENUSIZE        : Result:='SM_CYMENUSIZE';
    SM_ARRANGE           : Result:='SM_ARRANGE';
    SM_CXMINIMIZED       : Result:='SM_CXMINIMIZED';
    SM_CYMINIMIZED       : Result:='SM_CYMINIMIZED';
    SM_CXMAXTRACK        : Result:='SM_CXMAXTRACK';
    SM_CYMAXTRACK        : Result:='SM_CYMAXTRACK';
    SM_CXMAXIMIZED       : Result:='SM_CXMAXIMIZED';
    SM_CYMAXIMIZED       : Result:='SM_CYMAXIMIZED';
    SM_NETWORK           : Result:='SM_NETWORK';
    SM_CLEANBOOT         : Result:='SM_CLEANBOOT';
    SM_CXDRAG            : Result:='SM_CXDRAG';
    SM_CYDRAG            : Result:='SM_CYDRAG';
    SM_SHOWSOUNDS        : Result:='SM_SHOWSOUNDS';
    SM_CXMENUCHECK       : Result:='SM_CXMENUCHECK';
    SM_CYMENUCHECK       : Result:='SM_CYMENUCHECK';
    SM_SLOWMACHINE       : Result:='SM_SLOWMACHINE';
    SM_MIDEASTENABLED    : Result:='SM_MIDEASTENABLED';
    SM_MOUSEWHEELPRESENT : Result:='SM_MOUSEWHEELPRESENT';
    SM_XVIRTUALSCREEN    : Result:='SM_XVIRTUALSCREEN';
    SM_YVIRTUALSCREEN    : Result:='SM_YVIRTUALSCREEN';
    SM_CXVIRTUALSCREEN   : Result:='SM_CXVIRTUALSCREEN';
    SM_CYVIRTUALSCREEN   : Result:='SM_CYVIRTUALSCREEN';
    SM_CMONITORS         : Result:='SM_CMONITORS';
    SM_SAMEDISPLAYFORMAT : Result:='SM_SAMEDISPLAYFORMAT';
    SM_CMETRICS          : Result:='SM_CMETRICS';
    else                   Result:='';
   end;
  end;
 begin
  Result:='';
  if not IsEmptyStr(ParamName) then
  for Code:=0 to SM_CMETRICS do
  if IsSameText(ParamName,GetSystemMetricsName(Code)) then begin
   Result:=IntToStr(GetSystemMetrics(Code));
   Break;
  end;
 end;
 function GetSystemScreenStr(const ParamName:LongString):LongString;
 var i:Integer; rcWork:TRect; MonInfo:TMonitorInfo; currMonitor,primMonitor:TMonitor; s:LongString;
 begin
  Result:='';
  if SameText(ParamName,'width')         then Result:=IntToStr(Screen.Width)             else
  if SameText(ParamName,'height')        then Result:=IntToStr(Screen.Height)            else
  if SameText(ParamName,'desktopleft')   then Result:=IntToStr(Screen.DesktopLeft)       else
  if SameText(ParamName,'desktoptop')    then Result:=IntToStr(Screen.DesktopTop)        else
  if SameText(ParamName,'desktopwidth')  then Result:=IntToStr(Screen.DesktopWidth)      else
  if SameText(ParamName,'desktopheight') then Result:=IntToStr(Screen.DesktopHeight)     else
  if SameText(ParamName,'pixelsperinch') then Result:=IntToStr(Screen.PixelsPerInch)     else
  if SameText(ParamName,'monitorcount')  then Result:=IntToStr(Screen.MonitorCount)      else
  if SameText(ParamName,'colordepth')    then Result:=IntToStr(GetScreenColorDepth);
  if (Result<>'') then Exit;
  if SameText(Copy(ParamName,1,4),'work') then
  if SystemParametersInfo(SPI_GETWORKAREA, 0, @rcWork, 0) then begin
   if SameText(ParamName,'workleft')     then Result:=IntToStr(rcWork.Left)              else
   if SameText(ParamName,'worktop')      then Result:=IntToStr(rcWork.Top)               else
   if SameText(ParamName,'workwidth')    then Result:=IntToStr(rcWork.Right-rcWork.Left) else
   if SameText(ParamName,'workheight')   then Result:=IntToStr(rcWork.Bottom-rcWork.Top);
  end;
  if (Result<>'') then Exit;
  currMonitor:=nil; primMonitor:=nil;
  if SameText(Copy(ParamName,1,7),'monitor') then
  for i:=0 to Screen.MonitorCount-1 do begin
   s:=Format('monitor%dleft',  [i]);  if SameText(ParamName,s) then begin Result:=IntToStr(Screen.Monitors[i].Left);   break; end;
   s:=Format('monitor%dtop',   [i]);  if SameText(ParamName,s) then begin Result:=IntToStr(Screen.Monitors[i].Top);    break; end;
   s:=Format('monitor%dwidth', [i]);  if SameText(ParamName,s) then begin Result:=IntToStr(Screen.Monitors[i].Width);  break; end;
   s:=Format('monitor%dheight',[i]);  if SameText(ParamName,s) then begin Result:=IntToStr(Screen.Monitors[i].Height); break; end;
   MonInfo.cbSize:=sizeof(MonInfo);
   if GetMonitorInfo(Screen.Monitors[i].Handle,@MonInfo) then begin
    s:=Format('monitor%dworkleft',  [i]);  if SameText(ParamName,s) then begin Result:=IntToStr(MonInfo.rcWork.Left);  break; end;
    s:=Format('monitor%dworktop',   [i]);  if SameText(ParamName,s) then begin Result:=IntToStr(MonInfo.rcWork.Top);   break; end;
    s:=Format('monitor%dworkwidth', [i]);  if SameText(ParamName,s) then begin Result:=IntToStr(MonInfo.rcWork.Right-MonInfo.rcWork.Left); break; end;
    s:=Format('monitor%dworkheight',[i]);  if SameText(ParamName,s) then begin Result:=IntToStr(MonInfo.rcWork.Bottom-MonInfo.rcWork.Top); break; end;
    s:=Format('monitor%dflags',     [i]);  if SameText(ParamName,s) then begin Result:=IntToStr(MonInfo.dwFlags);      break; end;
    if MonInfo.dwFlags and MONITORINFOF_PRIMARY <> 0 then primMonitor:=Screen.Monitors[i];
   end;
  end;
  if (Result<>'') then Exit;
  if Application.MainForm is TForm then currMonitor:=Application.MainForm.Monitor;
  if currMonitor is TMonitor then if SameText(ParamName,'monitornumber')  then Result:=IntToStr(currMonitor.MonitorNum);
  if primMonitor is TMonitor then if SameText(ParamName,'monitorprimary') then Result:=IntToStr(primMonitor.MonitorNum);
 end;
begin
 Result:='';
 if SameText(Category,'OS')      then Result:=GetSystemOsStr(ParamName) else
 if SameText(Category,'Ram')     then Result:=GetSystemRamStr(ParamName) else
 if SameText(Category,'Process') then Result:=GetSystemProcessStr(ParamName) else
 if SameText(Category,'Metrics') then Result:=GetSystemMetricsStr(ParamName) else
 if SameText(Category,'Screen')  then Result:=GetSystemScreenStr(ParamName);
end;

{$IFDEF SKIP_DRAFT}
function OpenWinHelpTopic(const Path:LongString; const Topic:LongString=''):Boolean;
begin
 Result:=false;
 try
  if not FileExists(Path) then RAISE EHelpError.Create(Format('File not found:%s%s',[EOL,Path]));
  if IsEmptyStr(Topic) then begin
   if not WinHelp(0,PChar(Path),HELP_INDEX,0)
   then RAISE EHelpError.Create(Format('Could not open help file:%s%s',[EOL,Path]));
  end else begin
   if not WinHelp(0,PChar(Path),HELP_CONTENTS,0)
   or not WinHelp(0,PChar(Path),HELP_KEY,DWORD(Topic))
   then RAISE EHelpError.Create(Format('Could not open help file:%s%s',[EOL,Path]));
  end;
  Result:=true;
 except
  on E:Exception do BugReport(E,nil,'OpenWinHelpTopic');
 end;
end;

function OpenWinHelpTopicByLink(const HomeDir,IniFile,Section,Link:LongString; const Topic:LongString=''):Boolean;
var Path:ShortString;
begin
 Result:=false;
 try
  if not ReadIniFilePath(IniFile,Section,Link,HomeDir,Path)
  then RAISE EHelpError.Create(Format('%s is not defined in %s %s',[Link,ExtractFileNameExt(IniFile),Section]));
  Result:=OpenWinHelpTopic(Path,Topic);
 except
  on E:Exception do BugReport(E,nil,'OpenWinHelpTopicByLink');
 end;
end;
{$ENDIF ~SKIP_DRAFT}

function  GetWordUnderCursor(const aText:LongString; aCursor:Integer; const SpecChars:LongString=''):LongString;
const alfa:TCharSet=['a'..'z','A'..'Z','0'..'9','_'];
var i,c,b,e:Integer;
begin
 Result:='';
 if Length(aText)>0 then
 try
  c:=Max(1,Min(aCursor+1,Length(aText)));
  b:=c+1;
  e:=c-1;
  for i:=c downto 1 do if (aText[i] in alfa) then b:=i else Break;
  for i:=c to Length(aText) do if (aText[i] in alfa) then e:=i else Break;
  if (e>=b) then Result:=Copy(aText,b,e-b+1) else
  if (Pos(aText[c],SpecChars)>0) then Result:=aText[c];
 except
  on E:Exception do BugReport(E,nil,'GetWordUnderCursor');
 end;
end;

function GuardOpenDialog(OpenDialog:TOpenDialog):TOpenDialog;
begin
 Result:=OpenDialog;
 if Assigned(OpenDialog) then
 try
  if Guard.Level<ga_Root
  then OpenDialog.Options:=OpenDialog.Options+[ofOldStyleDialog,ofNoNetworkButton]
  else OpenDialog.Options:=OpenDialog.Options-[ofOldStyleDialog,ofNoNetworkButton];
  OpenDialog.Options:=OpenDialog.Options+[ofNoChangeDir];
 except
  on E:Exception do BugReport(E,nil,'GuardOpenDialog');
 end;
end;

function CheckEditPasswordChar(Edit:TEdit; aPasswordChar:Char):Char;
begin
 Result:=#0;
 if Assigned(Edit) then
 try
  Result:=Edit.PasswordChar;
  {$IFDEF WINDOWS}
  if Edit.HandleAllocated then begin
   Result:=Chr(SendMessage(Edit.Handle, EM_GETPASSWORDCHAR, 0, 0));
   if Result<>aPasswordChar then begin
    SendMessage(Edit.Handle, EM_SETPASSWORDCHAR, Ord(aPasswordChar), 0);
    Edit.Text:=''; Edit.SetTextBuf(PChar(Edit.Text));
   end;
  end;
  {$ENDIF ~WINDOWS}
  if Result<>aPasswordChar then Edit.PasswordChar:=aPasswordChar;
 except
  on E:Exception do BugReport(E,nil,'CheckEditPasswordChar');
 end;
end;

{$IFDEF WINDOWS}
function IsWindowTopMost(Handle:HWND):Boolean; overload;
var pwi:TWindowInfo;
begin
 Result:=False;
 try
  SafeFillChar(pwi,SizeOf(pwi),0);
  if IsWindow(Handle) then
  if GetWindowInfo(Handle,pwi) then
  if pwi.dwExStyle and WS_EX_TOPMOST <> 0 then Result:=True;
 except
  on E:Exception do BugReport(E,nil,'IsWindowTopMost');
 end;
end;

function IsWindowTopMost(Form:TForm):Boolean; overload;
begin
 Result:=False;
 if Assigned(Form) then
 try
  Result:=IsWindowTopMost(Form.Handle);
 except
  on E:Exception do BugReport(E,nil,'IsWindowTopMost');
 end;
end;
 
procedure MakeWindowTopMost(Handle:HWND); overload;
begin
 try
  if IsWindow(Handle) then
  if not IsWindowTopMost(Handle) then
  SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
 except
  on E:Exception do BugReport(E,nil,'MakeWindowTopMost');
 end;
end;
{$ENDIF ~WINDOWS}

procedure MakeWindowTopMost(Form:TForm; aSysWide:Boolean=false); overload;
begin
 if Assigned(Form) then
 try
  if aSysWide
  then Form.FormStyle:=fsSystemStayOnTop
  else Form.FormStyle:=fsStayOnTop;
  {$IFDEF WINDOWS}
  if Form.FormStyle in [fsNormal, fsStayOnTop] then MakeWindowTopMost(Form.Handle);
  {$ENDIF ~WINDOWS}
 except
  on E:Exception do BugReport(E,nil,'MakeWindowTopMost');
 end;
end;

function GetAppFormBounds:TRect;
var win:HWND;
begin
 win:=0;
 Result:=Rect(0,0,0,0);
 if (Application<>nil) then
 if (Application.MainForm<>nil) then win:=Application.MainForm.Handle;
 if (win<>0) and IsWindow(win) and (GetWindowRect(win,Result)<>0) then Exit;
 with Screen do Result:=Rect(0,0,Width,Height);
end;

function GetAppFormBoundsStr(delim:Char=' '):LongString;
begin
 with GetAppFormBounds do Result:=Format('%d %d %d %d',[Left,Top,Right,Bottom]);
 if (delim<>' ') then Result:=StringReplace(Result,' ',delim,[rfReplaceAll]);
end;
 
function GetAppClientBounds:TRect;
var win:HWND;
begin
 win:=0;
 Result:=Rect(0,0,0,0);
 if (Application<>nil) then
 if (Application.MainForm<>nil) then
 if (Application.MainForm.FormStyle=fsMDIForm) then win:=Application.MainForm.ClientHandle;
 if (win<>0) and IsWindow(win) and (GetWindowRect(win,Result)<>0) then Exit;
 with Screen do Result:=Rect(0,0,Width,Height);
end;

function GetAppClientBoundsStr(delim:Char=' '):LongString;
begin
 with GetAppClientBounds do Result:=Format('%d %d %d %d',[Left,Top,Right,Bottom]);
 if (delim<>' ') then Result:=StringReplace(Result,' ',delim,[rfReplaceAll]);
end;

function  ShowTooltip(const arg:LongString):Integer;
var Iter:Integer; path:LongString;
begin
 Result:=0;
 for Iter:=1 to 2 do begin
  if ((Length(TheFpQuiTipExe)>0) and FileExists(TheFpQuiTipExe))
  or ((Length(TheUnixExe)>0) and FileExists(TheUnixExe)) then begin
   if not IsEmptyStr(arg) then Result:=SendToMainConsole('@silent @tooltip '+Trim(arg)+EOL) else Result:=1;
   break;
  end;
  if Iter>1 then break;
  path:=GetEnv('PATH');
  TheUnixExe:=FileSearch('unix.exe',path);
  TheFpQuiTipExe:=FileSearch('fpquitip.exe',path);
 end;
end;

procedure InitTooltip;
begin
 if (Length(TheUnixExe)=0) or not FileExists(TheUnixExe)
 then TheUnixExe:=FileSearch('unix.exe',GetEnv('PATH'));
 if (Length(TheFpQuiTipExe)=0) or not FileExists(TheFpQuiTipExe)
 then TheFpQuiTipExe:=FileSearch('fpquitip.exe',GetEnv('PATH'));
end;

procedure FreeTooltip;
begin
 TheUnixExe:='';
 TheFpQuiTipExe:='';
end;

function GetScreenColorDepth:Integer;
var h:{$IFDEF WINDOWS}Windows.{$ENDIF}HDC;
begin
 Result:=0;
 h:=GetDC(0);
 if (h<>0) then begin
  Result:=GetDeviceCaps(h,BITSPIXEL);
  ReleaseDC(0,h);
 end;
end;

{$IFDEF WINDOWS}
 // https://docs.microsoft.com/en-us/windows/desktop/api/winuser/nf-winuser-getsystemmetrics
 // GetSystemMetrics(SM_SHUTTINGDOWN) : Nonzero if the current session is shutting down; otherwise, 0.
function IsSystemShuttingDown:Boolean;
begin
 Result:=(GetSystemMetrics(SM_SHUTTINGDOWN)<>0);
end;

 // https://docs.microsoft.com/en-us/windows/desktop/api/processthreadsapi/nf-processthreadsapi-setprocessshutdownparameters
 // This function sets a shutdown order for a process relative to the other processes in the system.
 // dwLevel = The shutdown priority for a process relative to other processes in the system (from high to low).
 //           Application levels is $100-$3FF, default is $280, shutdown order from hight to low.
 // dwFlags = SHUTDOWN_NORETRY = The system terminates the process without displaying a retry dialog box for the user.
function SetProcessShutdownParameters(dwLevel,dwFlags:DWORD):BOOL; stdcall;
type TFunc=function(dwLevel,dwFlags:DWORD):BOOL stdcall;
var h:THandle; const f:TFunc = nil;
begin
 Result:=FALSE;
 try
  if not Assigned(f) then begin
   h:=GetModuleHandle('kernel32.dll');
   if h<>0 then f:=GetProcAddress(h,'SetProcessShutdownParameters') else f:=nil;
  end;
  if Assigned(f) then Result:=f(dwLevel,dwFlags);
 except
  on E:Exception do BugReport(E,nil,'SetProcessShutdownParameters');
 end;
end;

 // https://docs.microsoft.com/en-us/windows/desktop/api/processthreadsapi/nf-processthreadsapi-getprocessshutdownparameters
 // Retrieves the shutdown parameters for the currently calling process.
function GetProcessShutdownParameters(lpdwLevel,lpdwFlags:LPDWORD):BOOL; stdcall;
type TFunc=function(lpdwLevel,lpdwFlags:LPDWORD):BOOL stdcall;
var h:THandle; const f:TFunc = nil;
begin
 Result:=FALSE;
 try
  if not Assigned(f) then begin
   h:=GetModuleHandle('kernel32.dll');
   if h<>0 then f:=GetProcAddress(h,'GetProcessShutdownParameters') else f:=nil;
  end;
  if Assigned(f) then Result:=f(lpdwLevel,lpdwFlags);
 except
  on E:Exception do BugReport(E,nil,'GetProcessShutdownParameters');
 end;
end;
{$ENDIF ~WINDOWS}

 {
 *******************************************************************************
 MUI support functions
 *******************************************************************************
 }
function GetACP:LANGID;
begin
 {$IFDEF WINDOWS}
 Result:=Windows.GetACP;
 {$ELSE}
 Result:=DefaultSystemCodePage;
 {$ENDIF}
end;

function GetOEMCP:LANGID;
begin
 {$IFDEF WINDOWS}
 Result:=Windows.GetOEMCP;
 {$ELSE}
 Result:=DefaultSystemCodePage;
 {$ENDIF}
end;

{$IFDEF SKIP_DRAFT}
 // https://docs.microsoft.com/en-us/windows/desktop/api/winnls/nf-winnls-getsystemdefaultuilanguage
 // Returns the language identifier for the system default UI language of the operating system.
 {$IFDEF WINDOWS}
function GetSystemDefaultUILanguage:LANGID;
type TGetLangIdFunc=function():LANGID stdcall;
var h:THandle; const f:TGetLangIdFunc = nil;
begin
 Result:=0;
 try
  if not Assigned(f) then begin
   h:=GetModuleHandle('kernel32.dll');
   if h<>0 then f:=GetProcAddress(h,'GetSystemDefaultUILanguage') else f:=nil;
  end;
  if Assigned(f) then Result:=f();
 except
  on E:Exception do BugReport(E,nil,'GetSystemDefaultUILanguage');
 end;
end;
{$ELSE ~WINDOWS}
function GetSystemDefaultUILanguage:LANGID;
var lng,def:String;
begin
 GetLanguageIDs(lng,def);
 Result:=DefaultSystemCodePage;
end;
{$ENDIF ~WINDOWS}

 // https://docs.microsoft.com/en-us/windows/desktop/api/winnls/nf-winnls-getuserdefaultuilanguage
 // Returns the language identifier for the user UI language for the current user.
function GetUserDefaultUILanguage:LANGID;
type TGetLangIdFunc=function():LANGID stdcall;
var h:THandle; const f:TGetLangIdFunc = nil;
begin
 Result:=0;
 try
  if not Assigned(f) then begin
   h:=GetModuleHandle('kernel32.dll');
   if h<>0 then f:=GetProcAddress(h,'GetUserDefaultUILanguage') else f:=nil;
  end;
  if Assigned(f) then Result:=f();
 except
  on E:Exception do BugReport(E,nil,'GetUserDefaultUILanguage');
 end;
end;

 // https://docs.microsoft.com/en-us/windows/desktop/api/winnls/nf-winnls-getthreaduilanguage
 // Returns the identifier for a language explicitly associated with the thread or a user or system user interface language.
function GetThreadUILanguage:LANGID;
type TGetLangIdFunc=function():LANGID stdcall;
var h:THandle; const f:TGetLangIdFunc = nil;
begin
 Result:=0;
 try
  if not Assigned(f) then begin
   h:=GetModuleHandle('kernel32.dll');
   if h<>0 then f:=GetProcAddress(h,'GetThreadUILanguage') else f:=nil;
  end;
  if Assigned(f) then Result:=f();
 except
  on E:Exception do BugReport(E,nil,'GetThreadUILanguage');
 end;
end;

 // https://docs.microsoft.com/en-us/windows/desktop/api/winnls/nf-winnls-getsystemdefaultlcid
 // Returns the locale identifier for the system default locale, identified by LOCALE_SYSTEM_DEFAULT.
function GetSystemDefaultLCID:LCID;
type TGetLcIdFunc=function():LCID stdcall;
var h:THandle; const f:TGetLcIdFunc = nil;
begin
 Result:=0;
 try
  if not Assigned(f) then begin
   h:=GetModuleHandle('kernel32.dll');
   if h<>0 then f:=GetProcAddress(h,'GetSystemDefaultLCID') else f:=nil;
  end;
  if Assigned(f) then Result:=f();
 except
  on E:Exception do BugReport(E,nil,'GetSystemDefaultLCID');
 end;
end;

 // https://docs.microsoft.com/en-us/windows/desktop/api/winnls/nf-winnls-getuserdefaultlcid
 // Returns the locale identifier for the user default locale, represented as LOCALE_USER_DEFAULT.
function GetUserDefaultLCID:LCID;
type TGetLcIdFunc=function():LCID stdcall;
var h:THandle; const f:TGetLcIdFunc = nil;
begin
 Result:=0;
 try
  if not Assigned(f) then begin
   h:=GetModuleHandle('kernel32.dll');
   if h<>0 then f:=GetProcAddress(h,'GetUserDefaultLCID') else f:=nil;
  end;
  if Assigned(f) then Result:=f();
 except
  on E:Exception do BugReport(E,nil,'GetUserDefaultLCID');
 end;
end;

 // https://docs.microsoft.com/en-us/windows/desktop/api/winnls/nf-winnls-getthreadlocale
 // Returns the locale identifier of the locale associated with the current thread.
function GetThreadLocale:LCID;
type TGetLcIdFunc=function():LCID stdcall;
var h:THandle; const f:TGetLcIdFunc = nil;
begin
 Result:=0;
 try
  if not Assigned(f) then begin
   h:=GetModuleHandle('kernel32.dll');
   if h<>0 then f:=GetProcAddress(h,'GetThreadLocale') else f:=nil;
  end;
  if Assigned(f) then Result:=f();
 except
  on E:Exception do BugReport(E,nil,'GetThreadLocale');
 end;
end;

 // https://docs.microsoft.com/en-us/windows/win32/api/winnls/nf-winnls-getsystemdefaultlocalename
 // Retrieves the system default locale name.
function GetSystemDefaultLocaleName(lpLocaleName:PWideChar; cchLocaleName:Integer):Integer stdcall;
type TFunc=function (lpLocaleName:PWideChar; cchLocaleName:Integer):Integer stdcall;
var h:THandle; const f:TFunc = nil;
begin
 Result:=0;
 try
  if not Assigned(f) then begin
   h:=GetModuleHandle('kernel32.dll');
   if h<>0 then f:=GetProcAddress(h,'GetSystemDefaultLocaleName') else f:=nil;
  end;
  if Assigned(f) then Result:=f(lpLocaleName,cchLocaleName);
 except
  on E:Exception do BugReport(E,nil,'GetSystemDefaultLocaleName');
 end;
end;

function GetSystemDefaultLocaleNameStr:String;
const LOCALE_NAME_MAX_LENGTH=85;
var Buff:array[0..LOCALE_NAME_MAX_LENGTH-1] of WideChar;
begin
 if GetSystemDefaultLocaleName(Buff,SizeOf(Buff) div SizeOf(Buff[0]))>0
 then Result:=Buff else Result:='';
end;
{$ENDIF ~SKIP_DRAFT}

function GetDefLanguage:Integer;
begin
 Result:=lng_English;
 if IsWindows and ((GetACP=1251) or (GetOEMCP=866)) then Result:=lng_Russian;
 if IsUnix and SameText(Copy(GetEnv('LANG'),1,2),'ru') then Result:=lng_Russian;
end;

function GetOptLanguage(def:Integer; LangOpts:LongString=''):Integer;
var slng,opt:LongString; i:Integer;
begin
 Result:=def; slng:='';
 LangOpts:=Trim(LangOpts);
 if (LangOpts='') then LangOpts:=Trim(ListLanguageOptionNames);
 if (LangOpts='') then Exit;
 CmdArgs.ListOptVal:=CmdArgs.ListOptVal+';'+LangOpts;
 for i:=1 to WordCount(LangOpts,ScanSpaces) do begin
  opt:=ExtractWord(i,LangOpts,ScanSpaces);
  slng:=CmdArgs.GetOptionValue(opt);
  if (slng<>'') then Break;
 end;
 if (slng='') then Exit;
 if (WordIndex(slng,'ru,rus,russian',ScanSpaces)>0) then Result:=lng_Russian;
 if (WordIndex(slng,'en,eng,english',ScanSpaces)>0) then Result:=lng_English;
end;

 {
 *******************************************************************************
 RIFF file utilities
 *******************************************************************************
 }
type
 TItemSearchRec = packed record
  Index : LongInt;
  Count : LongInt;
  Found : TRiffChunk;
 end;

procedure SearchItem(Filer:TRiffFiler; const Chunk:TRiffChunk; var Terminate:Boolean; Custom:Pointer);
begin
 with TItemSearchRec(Custom^) do
 case Chunk.dwSign of
  sig_ITEM: if Index=Count then begin
             Terminate:=true;
             Found:=Chunk;
            end else begin
             inc(Count);
            end;
 end;
end;

type
 TItemListRec = packed record
  Name : ShortString;
  Time : Double;
  Vers : LongInt;
 end;

procedure ListItem(Filer:TRiffFiler; const Chunk:TRiffChunk; var Terminate:Boolean; Custom:Pointer);
begin
 with TItemListRec(Custom^) do
 case Chunk.dwSign of
  sig_name : Name:=Filer.ReadString(Chunk.dwSize);
  sig_time : Time:=Filer.ReadDouble;
  sig_vers : Vers:=Filer.ReadLongInt;
 end;
end;

procedure ListItems(Filer:TRiffFiler; const Chunk:TRiffChunk; var Terminate:Boolean; Custom:Pointer);
var Rec:TItemListRec; i:LongInt;
begin
 case Chunk.dwSign of
  sig_ITEM : begin
              Rec.Name:='';
              Rec.Time:=_Nan;
              Rec.Vers:=sig_0001;
              Filer.ForEach(ListItem,Chunk,@Rec);
              if Rec.Name='' then Rec.Name:='?';
              if isNan(Rec.Time) then begin
               Rec.Name:=Pad('',19,'?')+'  '+Rec.Name;
              end else begin
               Rec.Name:=StdDateTimeStr(Rec.Time)+'  '+Rec.Name;
              end;
              if Str2Long(dwSign2Str(Rec.Vers),i)
              then Rec.Name:=dwSign2Str(Rec.Vers)+'  '+Rec.Name
              else Rec.Name:='????'+'  '+Rec.Name;
              Rec.Name:=' '+dwSign2Str(Chunk.dwFormID)+'  '+Rec.Name;
              TText(Custom).Insln(0,Rec.Name);
             end;
 end;
end;

function SelectRiffItemDialog(const FileName:LongString):TRiffChunk;
var
 Filer : TRiffFiler;
 List  : TText;
 Menu  : LongInt;
 Rec   : TItemSearchRec;
begin
 Result:=RiffChunk(0,0,0,0);
 try
  List:=NewText;
  Filer:=NewRiffFiler(FileName,fmOpenRead,sig_CRWF);
  try
   try
    if not Filer.Ok
    then Raise EFOpenError.Create(RusEng('Не могу открыть файл.','Could not open file.'));
    Filer.ForEach(ListItems,Filer.RootForm,List);
    if NoProblem(List.Count>0,RusEng('Нет списка объектов в файле ','No object list in file ')+FileName)
    then Menu:=ListBoxMenu(RusEng('Выбрать объект для ввода из ','Select object to input from ')+FileName,
                           RusEng(' '+'Тип '+'  '+'Верс'+'  '+'Время сохранения   '+'  '+'Имя',
                                  ' '+'Type'+'  '+'Vers'+'  '+'Time when saved    '+'  '+'Name'),
                           List.Text)
    else Menu:=-1;
    if Menu>=0 then  begin
     Rec.Index:=List.Count-1-Menu;
     Rec.Count:=0;
     Rec.Found:=RiffChunk(0,0,0,0);
     Filer.ForEach(SearchItem,Filer.RootForm,@Rec);
     Result:=Rec.Found;
    end
   except
    Filer.Modified:=false;
    Raise;
   end;
  finally
   Kill(Filer);
   Kill(List);
  end;
 except
  on E:Exception do begin
   BugReport(E,nil,'SelectRiffItemDialog');
   Error(E.Message+EOL+RusEng('Файл ','File ')+FileName);
  end;
 end;
end;

 {
 *******************************************************************************
 Initialize standard subsystems
 *******************************************************************************
 }
procedure Init_CpuFrequencyMHz;
begin
 UpdateStatusLine(RusEng('Определяю частоту процессора...','Eastimate CPU frequency...'));
 CpuFrequencyMHz:=EastimateCpuFrequencyMHz(1000);
end;

procedure Init_Sound_SubSystem;
var b:Boolean; s:ShortString; d:LongInt;
begin
 b:=false; s:=''; d:=0;
 UpdateStatusLine(RusEng('Инициализирую звук...','Initialize sound...'));
 DebugOut(stdfDebug,'');
 DebugOut(stdfDebug,'Init sound system.');
 DebugOut(stdfDebug,'******************');
 if ReadIniFileVariable(SysIniFile,'[System]','UseBlaster%b',b) and b then
 if ReadIniFilePath(SysIniFile,'[System]','SoundLibrary',HomeDir,s) then begin
  DebugOut(stdfDebug,'SoundLibrary = '+s);
  if InitBlaster(BlasterDefaultFifoSize,s,0) then begin
   DebugOut(stdfDebug,'Ok.');
   if ReadIniFileVariable(SysIniFile,'[System]','BlasterCheckDelay%d',d) then BlasterMemoPollPeriod:=d*1000;
   if ReadIniFileVariable(SysIniFile,'[System]','MaxBlasterDataSize%d',d) then BlasterMaxDataSize:=d*1024;
   if ReadIniFileVariable(SysIniFile,'[System]','UseSystemVoice%b',b) then EnableSystemVoice:=b;
   if ReadIniFileVariable(SysIniFile,'[System]','SayTimeInterval%d',d) then SayTimeInterval:=d;
   if ReadIniFileVariable(SysIniFile,'[SysVoice]','Greeting%s',s) then SysVoice(s);
   Echo(RusEng('Звуковая подсистема : Включена.','Sound subsystem '+ASCII_TAB+': Ok.'));
  end else begin
   DebugOut(stdfDebug,'Fails.');
   Echo(RusEng('Звуковая подсистема : Сбой.','Sound subsystem : Fails.'));
  end;
 end;
end;

procedure Done_Sound_SubSystem;
var s:ShortString;
begin
 s:='';
 UpdateStatusLine(RusEng('Завершаю звук...','Finalize sound...'));
 if ReadIniFileVariable(SysIniFile,'[SysVoice]','Farewell%s',s) then begin
  SysVoice(s);
  Sleep(2000);
 end;
 DoneBlaster;
end;

procedure Init_Calculator_SubSystem;
var s:ShortString;
begin
 s:='';
 UpdateStatusLine(RusEng('Инициализирую калькулятор...','Initialize calculator...'));
 if ReadIniFilePath(SysIniFile,'[System]','CalculatorConfig',HomeDir,s)
 then LoadCalculatorParams(s);
end;

procedure Done_Calculator_SubSystem;
var s:ShortString;
begin
 s:='';
 UpdateStatusLine(RusEng('Завершаю калькулятор...','Finalize calculator...'));
 if ReadIniFilePath(SysIniFile,'[System]','CalculatorConfig',HomeDir,s)
 then SaveCalculatorParams(s);
end;

procedure Init_Thermocouple_SubSystem;
var p:TText; i:Integer;
begin
 UpdateStatusLine(RusEng('Инициализирую термопары...','Initialize thermocouples...'));
 DebugOut(stdfDebug,'');
 DebugOut(stdfDebug,'Init thermocouples.');
 DebugOut(stdfDebug,'*******************');
 if ThermoCoupleCount=0 then InitCouples(SysIniFile,'[DataBase]','ThermoCouples',stdfDebug);
 if ThermoCoupleCount>0 then begin
  DebugOut(stdfDebug,'Ok.');
  Echo(RusEng('Таблицы термопар : Прочитаны.','Thermocouple tables : Ok.'));
  CalibTransformList.InitThermocouples;
 end else begin
  DebugOut(stdfDebug,'Fails.');
  Echo(RusEng('Таблица термопар : Сбой.','Thermocouple table : Fails.'));
 end;
 UpdateStatusLine(RusEng('Инициализирую калибровки...','Initialize relationships...'));
 DebugOut(stdfDebug,'');
 DebugOut(stdfDebug,'Init relationships.');
 DebugOut(stdfDebug,'*******************');
 if RelationshipCount=0 then InitRelationShips(SysIniFile,'[DataBase]','Relationships',stdfDebug);
 if RelationshipCount>0 then begin
  DebugOut(stdfDebug,'Ok.');
  Echo(RusEng('Таблицы калибровок : Прочитаны.','Calibration tables : Ok.'));
  CalibTransformList.InitRelations;
 end else begin
  DebugOut(stdfDebug,'Fails.');
  Echo(RusEng('Таблицы калибровок : Сбой.','Calibration tables : Fails.'));
 end;
 p:=NewText;
 p.Text:=CalibTransformList.Text;
 DebugOut(stdfDebug,RusEng(EOL+'Список доступных типов калибровок:'+EOL+
                               '**********************************',
                           EOL+'List of available calibration tables:'+EOL+
                               '*************************************'));

 for i:=0 to p.Count-1 do DebugOut(stdfDebug,p[i]);
 Kill(p);
 FreeConfigCache(0);
end;

procedure Done_Thermocouple_SubSystem;
begin
 UpdateStatusLine(RusEng('Завершаю термопары...','Finalize thermocouples...'));
end;

procedure Init_IOPM_SubSystem;
var i:LongInt; p:TText;
begin
 UpdateStatusLine(RusEng('Инициализирую драйвер IOPM...','Initialize IOPM driver...'));
 DebugOut(stdfDebug,'');
 DebugOut(stdfDebug,'Init IOPM driver.');
 DebugOut(stdfDebug,'*****************');
 if IOPM_Open(SysIniFile,'[System]','IOPM_DRIVER') then begin
  try
   for i:=0 to 5 do Sound(1000*(10-i),50);
  except
   on EPrivilege do begin
    DebugOut(stdfDebug,'IOPM driver invalid.');
    Echo(RusEng('Драйвер IOPM : Сбой.','Driver IOPM : Fails.'));
   end;
   on E:Exception do BugReport(E,nil,'Init_IOPM_SubSystem');
  end;
  DebugOut(stdfDebug,'Ok.');
  Echo(RusEng('Драйвер IOPM : Включен.','Driver IOPM : Ok.'));
 end else begin
  DebugOut(stdfDebug,'Fails.');
  Echo(RusEng('Драйвер IOPM : Сбой. Вероятно, нужны права администратора.',
              'Driver IOPM : Fails. Probably, administrator rights needed.'));
 end;
 p:=NewText;
 p.Text:=IOPM_History;
 for i:=0 to p.Count-1 do DebugOut(stdfDebug,p[i]);
 Kill(p);
end;

procedure Done_IOPM_SubSystem;
begin
 UpdateStatusLine(RusEng('Завершаю драйвер IOPM...','Finalize IOPM driver...'));
 IOPM_Close;
end;

procedure Timer_CheckConfigCache;
begin
 CheckConfigCache;
end;

procedure Timer_SayTime;
const Last:word=$FFFF;
var t:TSystemTime;
begin
 if UsesBlaster and (SayTimeInterval>0) then begin
  t:=MSecToNativeTime(msecnow);
  if t.Minute<>Last then begin
   if (SayTimeInterval=1) or (t.Minute mod SayTimeInterval=0) then SayTimeHhMm(t);
   Last:=t.Minute;
  end;
 end;
end;

procedure SayTimeHhMm(const t:TSystemTime; const Prefix:LongString);
var s:LongString;
begin
 s:=SayNumber(t.Minute);
 if t.Minute<10 then s:='0 '+s;
 s:=SayNumber(t.Hour)+' '+s;
 if t.Hour<10 then s:='0 '+s;
 Voice(Prefix+' '+s);
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_apptools;
begin
 {$IFDEF UNIX}
 UseSystemMessageBox:=false;
 {$ENDIF ~UNIX}
end;

procedure Free_crw_apptools;
begin
 FreeMenuShortcuts;
end;

initialization

 Init_crw_apptools;

finalization

 Free_crw_apptools;

end.

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

