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

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

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// File Input/Output routines.                                                //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20010712 - creation & tests                                                //
// 20011031 - config & ini files support                                      //
// 20020302 - fixed Std_IO_Initialization/Std_IO_Finalization                 //
// 20030217 - ReadRegistryString,GetWindowsShellxxx,CreateFileLink            //
// 20030325 - Struggle for safety (add some try/except checks)...             //
// 20030328 - Replace TObjectList to TObjectStorage.                          //
// 20040807 - ArgChar, GetEnv, SetEnv                                         //
// 20050811 - DebugOutFileLimit                                               //
// 20050819 - SmartFileRef, SmartFileRel, UserHomeDir                         //
// 20060306 - HostName,UserDomain,GetIpAddress,GetMacAddresses                //
// 20070522 - ReadIniFile(..,efMode,svConfig)                                 //
// 20070716 - efConfigNC                                                      //
// 20070717 - GetUserList,GetRootKeyByName,WriteRegistryString;               //
//            edit HostName,ReadRegistryString                                //
// 20070718 - GetHostList                                                     //
// 20070719 - GetDomainList                                                   //
// 20070721 - Small edit GetxxxxList                                          //
// 20090104 - SmartFileSearch, AddSearchPath, RemSearchPath                   //
// 20120313 - Update FreeConfigCache                                          //
// 20160623 - ExpEnv,ExpEnvFilter                                             //
// 20160922 - GetFileSize64                                                   //
// 20170203 - DebugOutText                                                    //
// 20170228 - StdInputFifoLimit,StdOutputFifoLimit,StdInputFifoFactor,        //
//            StdOutputFifoFactor                                             //
// 20171006 - ExtractTextSectionByPrefix                                      //
// 20171101 - DebugOutSetFifo, stdfReadIniLog                                 //
// 20171207 - GetFileVersionInfoAsText                                        //
// 20171219 - ConfigFileCacheHoldTime,CongfigFileCache etc.                   //
// 20190521 - GetEnvVar,PathAddDir,PathAddDirEnv,PathAddDirEnvFromIni         //
// 20191028 - GetLongPathName,GetShortPathName,GetRealFilePathName,           //
//            ValidatePathList                                                //
// 20200528 - ReadRegistryMultiStrings                                        //
// 20211014 - Add sfrDefXXXX constants, handleUrl param to ReadIniFilePath    //
// 20230523 - Modified for FPC (A.K.)                                         //
// 20240305 - ValidateEnvPathList                                             //
// 20240623 - ProgBaseName                                                    //
// 20241025 - ReadShellLinkAsText                                             //
// 20241026 - FindAllFilesAsText                                              //
// 20241029 - GetIfMacAddresses, GetIfIpAddresses                             //
// 20241105 - MaybeTildeStr                                                   //
// 20250208 - Optimize DebugOutText by using ForEachStringLine                //
// 20250210 - GetListOfShells                                                 //
// 20250524 - FileCopy,FileRename - IsSameFileName (fix source=target case)   //
// 20250816 - GetFilePermissionsAsString,GetFileOwnerAsString                 //
// 20250817 - GetFilePropertiesAsText                                         //
// 20251118 - O_CLOEXEC                                                       //
// 20251213 - ExtractEnumWordTextEx,ExtractEnumWordListEx                     //
// 20251218 - DebugOutBuff                                                    //
// 20251219 - DebugOutTick,DebugOutCheckAwakePeriod                           //
// 20251224 - ExtractListOfSections                                           //
// 20251228 - dlc_CfgCache                                                    //
// 20260307 - NumBytesStoredInTextBuf                                         //
////////////////////////////////////////////////////////////////////////////////

unit _crw_fio; // File input / output routines.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$IOCHECKS OFF}

{$WARN 4104 off : Implicit string type conversion from "$1" to "$2"}
{$WARN 4105 off : Implicit string type conversion with potential data loss from "$1" to "$2"}
{$WARN 5023 off : Unit "$1" not used in $2}
{$WARN 5028 off : Local $1 "$2" is not used}
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 {$IFDEF UNIX} baseunix, unix, users, netdb, {$ENDIF}
 sysutils, classes, math, strutils, lclproc,
 fileutil, fileinfo, process, sockets, lazfileutils,
 {$IFDEF WINDOWS} registry, comobj, shlobj, activex, winsock, {$ENDIF}
 _crw_alloc, _crw_fifo, _crw_rtc, _crw_str, _crw_dynar, _crw_ef, _crw_lm,
 _crw_base64, _crw_hash, _crw_hl, _crw_environ, _crw_proc, _crw_netif,
 _crw_runerr, _crw_spcfld;

 {
 ***********************
 Special file assignment
 ***********************
 }

 {
 Assign text file variable to NULL device (nothing read/write).
 }
procedure AssignNull(out T:Text);

 {
 Assigne file input and output to/from fifo.
 }
procedure AssignFifo(out T:Text; Fifo:TFifo=nil);

 {
 Standard Input / Output files should be redirected to FIFO in GUI mode.
 Note that Input/Output/ErrOutput in FPC are threadvar, so every thread
 should be redirected (if need) to FIFO.
 }
function StdInputFifo:TFifo;
function StdOutputFifo:TFifo;
function StdErrOutputFifo:TFifo;

const
 StdInputFifoSize    = 1024*64;
 StdOutputFifoSize   = 1024*128;
 StdInputFifoLimit   = 1024*1024*64;
 StdOutputFifoLimit  = 1024*1024*128;
 StdInputFifoFactor  = 2;
 StdOutputFifoFactor = 2;

const                    // Limit for buffer size of SetTextBuf procedure.
 MaxTextBufSize = 65355; // Maximum 65355 bytes according to FPC RTL help.

const // Buffer size uses for StdIO
 StdIoBuffSize : Integer = MaxTextBufSize;

const                                           // Redirection:
 StdInpMarker='0'; StdInpMarkers=['0','I','i']; // Marker of Input
 StdOutMarker='1'; StdOutMarkers=['1','O','o']; // Marker of Output
 StdErrMarker='2'; StdErrMarkers=['2','E','e']; // Marker of ErrOutput

 // Redirect Standard Input,Output,ErrOutput text files to FIFO and back.
 // Set What string like '012' to redirect Input,Output,ErrOutput.
 // For example: RedirectStdIo('012',true);
procedure RedirectStdIo(What:LongString; ToFifo:Boolean);

 // Redirected standard text files like '012'.
function  RedirectedStdIo:LongString;

 // Default Echo procedure: write to StdOutputFifo.
procedure StandardEchoProcedure(const Msg:LongString);

 {
 **********************
 Common file operations
 **********************
 }

{$IFDEF UNIX}
 {
 Simulate some WinApi stuff on Unix.
 }
const // Marker for file errors.
 INVALID_HANDLE_VALUE = THandle(-1);
const // Standard console streams.
 STD_INPUT_HANDLE  = System.StdInputHandle;
 STD_OUTPUT_HANDLE = System.StdOutputHandle;
 STD_ERROR_HANDLE  = System.StdErrorHandle;
const // GetFileType results
 FILE_TYPE_UNKNOWN = 0;     // Unknown or error  (all platforms )
 FILE_TYPE_DISK    = 1;     // Regular file      (all platforms )
 FILE_TYPE_CHAR    = 2;     // Character special (all platforms )
 FILE_TYPE_PIPE    = 3;     // Named pipe (fifo) (all platforms )
 ////////////////////////////////////////////////////////////////
 FILE_TYPE_NONE    = 0;     // Unknown or error  (synonym       )
 FILE_TYPE_REG     = 1;     // Regular file      (synonym       )
 FILE_TYPE_CHR     = 2;     // Character special (synonym       )
 FILE_TYPE_FIFO    = 3;     // Named pipe (fifo) (synonym       )
 ////////////////////////////////////////////////////////////////
 FILE_TYPE_DIR     = 4;     // Directory         (unix extension)
 FILE_TYPE_BLK     = 5;     // Block special     (unix extension)
 FILE_TYPE_LNK     = 6;     // Symbolic link     (unix extension)
 FILE_TYPE_SOCK    = 7;     // Socket            (unix extension)
 FILE_TYPE_REMOTE  = $8000; // Remote file       (winapi, unused)
 { Get standard file handle. }
function GetStdHandle(hFile:THandle):THandle;
{$ENDIF  UNIX}

 { Get type of file handle. }
function GetFileType(hFile:THandle):LongWord; overload;
function GetFileType(var F:Text):LongWord; overload;
function GetFileType(var F:File):LongWord; overload;

{$IFDEF WINDOWS}
const
 FILE_TYPE_NONE    = 0;     // Unknown or error  (synonym       )
{$ENDIF ~WINDOWS}

 { File type of StdIn. }
function StdInFileType:LongWord;
 { File type of StdOut. }
function StdOutFileType:LongWord;
 { File type of StdErr. }
function StdErrFileType:LongWord;
 { Convert result of GetFileType to string. }
function FileTypeToString(fType:LongWord; Prefix:LongString='FILE_TYPE_'):LongString;

 { Convert IOResult code to string message. }
function IoResultToString(Code:Integer):LongString;

 {
 Direct printing to standard console streams.
 }
function StdPrint(const Msg:LongString; n:Integer=1):LongInt;
function StdOutPrint(const Msg:LongString):LongInt;
function StdErrPrint(const Msg:LongString):LongInt;
function StdPrintLn(const Msg:LongString; n:Integer=1):LongInt;
function StdOutPrintLn(const Msg:LongString):LongInt;
function StdErrPrintLn(const Msg:LongString):LongInt;

 {
 The O_CLOEXEC is only for Linux since 2.6.23.
 Enable the FpOpen(…) close-on-exec flag for the new file descriptor.
 }
const
 O_CLOEXEC = _crw_rtc.O_CLOEXEC;

 {
 File has non-block flag (O_NONBLOCK)?
 Unix Only.
 }
function FileHasNonBlockFlag(fd:THandle):Boolean;
 {
 Set or clear non-block flag (O_NONBLOCK) of file.
 Unix Only.
 }
function FileSetNonBlockFlag(fd:THandle; State:Boolean=true):Boolean;

 {
 Set or clear close-on-exec flag (FD_CLOEXEC) of file descritor.
 Unix Only.
 }
function FileSetCloseOnExec(fd:THandle; State:Boolean=true):Boolean;

 {
 Check last ErrorCode to detect pending file operations,
 i.e. incomplete (waiting) operations on non-block file.
 Pending operations uses for non-blocking IO processing.
 On Windows it`s ERROR_IO_INCOMPLETE.
 On Unix it`s EAGAIN or EWOULDBLOCK.
 }
function ePendingFileOperation(ErrorCode:Integer):Boolean; inline;

 {
 ErrorCode is BROKEN_PIPE?
 }
function eBrokenPipe(ErrorCode:Integer):Boolean; inline;

 {
 ErrorCode is OPERATION_ABORTED?
 }
function eOperationAborted(ErrorCode:Integer):Boolean; inline;

 {
 isFileClosed  checks file: is file closed or not.
 File must be assigned before.
 }
function  isFileClosed(var f:File):Boolean; overload;
function  isFileClosed(var f:Text):Boolean; overload;

 {
 Number of bytes stored in text file buffer.
 }
function NumBytesStoredInTextBuf(var T:Text):SizeInt;

 {
 SmartFileClose close file, if it was opened.
 File must be assigned before.
 }
procedure SmartFileClose(var f:File); overload;
procedure SmartFileClose(var f:Text); overload;

 {
 Get text file name and buffer size from TTextRec(T).
 }
function GetTextFileName(var T:Text):LongString;
function GetTextFileBufSize(var T:Text):SizeInt;
function GetTextFileFifo(var T:Text):TFifo;

 { Check file is executable. }
function FileIsExecutable(const aFileName:LongString):Boolean;
 { Check file is symbolic link. }
function FileIsSymlink(const aFileName:LongString):Boolean;
 { Check file is hard link. }
function FileIsHardLink(const aFileName:LongString):Boolean;
 { Check file is readable. }
function FileIsReadable(const aFileName:LongString):Boolean;
 { Check file is writable. }
function FileIsWritable(const aFileName:LongString):Boolean;

 {
 Get file permissions as string.
 On Unix return file permissions like:
  -rwxrwxrwx
  |\_/\_/\_/
  |  \  \  \_others (rwx-), - means no access
  |   \  \___group  (rwx-), - means no access
  |    \_____user   (rwx-), - means no access
  |__________file/device type (ldbc-)
 where
  file/device type:
   l  symbolic link
   d  directory
   b  block device
   c  character device
   -  regular file
  user/group/other permissions:
   r  read access permission
   w  write access permission
   x  executable permission
   -  no access permission
 On Windows return empty string.
 }
function GetFilePermissionsAsString(const aFileName:LongString):LongString;

 {
 On Unix return file owner as user:group string, like alex:users.
 If AsDigits is set, return uid:guid as digits numbers.
 On Windows return empty string.
 }
function GetFileOwnerAsString(const aFileName:LongString; AsDigits:Boolean=False):LongString;

 {
 Return FileName file properties as key=value EOL separated text.
 Parameter Properties is a CSV list of wanted properties to read.
 All valid keys enumerated in CSV list ListAllFilePropertiesKeys.
 Keys are:
  Exists        - flag (1/0) "file exists"                    (anywhere)
  Permissions   - string of file permissions like -rw-rw-r--  (for Unix)
  Owners        - user:group uid:guid                         (for Unix)
  IsExecutable  - flag (1/0) "file is executable"             (for Unix)
  IsSymLink     - flag (1/0) "file is symlink"                (for Unix)
  IsHardLink    - flag (1/0) "file is hardlink"               (for Unix)
  IsReadable    - flag (1/0) "file is readable"               (anywhere)
  IsWritable    - flag (1/0) "file is writeble"               (anywhere)
  Size          - file size in bytes                          (anywhere)
  Attr          - file attributes as integer (bit flags)      (OSdepend)
  Time          - time of last modification, ms since Xmas    (anywhere)
  FileExt       - file extension (.ext)                       (anywhere)
  DirName       - file directory                              (anywhere)
  BaseName      - file base name (no dir,ext)                 (anywhere)
  FileName      - file expanded full file name                (anywhere)
  RealPath      - file real path, charcase, symlinks resolved (anywhere)
 }
function ListAllFilePropertiesKeys:LongString;
function GetFilePropertiesAsText(const FileName:LongString;
                                 const Properties:LongString=''):LongString;

 {
 Return attributes of file specified by FileName.
 Return -1 if empty file name, wild card (*,?) or file not exists.
 }
function  GetFileAttr(const FileName:LongString):LongInt;

 {
 Set attributes of file specified by FileName.
 Return false if empty file name, wild card (*,?) or file not exists.
 }
function  SetFileAttr(const FileName: LongString; Attr: LongInt):Boolean;

 {
 Return size of file or -1 if file not exists or error occured.
 }
function  GetFileSize(const FileName:LongString):Int64;

 {
 Return size of big file or -1 if file not exists or error occured.
 }
function GetFileSize64(hFile:THandle):Int64; overload;
function GetFileSize64(const FileName:LongString):Int64; overload;

 {
 Return date & time of file or -1 if file not exists or error occured.
 Return value in global milliseconds since Xmas, if ConvertToMSec=true,
 or in FileTime units (see MsToFileTime/FileTimeToMs).
 }
function GetFileDate(const FileName:LongString; ConvertToMsec:Boolean=false):Int64;

 {
 Return true if specified file(s) exists.
 FilePattern may contains "*","?" masks.
 }
function  FileExists(const FilePattern:LongString; Attribut:Integer=faAnyFile):Boolean;

 {
 Return true if specified directory exists. No "*","?" available.
 }
function  DirExists(const DirName: LongString): Boolean;

 {
 Erase (delete) file specified file.
 Return true if file not exists or successfully erased from disk.
 }
function  FileErase(const FileName:LongString; CheckExistance:Boolean=true):Boolean;

 {
 Copy file CopyFrom to file CopyTo.
 Return true if success. Return false if i/o error, CopyFrom not exists,
 or FailIfExists=true and CopyTo exists.
 }
function  FileCopy(const CopyFrom,CopyTo:LongString; FailIfExists:Boolean=false):Boolean;

 {
 Move file OldFileName to NewFileName.
 Return true if success. Return false if i/o error, OldFileName not exists,
 or FailIfExists=true and NewFileName exists.
 }
function  FileRename(const OldFileName,NewFileName:LongString; FailIfExists:Boolean=false):Boolean;

 {
 Return current directory without trailing backslash.
 }
function  GetCurrDir: LongString;

 {
 Set current directory. No "*","?" available.
 }
function  SetCurrDir(const DirName: LongString): Boolean;

 {
 Make new directory named DirName.
 If parent directories does not exists, make this directories too.
 Return true if DirName successfully created.
 }
function  MkDir(const DirName: LongString): Boolean;

 {
 Make new directory ExtractFileDir(FileName).
 }
function MkDirByFileName(const FileName:LongString):Boolean;

 {
 Remove directory named DirName. Directory must be empty.
 Return false if DirName invalid or not empty.
 }
function  RmDir(const DirName: LongString): Boolean;

 {
 Open file specified by FileName, seek to Offset and read Count bytes
 to Buffer. Return number of bytes was read from. Return -1 if error occured.
 }
function  ReadFileToBuffer(const FileName : LongString;
                                 Buffer   : Pointer;
                                 Count    : SizeInt;
                                 Offset   : SizeInt = 0
                                        ) : SizeInt; overload;
function  ReadFileToBuffer(const FileName : LongString;
                                 Count    : SizeInt;
                                 Offset   : SizeInt = 0
                                        ) : LongString; overload;

function StringFromFile(const FileName:LongString; MaxSize:SizeInt):LongString;

 {
 Open or create file specified by FileName, seek to Offset and write Count bytes
 to Buffer. Return number of bytes was write to. Return -1 if error occured.
 FLAGS may be
  OPEN_EXISTING open file, fails if not exists
  OPEN_ALWAYS   open file, create new if not exists
  CREATE_NEW    create new file, fails if file yet exists
  CREATE_ALWAYS create new file, exists file or not
 }

{$IFNDEF WINDOWS}
const
 CREATE_NEW        = 1;
 CREATE_ALWAYS     = 2;
 OPEN_EXISTING     = 3;
 OPEN_ALWAYS       = 4;
 TRUNCATE_EXISTING = 5;
{$ENDIF WINDOWS}

function  WriteBufferToFile(const FileName     : LongString;
                                  Buffer       : Pointer;
                                  Count        : SizeInt;
                                  Offset       : SizeInt = 0;
                                  FLAGS        : DWORD = OPEN_ALWAYS
                                             ) : SizeInt; overload;
function  WriteBufferToFile(const FileName     : LongString;
                                  Buffer       : LongString;
                                  Offset       : SizeInt = 0;
                                  FLAGS        : DWORD = OPEN_ALWAYS
                                             ) : SizeInt; overload;

 {
 Mask for any file: *.* for Windows, * for Unix.
 }
function AnyFileMask:LongString;

 {
 Find all files in SearchPath directories by names in SearchMask.
 }
function FindAllFilesAsText(const SearchPath:LongString;
                            const SearchMask:LongString='';
                                  SearchSubDirs:Boolean=True;
                                  DirAttr:Word=faDirectory;
                                  MaskSeparator:Char=';';
                                  PathSeparator:Char=';'
                            ):LongString;

 {
 ForEachFile is powerfull file iterator.
 For each file, specified by FilePatterns, starting from RootDir,
 calls FileAction procedure, then calls himself recursively for each subdirectory,
 if recursion level less then MaxSubDirLevels. CustomData points to user-defined
 data. FilePatterns contains list of file patterns to search for, for example,
 "*.bmp, config.*, *.wav". Delimiters define chars, wich separete each pattern
 in FilePatterns list. If user wants break iterations, he have to set Terminate.
 Example:
  program FileList;
  uses _fio;
  const Count : integer = 0;
   procedure PrintFile(const FileName:LongString; const FileDetails:TSearchRec;
                       SubDirLevel:Integer; var Terminate:Boolean; CustomData:Pointer);
   begin
    with FileDetails do
    writeln(Text(CustomData^),FileName:40, Time:10, Size:10, Attr:10, SubDirLevel:2);
    inc(Count);
    if Count>1000 then Terminate:=true;
   end;
  begin
   ForEachFile('c:\windows','*.bmp, *.wav',PrintFile,10,@Output);
  end;
 }
type
 TForEachFileAction = procedure(const FileName    : LongString;
                                const FileDetails : TSearchRec;
                                      SubDirLevel : Integer;
                                  var Terminate   : Boolean;
                                      CustomData  : Pointer);
const
 DefaultFilePatternDelimiters = [' ',';',',',ASCII_TAB,ASCII_CR,ASCII_LF];

procedure ForEachFile(const RootDir         : LongString;
                      const FilePatterns    : LongString;
                            FileAction      : TForEachFileAction;
                            MaxSubDirLevels : Integer = 0;
                            CustomData      : Pointer = nil;
                      const Delimiters      : TCharSet = DefaultFilePatternDelimiters
                     );

 {
 ForEachTextLine is powerfull text file iterator.
 For each line of given text file FileName apply Action which should be done.
 Return 0 if Ok, -1 if file not exists or IOResult otherwise.
 Example:
  program textview;
   procedure PrintLine(const FileName,Line:LongString; Count:LongInt;
                         var Terminate:Boolean; CustomData:Pointer);
   begin
    if Count=0 then writeln(Text(CustomData^),'File ', FileName, ' view:');
    writeln(Text(CustomData^),Line);
   end;
  begin
   ForEachTextLine(ParamStr(1),PrintLine,@Output);
  end.
 }
type
 TForEachTextLineAction = procedure (const FileName   : LongString;
                                     const Line       : LongString;
                                           Count      : SizeInt;
                                       var Terminate  : Boolean;
                                           CustomData : Pointer);

function ForEachTextLine(const FileName   : LongString;
                               Action     : TForEachTextLineAction;
                               CustomData : Pointer = nil;
                               BuffSize   : Integer = 0 ):Integer;

 {
 *****************
 Debug file output
 *****************
 }

 {
 Output a string S to debug file number n. Debug file n must be opened
 by DebugOutOpenFile. If debug file n was not opened, do nothing.
 This call is thread-safety and fast. At first, strings transfer to fifo,
 and then fifo will flush data to disk in another thread. Each debug file have
 own thread to write strings, collected in fifo, on disk. You may send debug
 messages from any threads whithout any time lost.
 In other side, if you send too many data at a time, fifo may overflow. Be care.
 Example:
  program Demo;
  begin
   DebugOutOpenFile(0,'debug.out');
   DebugOut(0,'Send to fifo');
   Sleep(100);
   DebugOutOpenFile(0,'');
  end.
 }
procedure DebugOut(n:Byte; const S:LongString);
procedure DebugOutText(n:Byte; const S:LongString);

 {
 Return current name of debug file n. Return empty string if not opened.
 }
function  DebugOutGetFile(n:Byte):LongString;

 {
 Return 0 if OK, number of lost bytes in debug file n or -1 if not opened.
 }
function  DebugOutGetErrors(n:Byte):Int64;

 {
 Set DebugOut FIFO parameters.
 }
procedure DebugOutSetFifo(n              : Byte;
                          FifoSize       : Integer = 1024*64;
                          FifoGrowFactor : Integer = 2;
                          FifoGrowLimit  : Integer = 1024*1024*4);

 {
 Open debug file number n. For each debug file creates new thread and fifo.
 FlushPeriod is period, in milliseconds, to flush data on disk.
 Call DebugOutOpenFile with empty FileName to close debug file.
 }
procedure DebugOutOpenFile(n           : Byte;
                     const FileName    : LongString;
                           FifoSize    : Integer = 1024*64;
                           FlushPeriod : Integer = 0;
                           CreateNew   : Boolean = true;
                           Hello       : Boolean = false);

const
 stdfDebug                   = 0; { standard debug.log   file }
 stdfError                   = 1; { standard error.log   file }
 stdfReadIniLog              = 2; { standard readini.log file }
 stdfSound                   = 3; { standard sound.log   file }
 DebugOutFileLimit : Integer = 1 shl 20;

const
 DebugOutFifoSize         : Integer  = 1024*64;
 DebugOutFifoGrowFactor   : Integer  = 2;
 DebugOutFifoPollPeriod   : Integer  = 1000;
 DebugOutFifoGrowLimit    : Integer  = 1024*1024*4;
 DebugOutCheckAwakePeriod : Cardinal = 10;

 {
 **************************************
 Функции чтения конфигурационных файлов
 **************************************
 }
 {
 ExtractTextSection Читая файл FileName, выделить секцию [SectionName]
                    с удаленными при необходимости комментариями
                    (комментарием считается подстрока, начинающаяся с
                    символа ; до конца строки)
 ConstructFullConfig Получить полный текст конфигурационного файла
 ExtractWordList    Выделить секцию и вернуть список слов с данным номером
                    в каждой строке.
                    1.Выделяется секция
                    2.Из каждой строки выделяется слово с данным номером
                      и указанным множеством разделителей слов
                    3.Если это слово не ноль, включить его в список
                    ExtractWordList служит, например, для получения
                    идентификаторов в конфигурационном файле
                    Ident1 = ...
                    Ident2 = ...
                    В этом случае выделение первого слова эквивалентно
                    выделению списка идентификаторов.
 ExtractEnumWordList Получить список слов из списков перечисления с данным
                    префиксом поиска, Например:
                    [NameList]
                    Names = Alex, Fedor, Bobby
                    Names = Georg, Vaska
                    При вызове ExtractEnumWordList('[NameList]','Name')
                    получится список [Alex,Fedor,Bobby,Georg,Vaska]
 }
const                            {флаги для ExtractTextSection}
 efNoCase   = 0;                 {не преобразовывать}
 efUpCase   = $0001;             {преобразовать к UpCase}
 efLoCase   = $0002;             {преобразовать к LoCase}
 efCaseMask = efUpCase+efLoCase; {маска для UpCase,LoCase}
 efLTrim    = $0004;             {удаление незначащих пробелов слева}
 efRTrim    = $0008;             {удаление незначащих пробелов справа}
 efTrimMask = efLTrim+efRTrim;
 efDelCom   = $0010;             {удаление комментариев}
 efExpEnv   = $0020;             {use ExpEnv on read IniPath}
 efAdaptFN  = $0040;             {use AdaptFileName for ReadIniPath}
 efAsIs     = 0;                 {'как есть', без купюр и преобразований}
 {стандартный для конфигурационных файлов}
 efConfig   = efUpCase+efLTrim+efRTrim+efDelCom;
 efConfigNC = efConfig and not efCaseMask;
 efConfigFN = {$IFDEF WINDOWS}efConfig{$ELSE}efConfigNC{$ENDIF} or efExpEnv or efAdaptFN;
 esComments = [';'];             {эти символы - признак начала комментариев}
 ConfigCacheLimit        : LongInt  = MegaByte;
 ConfigCacheCheck        : Cardinal = 1000;
 ConfigCacheHoldingTime  : Cardinal = 0;
 ConfigCacheHasherMethod : Integer  = 0;
 ConfigFileMaxRecursionLevel        = 8;
 idConfigFile                       = 'CONFIGFILE';
 idConfigFileList                   = '[CONFIGFILELIST]';
const                            {флаги для ExtractEnumWordListEx}
 ewUnique   = $0001;             {игнорировать дубликаты}
 ewSorted   = $0002;             {сортировать список}
 ewSectOn   = $0004;             {обрабатывать секции}
 ewUniSort  = ewUnique+ewSorted;
 ewUniSect  = ewUnique+ewSectOn;
 ewUniSoSe  = ewUnique+ewSorted+ewSectOn;

function  ConfigCacheSnapshot(mode:Integer=0):LongString;
function  FreeConfigCache(MaxSize:LongInt):LongInt;
function  ConfigCacheSize:LongInt;
procedure ResetConfigCache;
procedure CheckConfigCache;
function  ExtractListSection(const FileName            : LongString;
                             const SectionName         : LongString;
                                   ExtractSectionFlags : Cardinal) : TText;
function  ExtractTextSection(const FileName            : LongString;
                             const SectionName         : LongString;
                                   ExtractSectionFlags : Cardinal) : LongString;
function ConstructFullConfig(const FileName:LongString; CfcMode:Cardinal=0):TText;
function ExtractListOfSections(const FileName:LongString):LongString;
function ExtractWordList(const FileName            : LongString;
                         const SectionName         : LongString;
                               ExtractSectionFlags : Cardinal;
                               WordIndex           : Cardinal;
                         const Delimiters          : TCharSet ) : TText;
function ExtractEnumWordList(const IniFile             : LongString;
                             const SectionName         : LongString;
                             const Prefix              : LongString;
                                   ExtractSectionFlags : Cardinal) : TText;
function ExtractEnumWordTextEx(const IniFile             : LongString;
                               const SectionName         : LongString;
                               const Prefix              : LongString;
                                     ExtractSectionFlags : Cardinal;
                                     UniqSortSectFlags   : Cardinal) : LongString;
function ExtractEnumWordListEx(const IniFile             : LongString;
                               const SectionName         : LongString;
                               const Prefix              : LongString;
                                     ExtractSectionFlags : Cardinal;
                                     UniqSortSectFlags   : Cardinal) : TText;
function ExtractSectionTitle(const Line:LongString; out Title:LongString):Boolean;

 {
 Call data:
  [SectionName]
  Prefix = Line1
  Prefix = Line2
  Prefix = [SubSection]
  ...
  [SubSection]
  Line3
  Line4
 Return text:
  Line1
  Line2
  Line3
  Line4
 }
function ExtractTextSectionByPrefix(const FileName    : LongString;
                                    const SectionName : LongString;
                                    const Prefix      : LongString;
                                          efMode      : Integer = efConfig;
                                          svMode      : Integer = svConfig;
                                          SubSections : Boolean = true) : LongString;

 {
 ************************************************************
 ПРИМЕЧАНИЕ:
 Форматное чтение использует тип PureString, который является
 синонимом Short String или String[255], однако подчеркивает,
 что строка используется в специальных целях.
 ************************************************************
 ReadIniFileVariable  Чтение переменной из Ini-файла
                      Name%b boolean
                      Name%f double
                      Name%d LongInt
                      Name%w word
                      Name%i integer
                      Name%a alpha (1st string word)
                      Name%s string
 Пример Ini-файла:
  ;системные переменные
  [System]
  ResourceFile = crw_run.rsc
  HelpFile = crw_run.hlp
  TempPath =TEMP
  LowMemory = 1024
  Sound = TRUE
  ;описание графики
  [Graphics]
  GraphMode = $103
  PowerManager = TRUE
  ;описание подсистем
  [Speed]
  TurnOn = FALSE
  IniFile = Speed.ini
  DataPath = data
 }
function ReadIniFileVariable(const FileName    : LongString;
                             const SectionName : LongString;
                             const Format      : LongString;
                               var Data;
                                   efMode      : Integer = efConfig;
                                   svMode      : Integer = svConfig
                                             ) : Boolean;

function ReadIniFileRecord(const FileName    : LongString;
                           const SectionName : LongString;
                           const Format      : LongString;
                             var Data;
                                 efMode      : Integer = efConfig;
                                 svMode      : Integer = svConfig
                                           ) : Boolean;

function ReadIniFileBoolean(const FileName    : LongString;
                            const SectionName : LongString;
                            const Key         : LongString;
                              var Data        : Boolean;
                                  efMode      : Integer = efConfig;
                                  svMode      : Integer = svConfig
                                            ) : Boolean;

function ReadIniFileDouble(const FileName    : LongString;
                           const SectionName : LongString;
                           const Key         : LongString;
                             var Data        : Double;
                                 efMode      : Integer = efConfig;
                                 svMode      : Integer = svConfig
                                            ) : Boolean;

function ReadIniFileWord(const FileName    : LongString;
                         const SectionName : LongString;
                         const Key         : LongString;
                           var Data        : Word;
                               efMode      : Integer = efConfig;
                               svMode      : Integer = svConfig
                                         ) : Boolean;

function ReadIniFileInteger(const FileName    : LongString;
                            const SectionName : LongString;
                            const Key         : LongString;
                              var Data        : Integer;
                                  efMode      : Integer = efConfig;
                                  svMode      : Integer = svConfig
                                            ) : Boolean;

function ReadIniFileLongInt(const FileName    : LongString;
                            const SectionName : LongString;
                            const Key         : LongString;
                              var Data        : LongInt;
                                  efMode      : Integer = efConfig;
                                  svMode      : Integer = svConfig
                                            ) : Boolean;

function ReadIniFileAlpha(const FileName    : LongString;
                          const SectionName : LongString;
                          const Key         : LongString;
                            var Data        : PureString;
                                efMode      : Integer = efConfig;
                                svMode      : Integer = svConfig
                                          ) : Boolean; overload;

function ReadIniFileAlpha(const FileName    : LongString;
                          const SectionName : LongString;
                          const Key         : LongString;
                            var Data        : LongString;
                                efMode      : Integer = efConfig;
                                svMode      : Integer = svConfig
                                          ) : Boolean; overload;

function ReadIniFileString(const FileName    : LongString;
                           const SectionName : LongString;
                           const Key         : LongString;
                             var Data        : PureString;
                                 efMode      : Integer = efConfig;
                                 svMode      : Integer = svConfig
                                           ) : Boolean; overload;

function ReadIniFileString(const FileName    : LongString;
                           const SectionName : LongString;
                           const Key         : LongString;
                             var Data        : LongString;
                                 efMode      : Integer = efConfig;
                                 svMode      : Integer = svConfig
                                           ) : Boolean; overload;

 {
 Функция чтения имен файлов из ini-файла
 Если указано не полное имя файла, то к нему прибавляется StartupPath:
 File1 = c:\work\f1.txt   ->
 File2 = f2.txt           -> StartupPath+f2.txt
 }
function ReadIniFilePath(const FileName    : LongString;
                         const SectionName : LongString;
                         const Name        : LongString;
                         const StartupPath : LongString;
                           var Path        : PureString;
                               handleUrl   : Boolean = true;
                               efMode      : Integer = efConfigFN;
                               svMode      : Integer = svConfig
                                         ) : Boolean;  overload;
function ReadIniFilePath(const FileName    : LongString;
                         const SectionName : LongString;
                         const Name        : LongString;
                         const StartupPath : LongString;
                           var Path        : LongString;
                               handleUrl   : Boolean = true;
                               efMode      : Integer = efConfigFN;
                               svMode      : Integer = svConfig
                                         ) : Boolean; overload;
 {
 Установить файл отчета чтения INI-файлов
 }
procedure OpenIniLogFile(const Path:LongString);

const
 ReadIniLogFifoSize       : Integer = 1024*64;
 ReadIniLogFifoGrowFactor : Integer = 2;
 ReadIniLogFifoPollPeriod : Integer = 1000;
 ReadIniLogFifoGrowLimit  : Integer = 1024*1024*4;

 {
 *****************************
 Special directories and files
 *****************************
 }

 { Full program file name }
function  ProgName:LongString;

 { Program base file name }
function  ProgBaseName:LongString;

 { Home directory, where program placed }
function  HomeDir(const SubDir:LongString=''):LongString;

 { User $HOME or %USERPROFILE% directory }
function  UserHomeDir(const SubDir:LongString=''):LongString;

 { Home directory, where program started }
function  StartupPath(const SubDir:LongString=''):LongString;

 { Current dir, when program start to work }
function  StartAtDir(const SubDir:LongString=''):LongString;

 { File where program ini params must be placed }
function  SysIniFile:LongString;

 { Change dir to home directory }
procedure GoHome;

 { System root directory: / for UNIX, WINDIR for Windows }
function SystemRootDir:LongString;

 { Where windows placed, such as c:\windows; on Unix it's root (/). }
function  WindowsDir:LongString;

 { Windows system dir, such as c:\windows\system32. on Unix it's (/bin). }
function  WindowsSystemDir:LongString;

 { Windows temporary files directory. On unix it's (/tmp). }
function  WindowsTempDir:LongString;

 { Global (system) temporary directory }
function  GlobalTempDir(const SubDir:LongString=''):LongString;

 { Local (current user) temporary directory }
function  LocalTempDir(const SubDir:LongString=''):LongString;

 { Program temporary directory }
function  TempDir(const SubDir:LongString=''):LongString;

 { Setup program temporary directory }
procedure SetTempDir(const Dir:LongString);
function  CreateTempFile(const Template:LongString='###.tmp'; const InDir:LongString=''):LongString;

const // Executable for CrwKit package.
 TheCrwKitCheckList='crwkit crwrun unix';
 TheCrwKitPathVars='UNIXROOT CRWKIT_ROOT CRWTOOLKIT_ROOT CMDTOOLKIT_ROOT';

 { Find executable of CrwKit - (crwkit,crwrun,unix). }
function GetCrwKitExe:LongString;

 { Get command processor %COMSPEC% or $SHELL }
function GetComSpec:LongString;

 { Get command processor $SHELL or %COMSPEC% }
function GetShell:LongString;

 {
 Get shell command to call CmdLine.
 On Windows:  %COMSPEC% /c CmdLine
 On Unix:     $SHELL    -c CmdLine
 }
function GetShellCmd(const CmdLine:LongString):LongString;
function GetComSpecCmd(const CmdLine:LongString):LongString;

const                   // GetListOfShells Mode:
 glosh_Refresh = $0001; // Refresh list of shells
 glosh_DelPath = $0002; // Delete path, get name
 glosh_IfExist = $0004; // Check if file exists
 glosh_Default = 0;     // Use it by default

  { Get list of shells. On Unix from /etc/shells and $SHELL. }
function GetListOfShells(Mode:Integer=glosh_Default):LongString;

 { Get command line as it known from OS. }
function GetCommandLine:LongString;

 { Current user name }
function  UserName:LongString;

 { Computer name }
function  ComputerName:LongString;

 { Hostname 0:simple, 1:domain }
function  HostName(Method:Integer=0):LongString;

 { Check F is folder }
function  SearchRecValidFolder(const F:TSearchRec):Boolean;

 { Get user domain name. }
function  UserDomain(const aUser:LongString=''; aDef:LongString=''):LongString;

 { Get IP address. }
function  GetIPAddress(const aHostName:LongString=''):LongString;

{ Get list of MAC addresses of all local interfaces. }
function GetIfMacAddresses(Delim:LongString=','; Mode:Integer=0):LongString;

{ Get list of IP addresses of all local interfaces. }
function GetIfIpAddresses(Delim:LongString=','; Mode:Integer=0):LongString;

{ Get list of IP addresses with delemiter (Delim). }
function  GetIPAddresses(const aHostName:LongString=''; Delim:LongString=','):LongString;

{ List of MAC ADDRESS for Eternet cards. Mode(1)=WithNames. }
function  GetMacAddresses(const Machine:LongString=''; Delim:LongString=','; Mode:Integer=0):LongString;

function GetLocalUserList(Delim:LongString=EOL):LongString;

 {
 ***********************************************************
 Special enumarators. Be care: it can take a very long time.
 Use threads to avoid hanging.
 Each Level=0 enumerator much faster then Level=1 one.
 ***********************************************************
 GetUserList(Level=0) provides 1-column table of UserName
 GetUserList(Level=1) provides 4-column table:
  1         2                  3      4
  UserName  ?/Guest/User/Root On/Off Comment
  Alex      Root              On     Main user
 ***********************************************************
 GetHostList(Level=0) provides 1-column table of HostName
 GetHostList(Level=1) provides 4-column table:
  1         2           3               4
  HostName  IP          Flags           Comment
  crwbox    174.21.4.32 \WSt\Srv\WinNt\ DaqGroup server
 ***********************************************************
 GetDomainList(Level=0) provides 1-column table of DomainName
 GetDomainList(Level=1) provides 3-column table:
  1           2                 3
  DomainName  DomainController  DomainControllerIP
  abbey       abbot             174.21.4.31
 ***********************************************************
 }
const
 NetEnumTimeoutId  = '...TimeOut...';
 DefNetEnumTimeout = 10000;
 FILTER_NORMAL_ACCOUNT  = 0;
const // SV_101_TYPES: Типы серверов NetServerEnum
 SV_TYPE_WORKSTATION       = $00000001;
 SV_TYPE_SERVER            = $00000002;
 SV_TYPE_SQLSERVER         = $00000004;
 SV_TYPE_DOMAIN_CTRL       = $00000008;
 SV_TYPE_DOMAIN_BAKCTRL    = $00000010;
 SV_TYPE_TIME_SOURCE       = $00000020;
 SV_TYPE_AFP               = $00000040;
 SV_TYPE_NOVELL            = $00000080;
 SV_TYPE_DOMAIN_MEMBER     = $00000100;
 SV_TYPE_PRINTQ_SERVER     = $00000200;
 SV_TYPE_DIALIN_SERVER     = $00000400;
 SV_TYPE_XENIX_SERVER      = $00000800;
 SV_TYPE_SERVER_UNIX       = SV_TYPE_XENIX_SERVER;
 SV_TYPE_NT                = $00001000;
 SV_TYPE_WFW               = $00002000;
 SV_TYPE_SERVER_MFPN       = $00004000;
 SV_TYPE_SERVER_NT         = $00008000;
 SV_TYPE_POTENTIAL_BROWSER = $00010000;
 SV_TYPE_BACKUP_BROWSER    = $00020000;
 SV_TYPE_MASTER_BROWSER    = $00040000;
 SV_TYPE_DOMAIN_MASTER     = $00080000;
 SV_TYPE_SERVER_OSF        = $00100000;
 SV_TYPE_SERVER_VMS        = $00200000;
 SV_TYPE_WINDOWS           = $00400000;
 SV_TYPE_DFS               = $00800000;
 SV_TYPE_CLUSTER_NT        = $01000000;
 SV_TYPE_TERMINALSERVER    = $02000000;
 SV_TYPE_CLUSTER_VS_NT     = $04000000;
 SV_TYPE_DCE               = $10000000;
 SV_TYPE_ALTERNATE_XPORT   = $20000000;
 SV_TYPE_LOCAL_LIST_ONLY   = $40000000;
 SV_TYPE_DOMAIN_ENUM       = $80000000;
 SV_TYPE_ALL               = $FFFFFFFF;

function  GetUserList(const aServer  : LongString ='.';
                            aLevel   : Integer    = 0;
                            aFilter  : DWORD      = FILTER_NORMAL_ACCOUNT;
                            aTimeOut : DWORD      = DefNetEnumTimeout
                                   ) : LongString; // Return list of known users.
function  GetHostList(const aServer  : LongString ='.';
                            aDomain  : LongString ='';
                            aLevel   : DWORD      = 0;
                            aType    : DWORD      = SV_TYPE_ALL;
                            aTimeOut : DWORD      = DefNetEnumTimeout
                                   ) : LongString; // Return list of known hosts.
function  GetDomainList(const aServer  : LongString ='.';
                              aLevel   : Integer    = 0;
                              aLocals  : Boolean    = False;
                              aTimeOut : DWORD      = DefNetEnumTimeout
                                     ) : LongString; // Return list of known domains.

{$IFnDEF WINDOWS}
type
 HKEY = THANDLE;                          // Windows compatibility routines
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}

 //
 // System registry functions
 // Available RootKey are:
 //  HKCR  or HKEY_CLASSES_ROOT
 //  HKLM  or HKEY_LOCAL_MACHINE
 //  HKCU  or HKEY_CURRENT_USER
 //  HKU   or HKEY_USERS
 //  HKCC  or HKEY_CURRENT_CONFIG
 //  HKDD  or HKEY_DYN_DATA
 //  HKPD  or HKEY_PERFORMANCE_DATA
 //
function  GetRootKeyByName(const Key:LongString):HKEY;
function  ReadRegistryString(RootKey:HKEY; const Key,Name:LongString):LongString;
function  WriteRegistryString(RootKey:HKEY; const Key,Name,Data:LongString):LongString;
function  ReadRegistryMultiStrings(RootKey:HKey; const Key,Name:LongString; Delim:Char=ASCII_CR):LongString;
function  GetWindowsShellFolder(const Name:LongString):LongString;
function  GetWindowsShellDesktop:LongString;      // Windows shell Desktop
function  GetWindowsShellPrograms:LongString;     // Windows shell Programs menu
function  GetWindowsShellStartup:LongString;      // Windows shell Startup menu
function  GetWindowsShellStartMenu:LongString;    // Windows shell Start menu
function  GetWindowsShellFavorites:LongString;    // Windows shell Favorites
function  GetWindowsShellFonts:LongString;        // Windows shell Fonts
function  GetWindowsShellHistory:LongString;      // Windows shell History
function  GetWindowsShellPersonal:LongString;     // Windows shell My Documents
function  GetWindowsShellSendTo:LongString;       // Windows shell Send To
procedure CreateFileLink(const ObjectPath,LinkPath,Description,Params:LongString);
function  ReadShellLinkAsText(const FileName:LongString):LongString;

 //
 // Environment functions
 //
function ArgChar(const s:LongString):PChar;           // Return PChar(s) or nil
function GetEnv(const Name:LongString):LongString;    // Get environment variable
function SetEnv(const Name,Value:LongString):Boolean; // Set environment variable
function ExpEnv(const Str:LongString):LongString;     // ExpandEnvironmentStrings
function GetEnvVar(const Name:LongString):LongString; // Synonym of GetEnv
function MaybeEnvStr(const arg:LongString):Boolean;   // Maybe arg contains environment string
function MaybeTildeStr(const arg:LongString):Boolean; // Maybe arg contains ~ or ~~ reference

 //
 // ExpEnvFilter uses to expand data string Str with environment variables
 // which names in brackerts with function GetEnvFinc to readout variables.
 // By default GetEnvFunc equals to GetEnv to read environment as usually.
 // For example:
 //  ComSpec:=ExpEnvFilter('%ComSpec%','%','%');
 //  WinDir:=ExpEnvFilter('%WinDir%','%%',true);
 //  SystemRoot:=ExpEnvFilter('[SystemRoot]','[]');
 // If handleUrl is True, scanner will skip expressions looks like URL encoded
 // symbols like %xx with hexadecimal code xx. In this case Str compatible with
 // url_encode/url_decode functions.
 //
type TGetEnvFunction = function(const Str:LongString):LongString;
function ExpEnvFilter(const Str:LongString; lBracket,rBracket:Char;
                      handleUrl:Boolean=false; GetEnvFunc:TGetEnvFunction=nil):LongString; overload;
function ExpEnvFilter(const Str:LongString; const Brackets:LongString;
                      handleUrl:Boolean=false; GetEnvFunc:TGetEnvFunction=nil):LongString; overload;

 //
 // Calculate brackets for ExpEnvFilter: * means DefaultExpEnvBrackets
 //
function CalcExpEnvBrackets(const Brackets:LongString='*'):LongString;
const
 DefaultExpEnvBrackets : LongString = '%%!!';

 //
 // Add directory to Path list.
 // PathAddDir(Path,Dir) add directory Dir to Path directory list (delimeted with Delim) and return result list.
 // PathAddDirEnv(Dir) add directory to PATH environment variable.
 // PathAddDirEnvFromIni(IniFile,Section,VarName,BaseFile) read IniFile [Section] VarName = ... statement
 // and add directories to PATH environment
 //
function PathAddDir(const Path,Dir:LongString; AddFirst:Boolean=false; Check:Boolean=true; Delim:Char=PathSep):LongString;
function PathAddDirEnv(const Dir:LongString; AddFirst:Boolean=false; Check:Boolean=true; Delim:Char=PathSep):Boolean;
procedure PathAddDirEnvFromIni(const IniFile,Section,VarName,BaseFile:LongString; First:Boolean=false);

const                   // SmartFileRef constants
 sfrDefUserHome = '~';  // Marker of User Home,   i.e. %UserProfile%    like ~\Dir\demo.txt
 sfrDefProgHome = '~~'; // Marker of ProgramHome, i.e. main EXE folder  like ~~\Resource\Manual\crw-daq.htm
 sfrDefBrackets = '*';  // Marker of default brackets usage

 //
 // Get smart file reference:
 //  1) If FileRef has FULL pathname with extension, return FileRef
 //  2) If FileRef has no extension, set extension DefExt by default
 //  3) If FileRef starts from ~~, it's relative path from program HomeDir
 //  4) If FileRef starts from ~,  it's relative path from user home directory
 //  5) If FileRef has relative path, it's path form BaseFile
 // Example:
 //  SmartFileRef('c:\daq\demo\config\test.cfg') - c:\daq\demo\config\test.cfg
 //  SmartFileRef('test','.cfg',Daq.ConfigFile)  - c:\daq\demo\config\test.cfg
 //  SmartFileRef('~\test','.cfg')               - c:\Documents Add settings\Alex\test.cfg
 //  SmartFileRef('~~\test','.cfg')              - c:\Crw32exe\test.cfg
 //
function SmartFileRef(const FileRef   : LongString;
                      const DefExt    : LongString = '';
                      const BaseFile  : LongString = '';
                      const UserHome  : LongString = sfrDefUserHome;
                      const ProgHome  : LongString = sfrDefProgHome;
                      const Brackets  : LongString = sfrDefBrackets;
                            handleUrl : Boolean    = true
                                    ) : LongString;

 //
 // Get short file reference, back from SmartFileRef:
 //  1) Replace program home dir to ~~
 //  2) Replace user home dir    to ~
 //  3) Make relative path, form BaseFile
 //
function SmartFileRel(const FileRef   : LongString;
                      const BaseFile  : LongString;
                      const UserHome  : LongString = sfrDefUserHome;
                      const ProgHome  : LongString = sfrDefProgHome;
                      const Brackets  : LongString = sfrDefBrackets;
                            handleUrl : Boolean    = true
                                    ) : LongString;

 //
 // Smart file seach.
 // FileName   is short (without path) file name to seach.
 // PathVarStr is semicolon-delimited list of environment variables, each
 //            variable contains semicolon-delimited list of search
 //            directories. For example, Path environment variable
 //            contains system Windows seach directories list.
 // PathExtVar is environment variable with semicolon-delimeted list of
 //            extensions to seach for, if one not specified in FileName.
 // PathExtStr is direct semicolon-delimeted list of extensions to seach
 //            for, if one not specified in FileName and PathExtVar.
 // Example: arj:=SmartFileSearch('arj.exe','CRW_DAQ_SYS_PATH;Path');
 //
const
 {$IFDEF WINDOWS}
 DefaultPathExt    = '.com;.exe;.bat;.cmd;.vbs;.vbe;.js;.jse;.wsf;.wsh';
 {$ELSE}
 DefaultPathExt    = '.sh;.bash';
 {$ENDIF ~WINDOWS}
 DefaultPathVarStr = 'CRW_DAQ_CONFIG_PATH;CRW_DAQ_SYS_PATH;PATH';

function SmartFileSearch(const FileName   : LongString;
                         const PathVarStr : LongString='PATH';
                         const PathExtVar : LongString='PATHEXT';
                         const PathExtStr : LongString=DefaultPathExt
                                        ) : LongString;

 //
 // Add/remove directory Path to seach list in environment variable EnvVar.
 // Example: AddSearchPath('PATH','e:\temp');
 //
function AddSearchPath(const EnvVar,Path:LongString; First:Boolean=false):LongString;
function RemSearchPath(const EnvVar,Path:LongString):LongString;

 //
 // Get EXE file information:
 // CompanyName,FileDescription,FileVersion,InternalName,LegalCopyright,
 // LegalTradeMarks,OriginalFilename,ProductName,ProductVersion,Comments
 //
function GetFileVersionInfoAsText(FileName:LongString):LongString;

{$IFDEF WINDOWS}
 {
 Converts the specified path to its long form.
 If the function succeeds, the return value is the length, in chars,
 of the string copied to lpszLongPath, not including the terminating null character.
 If the function fails for any other reason, such as if the file does not exist, the return value is zero.
 https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-getlongpathnamea
 }
function GetLongPathName(lpszShortPath,lpszLongPath:PChar; cchBuffer:DWORD):DWORD;stdcall;

 {
 Retrieves the short path form of the specified path.
 https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-getshortpathnamew
 }
function GetShortPathName(lpszLongPath,lpszShortPath:PChar; cchBuffer:DWORD):DWORD;stdcall;
{$ENDIF WINDOWS}

 {
 Read symlink (rerursive) or return regular file name.
 }
function ReadSymLink(const FileName:LongString; MaxLevel:Integer=10):LongString;

 {
 Get real file path name as it is exist on disk.
 Don't change file name if the file was not found.
 }
function GetRealFilePathName(const FileName:LongString; BuffSize:Integer=MAX_PATH; Mode:Integer=0):LongString;

const                         // GetRealFilePathName Mode flags:
 fm_ReplaceSlash = $00000001; // Replace / to \
 fm_ApplyFExpand = $00000002; // Apply GetFullPathName to resolve .\, ..\, \\
 fm_ApplyGLongFN = $00000004; // Apply GetLongFileName to convert file names to long file names (but not path)
 fm_ApplyFind1st = $00000008; // Apply FindFirstFile to correct char case of file name and full path
 fm_ReadSymLinks = $00000010; // Use ReadSymLink to resolve symbolic links

const // Default  GetRealFilePathName Mode
 DefaultGetRealFilePathNameMode : Integer = $0000001F;

 {
 Validate PATH list like: SetEnv('PATH',ValidatePathList(GetEnv('PATH')));
 Check directory exists, convert short file names to long etc, see GetRealFilePathName.
 }
function ValidatePathList(const PathList:LongString; Delim:Char=PathSep):LongString;

 {
 Validate file search paths from list of environment variables, like:
 ValidateEnvPathList('PATH;CRW_DAQ_CONFIG_PATH');
 }
function ValidateEnvPathList(const EnvPathList:LongString; Delim:Char=PathSep):Integer;

 {
 Search file in PATH like unix's which does.
 Return empty string if file not found.
 }
function file_which(name:LongString):LongString;

 {
 On Unix: set TMPDIR environment variable to /tmp if it is not set.
 }
function ValidateEnvTmpDir:Boolean;

 {
 Config Files cache log.
 }
function dlc_CfgCache:Integer;

implementation

uses
 _crw_polling, _crw_dbglog;

 {
 ***************
 Common routines
 ***************
 }
function dlc_CfgCache:Integer;
const dlc:Integer=0;
begin
 if (dlc=0) then dlc:=RegisterDebugLogChannel('_CfgCache');
 Result:=dlc;
end;

 {
 ***********************
 Special file assignment
 ***********************
 }

 {
 ********************
 NULL file assignment
 ********************
 }

procedure NullWriteFunc(var F: TTextRec);  // See System.FileFunc
begin
 F.BufPos:=0;
 F.BufEnd:=0;
end;

procedure NullReadFunc(var F: TTextRec);
begin
 F.BufPos:=0;
 F.BufEnd:=0;
end;

procedure NullCloseFunc(var F: TTextRec);
begin
 F.BufPos:=0;
 F.BufEnd:=0;
 F.Handle:=UnusedHandle;
end;

procedure NullOpenFunc(var F: TTextRec);
begin
 if (F.Mode=fmInput) then begin
  F.InOutFunc:=@NullReadFunc;
  F.FlushFunc:=nil;
 end else begin
  F.Mode:=fmOutput;
  F.InOutFunc:=@NullWriteFunc;
  F.FlushFunc:=@NullWriteFunc;
 end;
 F.CloseFunc:=@NullCloseFunc;
end;

procedure AssignNull(out T:Text);
begin
 Assign(T,'NULL:');
 TTextRec(T).OpenFunc:=@NullOpenFunc;
end;

 {
 ********************
 FIFO file assignment
 ********************
 }

type
 PFifoData = ^TFifoData;
 TFifoData = packed record  // UserData for Fifo
  Fifo     : TFifo;         // Fifo reference
  Safe     : PtrUInt;       // Safety marker
  Sign     : QWord;         // Magic sign
 end;

{$DEFINE USES_NEW_SignFIFO}
const
 {$IFDEF USES_NEW_SignFIFO}
 FifoMagicSign = $4F4649466E676953; // Dump2q('SignFIFO')
 {$ELSE}
 FifoMagicSign = $0123456789ABCDEF; // Magic sign for FIFO
 {$ENDIF}

function GetTextFifo(var F: TTextRec):TFifo; inline;
begin
 with PFifoData(@F.UserData)^ do
 if Assigned(Fifo) and (Safe=(not PointerToPtrUInt(Fifo))) and (Sign=FifoMagicSign)
 then Result:=Fifo else Result:=nil;
end;

function GetTextFileFifo(var T:Text):TFifo;
begin
 Result:=GetTextFifo(TTextRec(T));
end;

procedure SetTextFifo(var F: TTextRec; Fifo:TFifo);
begin
 F.Handle:=Fifo.Ref;
 PFifoData(@F.UserData)^.Fifo:=Fifo;
 PFifoData(@F.UserData)^.Safe:=(not PointerToPtrUInt(Fifo));
 PFifoData(@F.UserData)^.Sign:=FifoMagicSign;
end;

procedure FifoWriteFunc(var F: TTextRec); // See FPC text.inc
var Fifo:TFifo; n:SizeInt;
begin
 if (F.BufPos=0) then Exit;
 Fifo:=GetTextFifo(F);
 n:=Fifo.Put(F.BufPtr,F.BufPos);
 if (n<>F.BufPos) then SetInOutRes(101);
 F.BufPos:=0;
 F.BufEnd:=0;
end;

procedure FifoReadFunc(var F: TTextRec);
var Fifo:TFifo;
begin
 F.BufPos:=0;
 F.BufEnd:=0;
 Fifo:=GetTextFifo(F);
 if Assigned(Fifo)
 then Inc(F.BufEnd,Fifo.Get(F.BufPtr,F.BufSize))
 else SetInOutRes(100);
end;

procedure FifoCloseFunc(var F: TTextRec);
begin
 SafeFillChar(F.UserData,SizeOf(F.UserData),0);
 F.Handle:=UnusedHandle;
 F.BufPos:=0;
 F.BufEnd:=0;
end;

procedure FifoOpenFunc(var F: TTextRec);
var Fifo:TFifo;
begin
 Fifo:=GetTextFifo(F);
 if Assigned(Fifo) then begin
   if (F.Mode=fmInput) then begin
   F.InOutFunc:=@FifoReadFunc;
   F.FlushFunc:=nil;                     { NB! In FPC FlushFunc must be NIL  }
  end else begin
   if (F.Mode=fmOutput) then Fifo.Clear; { if rewrite called then clear fifo }
   F.Mode:=fmOutput;                     { !!! }
   F.InOutFunc:=@FifoWriteFunc;
   F.FlushFunc:=@FifoWriteFunc;
  end;
  F.CloseFunc:=@FifoCloseFunc;
 end else begin
  NullOpenFunc(F);
  SetInOutRes(102);
 end;
end;

procedure AssignFifo(out T:Text; Fifo:TFifo=nil);
 function GetFifoName(Fifo:TFifo):LongString;
 begin
  if (Fifo.Name='')
  then Result:='FIFO:'
  else Result:=Fifo.Name;
 end;
begin
 if Assigned(Fifo) then begin
  Assign(T,GetFifoName(Fifo));
  SetTextFifo(TTextRec(T),Fifo);
  TTextRec(T).OpenFunc:=@FifoOpenFunc;
 end else AssignNull(T);
end;

 {
 *************************************
 Standard Input/Output file assignment
 *************************************
 }
const
 Std_Inp_Fifo : TFifo = nil;
 Std_Out_Fifo : TFifo = nil;
 Std_Err_Fifo : TFifo = nil;

function StdInputFifo:TFifo;
begin
 if not Assigned(Std_Inp_Fifo) then begin
  Std_Inp_Fifo:=NewFifo(StdInputFifoSize,'CON:\INPUT');
  Std_Inp_Fifo.Master:=@Std_Inp_Fifo;
  Std_Inp_Fifo.GrowLimit:=StdInputFifoLimit;
  Std_Inp_Fifo.GrowFactor:=StdInputFifoFactor;
 end;
 Result:=Std_Inp_Fifo;
end;

function StdOutputFifo:TFifo;
begin
 if not Assigned(Std_Out_Fifo) then begin
  Std_Out_Fifo:=NewFifo(StdOutputFifoSize,'CON:\OUTPUT');
  Std_Out_Fifo.Master:=@Std_Out_Fifo;
  Std_Out_Fifo.GrowLimit:=StdOutputFifoLimit;
  Std_Out_Fifo.GrowFactor:=StdOutputFifoFactor;
 end;
 Result:=Std_Out_Fifo;
end;
 
function StdErrOutputFifo:TFifo;
begin
 if not Assigned(Std_Err_Fifo) then begin
  Std_Err_Fifo:=NewFifo(StdOutputFifoSize,'CON:\ERROUTPUT');
  Std_Err_Fifo.Master:=@Std_Err_Fifo;
  Std_Err_Fifo.GrowLimit:=StdOutputFifoLimit;
  Std_Err_Fifo.GrowFactor:=StdOutputFifoFactor;
 end;
 Result:=Std_Err_Fifo;
end;

function Redirected(var T:Text):Boolean; inline;
begin
 Result:=Assigned(GetTextFifo(TTextRec(T)));
end;

procedure StandardEchoProcedure(const Msg:LongString);
begin
 {if IsConsole}
 if not Redirected(Output)
 then System.Write(Output,Msg)
 else StdOutputFifo.PutText(Msg);
end;

threadvar // Saved IO files, strings for IO buffers
 SaveInput     : Text;   BuffInput     : LongString;
 SaveOutput    : Text;   BuffOutput    : LongString;
 SaveErrOutput : Text;   BuffErrOutput : LongString;

procedure SetTextBufToString(var T:Text; var S:LongString);
var BuffSize:Integer;
begin
 BuffSize:=EnsureRange(StdIoBuffSize,0,MaxTextBufSize);
 if (BuffSize<=System.TextRecBufSize) then Exit;
 SetLength(S,StdIoBuffSize);
 if (Length(S)=0) then Exit;
 SetTextBuf(T,S[1],Length(S));
end;

procedure RedirectStdIo(What:LongString; ToFifo:Boolean);
begin
 if ToFifo then begin
  // Redirect Standard Input to FIFO
  if HasChars(What,StdInpMarkers) then
  if not Redirected(Input) then begin
   TTextRec(SaveInput):=TTextRec(Input);
   AssignFifo(Input,StdInputFifo);
   Reset(Input);
   SetTextBufToString(Input,BuffInput);
  end;
  // Redirect Standard Output to FIFO
  if HasChars(What,StdOutMarkers) then
  if not Redirected(Output) then begin
   TTextRec(SaveOutput):=TTextRec(Output);
   AssignFifo(Output,StdOutputFifo);
   Append(Output);
   SetTextBufToString(Output,BuffOutput);
  end;
  // Redirect Standard ErrOutput to FIFO
  if HasChars(What,StdErrMarkers) then
  if not Redirected(ErrOutput) then begin
   TTextRec(SaveErrOutput):=TTextRec(ErrOutput);
   AssignFifo(ErrOutput,StdErrOutputFifo);
   Append(ErrOutput);
   SetTextBufToString(ErrOutput,BuffErrOutput);
  end;
 end else begin
   // Redirect Standard Input back
  if HasChars(What,StdInpMarkers) then
  if Redirected(Input) then begin
   SmartFileClose(Input);
   BuffInput:='';
   // Restore original Standard Input
   TTextRec(Input):=TTextRec(SaveInput);
  end;
  // Redirect Standard Output back
  if HasChars(What,StdOutMarkers) then
  if Redirected(Output) then begin
   SmartFileClose(Output);
   BuffOutput:='';
   // Restore original Standard Output
   TTextRec(Output):=TTextRec(SaveOutput);
  end;
  // Redirect Standard ErrOutput back
  if HasChars(What,StdErrMarkers) then
  if Redirected(ErrOutput) then begin
   SmartFileClose(ErrOutput);
   BuffErrOutput:='';
   // Restore original Standard ErrOutput
   TTextRec(ErrOutput):=TTextRec(SaveErrOutput);
  end;
 end;
end;

function  RedirectedStdIo:LongString;
begin
 Result:='';
 if Redirected(Input) then Result:=Result+StdInpMarker;
 if Redirected(Output) then Result:=Result+StdOutMarker;
 if Redirected(ErrOutput) then Result:=Result+StdErrMarker;
end;

procedure Std_IO_Initialization;
begin
 if not IsConsole then RedirectStdIo('012',true);
 SystemEchoProcedure:=StandardEchoProcedure;
end;

procedure Std_IO_Finalization;
begin
 RedirectStdIo('012',false);
 Kill(Std_Inp_Fifo);
 Kill(Std_Out_Fifo);
 Kill(Std_Err_Fifo);
end;

 {
 **********************
 Common file operations
 **********************
 }

{$IFDEF UNIX}
function GetStdHandle(hFile:THandle):THandle;
begin
 case hFile of
  STD_INPUT_HANDLE  : Result:=System.StdInputHandle;
  STD_OUTPUT_HANDLE : Result:=System.StdOutputHandle;
  STD_ERROR_HANDLE  : Result:=System.StdErrorHandle;
  else                Result:=INVALID_HANDLE_VALUE;
 end;
end;
{$ENDIF UNIX}

{$IFDEF UNIX}
function GetFileType(hFile:THandle):LongWord;
var sb:stat; fmt:LongWord;
begin
 Result:=FILE_TYPE_UNKNOWN;
 sb.st_dev:=0; sb.st_mode:=0;
 if fpfstat(hFile,sb)=0 then begin
  fmt:=(sb.st_mode and S_IFMT);
  case fmt of
   S_IFIFO  : Result:=FILE_TYPE_FIFO; // named pipe (fifo)
   S_IFCHR  : Result:=FILE_TYPE_CHR;  // character special
   S_IFDIR  : Result:=FILE_TYPE_DIR;  // directory
   S_IFBLK  : Result:=FILE_TYPE_BLK;  // block special
   S_IFREG  : Result:=FILE_TYPE_REG;  // regular file
   S_IFLNK  : Result:=FILE_TYPE_LNK;  // symbolic link
   S_IFSOCK : Result:=FILE_TYPE_SOCK; // socket
   else       Result:=FILE_TYPE_NONE; // unknown or error
  end;
 end;
end;
{$ENDIF UNIX}

{$IFDEF WINDOWS}
function GetFileType(hFile:THandle):LongWord;
begin
 Result:=Windows.GetFileType(hFile);
end;
{$ENDIF UNIX}

function GetFileType(var F:Text):LongWord;
begin
 Result:=GetFileType(TextRec(F).Handle);
end;

function GetFileType(var F:File):LongWord;
begin
 Result:=GetFileType(FileRec(F).Handle);
end;

function StdInFileType:LongWord;
begin
 Result:=GetFileType(GetStdHandle(STD_INPUT_HANDLE));
end;

function StdOutFileType:LongWord;
begin
 Result:=GetFileType(GetStdHandle(STD_OUTPUT_HANDLE));
end;

function StdErrFileType:LongWord;
begin
 Result:=GetFileType(GetStdHandle(STD_ERROR_HANDLE));
end;

function FileTypeToString(fType:LongWord; Prefix:LongString='FILE_TYPE_'):LongString;
begin
 case fType of
  FILE_TYPE_UNKNOWN : Result:=Prefix+'UNKNOWN';
  FILE_TYPE_DISK    : Result:=Prefix+'DISK';
  FILE_TYPE_CHAR    : Result:=Prefix+'CHAR';
  FILE_TYPE_PIPE    : Result:=Prefix+'PIPE';
  {$IFDEF UNIX}
  FILE_TYPE_DIR     : Result:=Prefix+'DIR';
  FILE_TYPE_BLK     : Result:=Prefix+'BLK';
  FILE_TYPE_LNK     : Result:=Prefix+'LNK';
  FILE_TYPE_SOCK    : Result:=Prefix+'SOCK';
  FILE_TYPE_REMOTE  : Result:=Prefix+'REMOTE';
  {$ENDIF ~UNIX}
  else                Result:=Prefix+'UNKNOWN';
 end;
end;

function IoResultToString(Code:Integer):LongString;
begin
 Result:=GetRunErrorText(Code);
end;

function StdPrint(const Msg:LongString; n:Integer=1):LongInt;
var h:THandle;
begin
 Result:=0;
 case n of
  1:   h:=GetStdHandle(STD_OUTPUT_HANDLE);
  2:   h:=GetStdHandle(STD_ERROR_HANDLE);
  else h:=INVALID_HANDLE_VALUE;
 end;
 if (h>0) and (Msg<>'') then Result:=FileWrite(h,PChar(Msg)^,Length(Msg));
end;

function StdOutPrint(const Msg:LongString):LongInt;
begin
 Result:=StdPrint(Msg,1);
end;

function StdErrPrint(const Msg:LongString):LongInt;
begin
 Result:=StdPrint(Msg,2);
end;

function StdPrintLn(const Msg:LongString; n:Integer=1):LongInt;
begin
 Result:=StdPrint(Msg+EOL,n);
end;

function StdOutPrintLn(const Msg:LongString):LongInt;
begin
 Result:=StdPrint(Msg+EOL,1);
end;

function StdErrPrintLn(const Msg:LongString):LongInt;
begin
 Result:=StdPrint(Msg+EOL,2);
end;

function FileHasNonBlockFlag(fd:THandle):Boolean;
begin
 {$IFDEF UNIX}
 Result:=HasFlags(fpfcntl(fd,F_GETFL),O_NONBLOCK);
 {$ELSE}
 Result:=false;
 {$ENDIF}
end;

function FileSetNonBlockFlag(fd:THandle; State:Boolean=true):Boolean;
{$IFDEF UNIX}var Flags:LongInt;{$ENDIF}
begin
 {$IFDEF UNIX}
 Flags:=fpfcntl(fd,F_GETFL);
 LiftFlags(Flags,O_NONBLOCK,State);
 Result:=(fpfcntl(fd,F_SETFL,Flags)=NO_ERROR);
 {$ELSE}
 Result:=false;
 {$ENDIF}
end;

function FileSetCloseOnExec(fd:THandle; State:Boolean=true):Boolean;
{$IFDEF UNIX}var Flags:LongInt; const FD_CLOEXEC=1;{$ENDIF}
begin
 {$IFDEF UNIX}
 Flags:=fpfcntl(fd,F_GETFD);
 if (Flags=-1) then Exit(false);
 LiftFlags(Flags,FD_CLOEXEC,State);
 Result:=(fpfcntl(fd,F_SETFD,Flags)=NO_ERROR);
 {$ELSE}
 Result:=false;
 {$ENDIF}
end;

function ePendingFileOperation(ErrorCode:Integer):Boolean;
begin
 {$if defined (WINDOWS)}
 Result:=(ErrorCode=ERROR_IO_INCOMPLETE) // Overlapped I/O event is not in a signaled state.
      or (ErrorCode=ERROR_IO_PENDING);   // Overlapped I/O operation is in progress.
 {$elseif defined(UNIX)}
 Result:=(ErrorCode=ESysEAGAIN)       // Try again
      or (ErrorCode=ESysEWOULDBLOCK)  // Try again
      or (ErrorCode=ESysEINPROGRESS); // Operation now in progress
 {$else}
 Result:=false;
 {$endif}
end;

function eBrokenPipe(ErrorCode:Integer):Boolean;
begin
 {$IFDEF WINDOWS}
 Result:=(ErrorCode=ERROR_BROKEN_PIPE);
 {$ENDIF ~WINDOWS}
 {$IFDEF UNIX}
 Result:=(ErrorCode=ESysEPIPE);
 {$ENDIF ~UNIX}
end;

function eOperationAborted(ErrorCode:Integer):Boolean;
begin
 {$IFDEF WINDOWS}
 Result:=(ErrorCode=ERROR_OPERATION_ABORTED);
 {$ENDIF ~WINDOWS}
 {$IFDEF UNIX}
 Result:=(ErrorCode=ESysECONNABORTED);
 {$ENDIF ~UNIX}
end;

function isFileClosed(var f:File):Boolean;
begin
 Result:=(TFileRec(f).Mode=fmClosed);
end;

function isFileClosed(var f:Text):Boolean;
begin
 Result:=(TTextRec(f).Mode=fmClosed);
end;

function NumBytesStoredInTextBuf(var T:Text):SizeInt;
var R:TTextRec absolute T;
begin
 Result:=0;
 case R.Mode of
  fmClosed : Result:=0;
  fmInput  : Result:=R.bufend-R.bufpos;
  fmOutput : Result:=R.bufend-R.bufpos;
  fmInOut  : Result:=R.bufend-R.bufpos;
  fmAppend : Result:=R.bufend-R.bufpos;
 end;
end;

procedure SmartFileClose(var f:File);
begin
 if not isFileClosed(f) then Close(f);
end;

procedure SmartFileClose(var f:Text);
begin
 if not isFileClosed(f) then Close(f);
end;

function GetTextFileName(var T:Text):LongString;
begin
 case TTextRec(T).Mode of
  fmClosed : Result:=Format('%s',[SysUtils.StrPas(TTextRec(T).Name)]);
  fmInput  : Result:=Format('%s',[SysUtils.StrPas(TTextRec(T).Name)]);
  fmOutput : Result:=Format('%s',[SysUtils.StrPas(TTextRec(T).Name)]);
  fmInOut  : Result:=Format('%s',[SysUtils.StrPas(TTextRec(T).Name)]);
  fmAppend : Result:=Format('%s',[SysUtils.StrPas(TTextRec(T).Name)]);
  else       Result:='';
 end;
end;

function GetTextFileBufSize(var T:Text):SizeInt;
begin
 Result:=TTextRec(T).BufSize;
end;

function FileIsExecutable(const aFileName:LongString):Boolean;
begin
 Result:=lazfileutils.FileIsExecutable(aFileName);
end;

function FileIsSymlink(const aFileName:LongString):Boolean;
begin
 Result:=lazfileutils.FileIsSymlink(aFileName);
end;

function FileIsHardLink(const aFileName:LongString):Boolean;
begin
 Result:=lazfileutils.FileIsHardLink(aFileName);
end;

function FileIsReadable(const aFileName:LongString):Boolean;
begin
 Result:=lazfileutils.FileIsReadable(aFileName);
end;

function FileIsWritable(const aFileName:LongString):Boolean;
begin
 Result:=lazfileutils.FileIsWritable(aFileName);
end;

function GetFilePermissionsAsString(const aFileName:LongString):LongString;
 {$IFDEF UNIX}
 var info:stat; mode:Cardinal;
 function IsMode(mode,mask:Cardinal):Boolean;
 begin
  Result:=((mask and mode)=mask);
 end;
 {$ENDIF ~UNIX}
begin
 Result:='';
 if IsUnix then begin
  {$IFDEF UNIX}
  info:=Default(stat);
  if (FpStat(aFileName,info)=0) then begin
   // file type
   mode:= info.st_mode;
   if IsMode(mode,STAT_IFLNK) then Result:=Result+'l' else
   if IsMode(mode,STAT_IFDIR) then Result:=Result+'d' else
   if IsMode(mode,STAT_IFBLK) then Result:=Result+'b' else
   if IsMode(mode,STAT_IFCHR) then Result:=Result+'c' else Result:=Result+'-';
   // user permissions
   if IsMode(mode,STAT_IRUsr) then Result:=Result+'r' else Result:=Result+'-';
   if IsMode(mode,STAT_IWUsr) then Result:=Result+'w' else Result:=Result+'-';
   if IsMode(mode,STAT_IXUsr) then Result:=Result+'x' else Result:=Result+'-';
   // group permissions
   if IsMode(mode,STAT_IRGRP) then Result:=Result+'r' else Result:=Result+'-';
   if IsMode(mode,STAT_IWGRP) then Result:=Result+'w' else Result:=Result+'-';
   if IsMode(mode,STAT_IXGRP) then Result:=Result+'x' else Result:=Result+'-';
   // other permissions
   if IsMode(mode,STAT_IROTH) then Result:=Result+'r' else Result:=Result+'-';
   if IsMode(mode,STAT_IWOTH) then Result:=Result+'w' else Result:=Result+'-';
   if IsMode(mode,STAT_IXOTH) then Result:=Result+'x' else Result:=Result+'-';
  end;
  {$ELSE}
  FakeNop(aFileName);
  {$ENDIF ~UNIX}
 end;
end;

function GetFileOwnerAsString(const aFileName:LongString; AsDigits:Boolean=False):LongString;
{$IFDEF UNIX}var info:stat;{$ENDIF ~UNIX}
begin
 Result:='';
 if IsUnix then begin
  {$IFDEF UNIX}
  info:=Default(stat);
  if (FpStat(aFileName,info)=0) then begin
   if AsDigits
   then Result:=IntToStr(info.st_uid)+':'+IntToStr(info.st_gid)
   else Result:=GetUserName(info.st_uid)+':'+GetGroupName(info.st_gid);
  end;
  {$ELSE}
  FakeNop(aFileName);
  FakeNop(AsDigits);
  {$ENDIF ~UNIX}
 end;
end;

function ListAllFilePropertiesKeys:LongString;
begin
 Result:='Exists,Permissions,Owners,'
        +'IsExecutable,IsSymLink,IsHardLink,IsReadable,IsWritable,'
        +'Size,Attr,Time,FileExt,DirName,BaseName,FileName,RealPath';
end;

function GetFilePropertiesAsText(const FileName:LongString;
                                 const Properties:LongString=''):LongString;
var i:Integer; key,perm,owns:LongString;
 function GetPerm(const fname:LongString; out perm:LongString):Boolean;
 begin
  perm:=GetFilePermissionsAsString(fname);
  Result:=(perm<>'');
 end;
 function GetOwns(const fname:LongString; out owns:LongString):Boolean;
 begin
  owns:=Trim(GetFileOwnerAsString(fname,False)+' '+GetFileOwnerAsString(fname,True));
  Result:=(owns<>'');
 end;
begin
 Result:=''; perm:=''; owns:='';
 if IsEmptyStr(Properties) then begin
  Result:=GetFilePropertiesAsText(FileName,ListAllFilePropertiesKeys);
  Exit;
 end;
 for i:=1 to WordCount(Properties,ScanSpaces) do begin
  key:=ExtractWord(i,Properties,ScanSpaces); if IsEmptyStr(key) then continue;
  if SameText(key,'Exists') then Result:=Result+'Exists='+IfThen(FileExists(FileName),'1','0')+EOL else
  if SameText(key,'Permissions') and GetPerm(FileName,perm) then Result:=Result+'Permissions='+perm+EOL else
  if SameText(key,'Owners') and GetOwns(FileName,owns) then Result:=Result+'Owners='+owns+EOL else
  if SameText(key,'IsExecutable') then Result:=Result+'IsExecutable='+IfThen(FileIsExecutable(FileName),'1','0')+EOL else
  if SameText(key,'IsSymLink') then Result:=Result+'IsSymLink='+IfThen(FileIsSymLink(FileName),'1','0')+EOL else
  if SameText(key,'IsHardLink') then Result:=Result+'IsHardLink='+IfThen(FileIsHardLink(FileName),'1','0')+EOL else
  if SameText(key,'IsReadable') then Result:=Result+'IsReadable='+IfThen(FileIsReadable(FileName),'1','0')+EOL else
  if SameText(key,'IsWritable') then Result:=Result+'IsWritable='+IfThen(FileIsWritable(FileName),'1','0')+EOL else
  if SameText(key,'Size')  then Result:=Result+'Size='+IntToStr(GetFileSize(FileName))+EOL else
  if SameText(key,'Attr')  then Result:=Result+'Attr='+IntToStr(GetFileAttr(FileName))+EOL else
  if SameText(key,'Time')  then Result:=Result+'Time='+IntToStr(GetFileDate(FileName,true))+EOL else
  if SameText(key,'FileExt') then Result:=Result+'FileExt='+ExtractFileExt(FileName)+EOL else
  if SameText(key,'DirName') then Result:=Result+'DirName='+ExtractFileDir(FileName)+EOL else
  if SameText(key,'BaseName') then Result:=Result+'BaseName='+ExtractBaseName(FileName)+EOL else
  if SameText(key,'FileName') then Result:=Result+'FileName='+UnifyFileAlias(FileName)+EOL else
  if SameText(key,'RealPath') then Result:=Result+'RealPath='+GetRealFilePathName(FileName)+EOL;
 end;
end;

function GetFileAttr(const FileName:LongString):LongInt;
begin
 if IsEmptyStr(FileName) or IsWildCard(FileName)
 then Result:=-1
 else Result:=FileGetAttr(Trim(FileName));
end;

function SetFileAttr(const FileName: LongString; Attr: LongInt):Boolean;
begin
 if IsEmptyStr(FileName) or IsWildCard(FileName)
 then Result:=false
 else Result:=(FileSetAttr(Trim(FileName),Attr)=0);
end;

function GetFileSize(const FileName:LongString):Int64;
begin
 if IsEmptyStr(FileName) or IsWildCard(FileName)
 then Result:=-1
 else Result:=FileSize(Trim(FileName));
end;

function GetFileSize64(hFile:THandle):Int64;
var Pos:Int64;
begin
 Pos:=FileSeek(hFile,0,fsFromCurrent);
 Result:=FileSeek(hFile,0,fsFromEnd);
 FileSeek(hFile,Pos,fsFromBeginning);
end;

function GetFileSize64(const FileName:LongString):Int64;
begin
 if IsEmptyStr(FileName) or IsWildCard(FileName)
 then Result:=-1
 else Result:=FileSize(Trim(FileName));
end;

function GetFileDate(const FileName:LongString; ConvertToMSec:Boolean=false):Int64;
var Age:TDateTime; ms:Double;
begin
 Result:=-1;
 if IsEmptyStr(FileName) or IsWildCard(FileName)
 then Result:=-1
 else
 try
  if FileAge(Trim(FileName),Age,true) then begin
   ms:=DateTimeToMs(Age);
   if ConvertToMSec
   then Result:=Round(ms)
   else Result:=MsecToFileTime(ms);
  end;
 except
  on E:Exception do BugReport(E,nil,'GetFileDate');
 end;
end;

function FileExists(const FilePattern:LongString; Attribut:Integer=faAnyFile):Boolean;
var Found:TSearchRec;
begin
 Result:=False;
 if IsNonEmptyStr(FilePattern) then
 try
  if not IsWildCard(FilePattern)
  then Result:=SysUtils.FileExists(Trim(FilePattern))
  else
  try
   Result:=(SysUtils.FindFirst(Trim(FilePattern),Attribut,Found)=0);
  finally
   SysUtils.FindClose(Found);
  end;
 except
  on E:Exception do BugReport(E,nil,'FileExists');
 end;
end;

function DirExists(const DirName: LongString): Boolean;
begin
 if IsEmptyStr(DirName) or IsWildCard(DirName)
 then Result:=false
 else Result:=DirectoryExists(DropPathDelim(Trim(DirName)));
end;

function  FileErase(const FileName:LongString; CheckExistance:Boolean=true):Boolean;
begin
 Result:=true;
 if CheckExistance then if not FileExists(FileName) then exit;
 Result:=DeleteFile(Trim(FileName));
end;

function  FileCopy(const CopyFrom,CopyTo:LongString; FailIfExists:Boolean=false):Boolean;
var cff:TCopyFileFlags;
begin
 Result:=false;
 if IsEmptyStr(CopyFrom) or IsEmptyStr(CopyTo) then exit;
 if IsWildCard(CopyFrom) or IsWildCard(CopyTo) then exit;
 if IsSameFileName(CopyFrom,CopyTo) then exit;
 if not FileExists(CopyFrom) then exit;
 cff:=[cffPreserveTime,cffOverwriteFile];
 if FailIfExists then Exclude(cff,cffOverwriteFile);
 Result:=CopyFile(CopyFrom,CopyTo,cff,false);
end;

function  FileRename(const OldFileName,NewFileName:LongString; FailIfExists:Boolean=false):Boolean;
begin
 Result:=false;
 if IsEmptyStr(OldFileName) or IsEmptyStr(NewFileName) then exit;
 if IsWildCard(OldFileName) or IsWildCard(NewFileName) then exit;
 if IsSameFileName(OldFileName,NewFileName) then exit;
 if not FileExists(OldFileName) then exit;
 if FileExists(NewFileName) then begin
  if FailIfExists then exit;
  if not FileErase(NewFileName,false) then exit;
 end;
 Result:=SysUtils.RenameFile(Trim(OldFileName),Trim(NewFileName));
end;

function GetCurrDir: LongString;
begin
 Result:=GetCurrentDir;
end;

function SetCurrDir(const DirName: LongString): Boolean;
begin
 if not DirExists(DirName)
 then Result:=false
 else Result:=SetCurrentDir(DropPathDelim(DirName));
end;

function MkDir(const DirName: LongString): Boolean;
var i:Integer;
begin
 Result:=false;
 if IsEmptyStr(DirName) then exit;
 if IsWildCard(DirName) then exit;
 if DirExists(DirName) then begin Result:=true; exit; end;
 for i:=1 to length(DirName) do begin
  if (DirName[i]<=' ') then continue;
  if (i=length(DirName)) or (DirName[i] in DosDelimiters) then begin
   if (i<length(DirName)) and (DirName[i+1] in DosDelimiters) then continue;
   if DirExists(Copy(DirName,1,i)) then continue;
   if not CreateDir(DropBackSlash(Copy(DirName,1,i))) then exit;
  end;
 end;
 Result:=DirExists(DirName);
end;

function MkDirByFileName(const FileName:LongString):Boolean;
var dir:LongString;
begin
 Result:=false;
 if IsNonEmptyStr(FileName) then begin
  dir:=ExtractFileDir(FileName);
  if IsNonEmptyStr(dir) then begin
   if DirExists(dir)
   then Result:=true
   else Result:=MkDir(dir);
  end;
 end;
end;

function RmDir(const DirName: LongString): Boolean;
begin
 if IsEmptyStr(DirName) or IsWildCard(DirName)
 then Result:=false
 else if not DirExists(DirName)
 then Result:=true
 else Result:=RemoveDir(DropPathDelim(DirName));
end;

function ReadFileToBuffer(const FileName : LongString;
                                Buffer   : Pointer;
                                Count    : SizeInt;
                                Offset   : SizeInt = 0
                                       ) : SizeInt;
var
 hFile    : THandle;
 SeekOk   : Boolean;
begin
 Result:=-1;
 if not Assigned(Buffer) then exit;
 if (Count<=0) then exit;
 if (Offset<0) then exit;
 if IsEmptyStr(FileName) then exit;
 if IsWildCard(FileName) then exit;
 if not FileExists(FileName) then exit;
 hFile:=FileOpen(Trim(FileName),fmOpenRead or fmShareDenyNone);
 if (hFile=INVALID_HANDLE_VALUE) then exit;
 if (Offset>0)
 then SeekOk:=(FileSeek(hFile,Offset,fsFromBeginning)=Offset)
 else SeekOk:=true;
 if SeekOk then Result:=FileRead(hFile,Buffer^,Count);
 FileClose(hFile);
end;

function ReadFileToBuffer(const FileName : LongString;
                                Count    : SizeInt;
                                Offset   : SizeInt = 0
                                       ) : LongString;
var Buffer:LongString; Len:SizeInt;
begin
 Result:='';
 if FileExists(Trim(FileName)) and (Count>0) and (Offset>=0) then
 try
  Buffer:='';
  Count:=Min(Count,GetFileSize(Trim(FileName))-Offset);
  if (Count<=0) then Exit;
  SetLength(Buffer,Count);
  Len:=ReadFileToBuffer(FileName,Pointer(Buffer),Length(Buffer),Offset);
  if (Len<=0) then Exit;
  SetLength(Buffer,Len);
  Result:=Buffer;
  Buffer:='';
 except
  on E:Exception do BugReport(E,nil,'ReadFileToBuffer');
 end;
end;

function StringFromFile(const FileName:LongString; MaxSize:SizeInt):LongString;
var F:THandle; nRead,nSize:SizeInt; Buff:LongString;
const BuffSize=1024*32;
begin
 Result := '';
 try
  if IsEmptyStr(FileName) then Exit;
  if not FileExists(Trim(FileName)) then Exit;
  F:=FileOpen(Trim(FileName),fmOpenRead or fmShareDenyNone);
  if (F<>INVALID_HANDLE_VALUE) then
  try
   if (MaxSize<=0) then begin // Unknown size
    Buff:=StringBuffer(BuffSize);
    repeat
     nRead:=FileRead(F,Buff[1],Length(Buff));
     if (nRead>0) then Result:=Result+Copy(Buff,1,nRead);
    until (nRead<=0);
   end else begin
    nSize:=EnsureRange(GetFileSize(FileName),0,MaxSize);
    if (nSize>0) then begin
     Result:=StringBuffer(nSize);
     nRead:=FileRead(F,Result[1],Length(Result));
     SetLength(Result,Max(0,nRead));
    end;
   end;
  finally
   FileClose(F);
   Buff:='';
  end;
 except
  on E:Exception do BugReport(E,nil,'StringFromFile');
 end;
end;

function WriteBufferToFile(const FileName     : LongString;
                                 Buffer       : Pointer;
                                 Count        : SizeInt;
                                 Offset       : SizeInt = 0;
                                 FLAGS        : DWORD = OPEN_ALWAYS
                                            ) : SizeInt;
var
 hFile    : THandle;
 SeekOk   : Boolean;
begin
 Result:=-1;
 if not Assigned(Buffer) then exit;
 if (Count<=0) then exit;
 if (Offset<0) then exit;
 if IsEmptyStr(FileName) then exit;
 if IsWildCard(FileName) then exit;
 hFile:=INVALID_HANDLE_VALUE;
 case FLAGS of
  CREATE_NEW    : if FileExists(Trim(FileName))
                  then hFile:=INVALID_HANDLE_VALUE
                  else hFile:=FileCreate(Trim(FileName));
  CREATE_ALWAYS : hFile:=FileCreate(Trim(FileName));
  TRUNCATE_EXISTING,
  OPEN_EXISTING : if FileExists(Trim(FileName))
                  then hFile:=FileOpen(Trim(FileName),fmOpenWrite)
                  else hFile:=INVALID_HANDLE_VALUE;
  OPEN_ALWAYS   : if FileExists(Trim(FileName))
                  then hFile:=FileOpen(Trim(FileName),fmOpenWrite)
                  else hFile:=FileCreate(Trim(FileName));
  else hFile:=INVALID_HANDLE_VALUE;
 end;
 if (hFile=INVALID_HANDLE_VALUE) then exit;
 if (FLAGS=TRUNCATE_EXISTING) then FileTruncate(hFile,0);
 if (Offset>0)
 then SeekOk:=(FileSeek(hFile,Offset,fsFromBeginning)=Offset)
 else SeekOk:=true;
 if SeekOk then Result:=FileWrite(hFile,Buffer^,Count);
 FileClose(hFile);
end;

function WriteBufferToFile(const FileName     : LongString;
                                 Buffer       : LongString;
                                 Offset       : SizeInt = 0;
                                 FLAGS        : DWORD = OPEN_ALWAYS
                                            ) : SizeInt;
begin
 Result:=WriteBufferToFile(FileName,Pointer(Buffer),Length(Buffer),Offset,FLAGS);
end;

function AnyFileMask:LongString;
begin
 if IsWindows then Result:='*.*' else Result:='*';
end;

function FindAllFilesAsText(const SearchPath:LongString;
                            const SearchMask:LongString='';
                                  SearchSubDirs:Boolean=True;
                                  DirAttr:Word=faDirectory;
                                  MaskSeparator:Char=';';
                                  PathSeparator:Char=';'
                            ):LongString;
var List:TStringList;
begin
 Result:='';
 if (SearchPath<>'') then
 try
  List:=FindAllFiles(SearchPath,SearchMask,SearchSubDirs,
                     DirAttr,MaskSeparator,PathSeparator);
  try
   Result:=List.Text;
  finally
   Kill(List);
  end;
 except
  on E:Exception do BugReport(E,nil,'FindAllFilesAsText');
 end;
end;

procedure ForEachFile(const RootDir         : LongString;
                      const FilePatterns    : LongString;
                            FileAction      : TForEachFileAction;
                            MaxSubDirLevels : Integer = 0;
                            CustomData      : Pointer = nil;
                      const Delimiters      : TCharSet = DefaultFilePatternDelimiters
                     );
var
 i          : Integer;
 Terminated : Boolean;
 {
 Recursive file iterator
 }
 procedure ForEachFileDo(const ThePath,TheMask:LongString; SubDirLevel:Integer);
 var
  Found       : TSearchRec;
  FindResult  : Integer;
 begin
  {
  Make action for each files in current directory, exclude subrirectories.
  }
  if (SubDirLevel<=MaxSubDirLevels) and not Terminated then
  try
   FindResult:=SysUtils.FindFirst(AddPathDelim(ThePath)+TheMask,(faAnyFile and not faDirectory),Found);
   while (FindResult=0) do begin
    if ((Found.Attr and faDirectory)=0) then begin
     FileAction(AddPathDelim(ThePath)+Found.Name,Found,SubDirLevel,Terminated,CustomData);
     if Terminated then Break;
    end;
    FindResult:=SysUtils.FindNext(Found);
   end;
  finally
   SysUtils.FindClose(Found);
  end;
  {
  Make action and call himself recursively for each subrirectories.
  Pass special directories such as ".", ".." & etc.
  }
  if (SubDirLevel<MaxSubDirLevels) and not Terminated then
  try
   FindResult:=SysUtils.FindFirst(AddPathDelim(ThePath)+AnyFileMask,faDirectory,Found);
   while (FindResult=0) do begin
    if ( Found.Attr and faDirectory <> 0 ) and
       ( Found.Name <> '.'   ) and
       ( Found.Name <> '..'  ) and
       ( Found.Name <> '...' ) and
       ( Found.Name <> '//'  )
    then begin
     FileAction(AddPathDelim(ThePath)+Found.Name,Found,SubDirLevel,Terminated,CustomData);
     if Terminated then break;
     ForEachFileDo(AddPathDelim(ThePath)+Found.Name,TheMask,SubDirLevel+1);
    end;
    FindResult:=SysUtils.FindNext(Found);
   end;
  finally
   SysUtils.FindClose(Found);
  end;
 end;
begin
 Terminated:=false;
 if Assigned(FileAction) and (MaxSubDirLevels>=0) then
 for i:=1 to WordCount(FilePatterns,Delimiters) do
 try
  ForEachFileDo(Trim(RootDir),Trim(ExtractWord(i,FilePatterns,Delimiters)),0);
 except
  on E:Exception do BugReport(E,nil,'ForEachFile');
 end; 
end;

function ForEachTextLine(const FileName   : LongString;
                               Action     : TForEachTextLineAction;
                               CustomData : Pointer = nil;
                               BuffSize   : Integer = 0 ):Integer;
var
 F         : System.Text;
 IORes1    : Integer;
 IORes2    : Integer;
 Count     : LongInt;
 Terminate : Boolean;
 Line      : LongString;
 Buff      : Pointer;
begin
 Result:=-1;
 if FileExists(FileName) and Assigned(Action) then
 try
  Count:=0;
  Terminate:=false;
  IORes1:=IOResult;
  System.Assign(F,FileName);
  BuffSize:=EnsureRange(BuffSize,0,MaxTextBufSize);
  if (BuffSize>System.TextRecBufSize) then begin
   Buff:=Allocate(BuffSize);
   if (AllocSize(Buff)>0) then
   SetTextBuf(F,Buff^,AllocSize(Buff));
  end else Buff:=nil;
  System.Reset(F);
  try
   IORes2:=IOResult;
   while not ( Terminate or (IORes2<>0) or System.Eof(F) ) do begin
    readln(F,Line);
    IORes2:=IOResult;
    if (IORes2=0) then Action(FileName, Line, Count, Terminate, CustomData);
    inc(Count);
   end;
   SetInOutRes(IORes2);
  finally
   System.Close(F);
   Deallocate(Buff);
   Result:=IOResult;
   SetInOutRes(IORes1);
  end;
 except
  on E:Exception do BugReport(E,nil,'ForEachTextLine');
 end;
end;

 {
 *****************
 Debug file output
 *****************
 }
var
 DebugOutFifo : packed array[Byte] of TFifo;
 DebugOutPoll : packed array[Byte] of TPolling;
 DebugOutBuff : packed array[Byte] of LongString;
 DebugOutTick : packed array[Byte] of Cardinal;

procedure DebugOutPollAction(aPolling:TPolling; var Terminate:Boolean);
 procedure FlushFifo(Fifo:TFifo);
 var F:Text; s:LongString; n:Byte; Len:SizeInt; FBuff:LongString;
 begin
  if (Fifo.Count>0) then
  try
   s:=Fifo.Name;
   if (DebugOutFileLimit>0) then
   if (GetFileSize(s)>DebugOutFileLimit) then FileRename(s,s+'.old');
   SetInOutRes(0);
   System.Assign(F,s);
   try
    n:=aPolling.LinkHandle[0];
    if FileExists(s) then System.Append(F) else System.Rewrite(F);
    if InRange(n,Low(DebugOutBuff),High(DebugOutBuff)) then begin
     FBuff:=DebugOutBuff[n];
     if (FBuff<>'') then begin
      Len:=Length(FBuff);
      if (Len>SizeOf(TextRec(F).buffer))
      then SetTextBuf(F,PChar(FBuff)^,Len);
     end;
    end;
    while (Fifo.Count>0) do begin
     s:=Fifo.GetText; if (s<>'') then System.Write(F,s);
     if (IOResult<>0) then Fifo.Lost:=Fifo.Lost+Length(s);
    end;
    System.Flush(F);
   finally
    SmartFileClose(F);
    SetInOutRes(0);
   end;
  except
   on E:Exception do BugReport(E,nil,'DebugOutPollAction');
  end;
 end;
begin
 if aPolling.LinkObject is TFifo
 then FlushFifo(aPolling.LinkObject as TFifo)
 else Terminate:=true;
end;

procedure InitDebugOut;
var i:Byte;
begin
 SafeFillChar(DebugOutFifo, SizeOf(DebugOutFifo), 0);
 SafeFillChar(DebugOutPoll, SizeOf(DebugOutPoll), 0);
 SafeFillChar(DebugOutTick, SizeOf(DebugOutTick), 0);
 for i:=Low(DebugOutBuff) to High(DebugOutBuff) do DebugOutBuff[i]:='';
end;

procedure DoneDebugOut;
var n:Byte;
begin
 for n:=Low(DebugOutFifo) to High(DebugOutFifo) do DebugOutOpenFile(n,'');
end;

procedure DebugOutCheckAwake(n:Byte; dT:Cardinal);
begin
 // Awake DebugOutPoll thread if Fifo is half-full
 if ((GetTickCount-DebugOutTick[n])>dT) then begin
  if (DebugOutFifo[n].Space<DebugOutFifo[n].Count)
  then DebugOutPoll[n].Awake;
  DebugOutTick[n]:=GetTickCount;
 end;
end;

procedure DebugOut(n:Byte; const S:LongString);
begin
 DebugOutText(n,S);
end;

procedure DebugOutLine(n:Byte; const S:LongString);
begin
 if DebugOutFifo[n].PutText(S+EOL)
 then DebugOutPoll[n].Awake
 else DebugOutFifo[n].Lost:=DebugOutFifo[n].Lost+Length(S)+Length(EOL);
end;

function DebugOutIter(n:SizeInt; Line:LongString; Custom:Pointer):Boolean;
begin
 Result:=true;
 if Assigned(Custom)
 then DebugOutLine(Byte(Custom^),Line)
 else Result:=false;
end;

procedure DebugOutText(n:Byte; const S:LongString);
begin
 if (S='') then Exit;
 if DebugOutFifo[n].Ok then
 try
  ForEachStringLine(S,DebugOutIter,@n);
  DebugOutCheckAwake(n,DebugOutCheckAwakePeriod);
 except
  on E:Exception do BugReport(E,nil,'DebugOutText');
 end;
end;

function DebugOutGetFile(n:Byte):LongString;
begin
 Result:=DebugOutFifo[n].Name;
end;

function  DebugOutGetErrors(n:Byte):Int64;
begin
 if Assigned(DebugOutFifo[n]) then Result:=DebugOutFifo[n].Lost else Result:=-1;
end;

procedure DebugOutSetFifo(n              : Byte;
                          FifoSize       : Integer;
                          FifoGrowFactor : Integer;
                          FifoGrowLimit  : Integer);
begin
 if DebugOutFifo[n].Ok then with DebugOutFifo[n] do
 try
  Lock;
  try
   if (Count<=FifoSize) then Size:=FifoSize;
   if (GrowFactor<>FifoGrowFactor) then GrowFactor:=FifoGrowFactor;
   if (GrowLimit<>FifoGrowLimit) then GrowLimit:=FifoGrowLimit;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,nil,'DebugOutSetFifo');
 end;
end;

procedure DebugOutOpenFile(n           : Byte;
                     const FileName    : LongString;
                           FifoSize    : Integer = 1024*64;
                           FlushPeriod : Integer = 0;
                           CreateNew   : Boolean = true;
                           Hello       : Boolean = false);
var
 aDelay    : Integer;
 aPriority : TThreadPriority;
begin
 Kill(DebugOutPoll[n]);
 Kill(DebugOutFifo[n]);
 DebugOutBuff[n]:='';
 if IsNonEmptyStr(FileName) then
 try
  DebugOutFifo[n]:=NewFifo(FifoSize,UnifyFileAlias(FileName));
  DebugOutFifo[n].Master:=@DebugOutFifo[n];
  DebugOutFifo[n].GrowLimit:=DebugOutFifoGrowLimit;
  DebugOutFifo[n].GrowFactor:=DebugOutFifoGrowFactor;
  if (DebugOutFifo[n].Size>0) then begin
   if CreateNew then FileErase(DebugOutFifo[n].Name);
   if Hello then begin
    DebugOut(n,'');
    DebugOut(n,'Debug file of program '+ProgName+'.');
    DebugOut(n,'File creation time is '+GetDateStr(msecnow)+'-'+GetTimeStr(msecnow)+'.');
    DebugOut(n,'');
   end;
   aDelay:=50; aPriority:=tpNormal;
   if not ReadIniFilePolling(SysIniFile,'[System]','DebugOutPolling',aDelay,aPriority) then begin
    aDelay:=50;
    aPriority:=tpNormal;
   end;
   if (FlushPeriod>0) then aDelay:=FlushPeriod;
   DebugOutPoll[n]:=NewPolling(DebugOutPollAction, aDelay, aPriority, false, Format('System.DebugOut[%d]',[n]));
   DebugOutPoll[n].Master:=@DebugOutPoll[n];
   DebugOutPoll[n].LinkObject:=DebugOutFifo[n];
   DebugOutPoll[n].Enabled:=true;
   DebugOutPoll[n].LinkHandle[0]:=n;
   DebugOutBuff[n]:=StringBuffer(KiloByte*48);
  end;
 except
  on E:Exception do BugReport(E,nil,'DebugOutOpenFile');
 end;
end;

 {
 **************************************
 Функции чтения конфигурационных файлов
 **************************************
 }

 {
 Функция определяет, является ли строка заголовком секции по признакам
 1) Часть строки от символа ";" до конца строки считается комментарием и
    не принимается в расчет
 2) Первый символ, отличный от пробелов - "["
 3) Последний символ, отличный от пробелов - "]"
 4) В строке нет более одного символа "[" и одного символа "]"
 5) Символ "[" предшествует сиволу "]"
 Возвращает заголовок секции в строке Title
 Заголовок Title приведен к верхнему регистру
 }
function ExtractSectionTitle(const Line:LongString; out Title:LongString):Boolean;
var i,start,stops:SizeInt;
begin
 Result:=false;
 Title:='';
 start:=0;
 stops:=0;
 for i:=1 to length(Line) do
 case Line[i] of
  '[': if (start>0) then exit else start:=i;          {не более одного "["}
  ']': if (stops>0) then exit else stops:=i;          {не более одного "]"}
  ' ': ;                                              {пробел игнорируем}
  #9 : ;                                              {пробел игнорируем}
  else begin                                          {непробельные символы}
   if (Line[i] in esComments) then break;             {начало комментария}
   if (start=0) then exit;                            {есть символы до "["}
   if (stops>0) then exit;                            {есть символы после "]"}
  end;
 end;
 if (start=0) then exit;                              {не найден "["}
 if (stops=0) then exit;                              {не найден "]"}
 if (stops<=start) then exit;                         {неверный порядок}
 Title:=UnifyAlias(Copy(Line,start,stops-start+1));   {выделение заголовка}
 Title:=UpCaseStr(Title);                             {в верхний регистр}
 Result:=true;
end;

 {
 Объект реализует секцию как поименованный текст TheText без каких-либо
 модификаций и хранит результат последнего выделения секции HotText, так как
 способ чтения секций может отличаться флагами
 }
type
 TSection = class(TMasterObject) // реализует секцию конфигурационного файла
 private
  myFName   : LongString;
  myTitle   : LongString;        // заголовок секции
  myTheText : TText;             // текст секции "как есть"
  myHotText : THashList;         // текст секции с учетом флагов
 public
  constructor Create(const TheFile,TheTitle:LongString; aHasher:THash32Function);
  destructor  Destroy; override;
  function    Title:LongString;
  function    TheText:TText;
  function    MemUsed:Integer;
  function    Extract(TheFlags:Cardinal):LongString;
 end;

constructor TSection.Create(const TheFile,TheTitle:LongString; aHasher:THash32Function);
begin
 inherited Create;
 myFName:=TheFile;
 myTitle:=TheTitle;
 myTheText:=NewText;
 myHotText:=NewHashList(true,aHasher);
end;

destructor TSection.Destroy;
begin
 myFName:='';
 myTitle:='';
 Kill(myHotText);
 Kill(myTheText);
 inherited Destroy;
end;

function TSection.Title:LongString;
begin
 if Assigned(Self) then Result:=myTitle else Result:='';
end;

function TSection.TheText:TText;
begin
 if Assigned(Self) then Result:=myTheText else Result:=nil;
end;

function TSection.MemUsed:Integer;
begin
 Result:=0;
 if Assigned(Self) then begin
  inc(Result,InstanceSize);
  inc(Result,Length(myTitle));
  inc(Result,myTheText.MemUsed);
  inc(Result,myHotText.MemUsed);
  inc(Result,myTheText.InstanceSize);
  inc(Result,myHotText.InstanceSize);
 end;
end;

function SectionExtractByFlags(Dest,Source:TText; Flags:Cardinal):TText;
var Line,i:Integer; s:LongString;
begin
 Result:=Dest;
 if Assigned(Source) then
 if Assigned(Result) then begin
  Result.Count:=0;
  for Line:=0 to Source.Count-1 do begin
   s:=Source[Line];
   if (s<>'') then begin
    {удаление комментариев}
    if ((Flags and efDelCom)<>0) then
    for i:=1 to length(s) do if (s[i] in esComments) then begin
     System.Delete(s,i,length(s)-i+1);
     break;
    end;
    {удаление пробелов}
    case Flags and (efLTrim+efRTrim) of
     efLTrim         : s:=TrimLead(s);
     efRTrim         : s:=TrimTrail(s);
     efLTrim+efRTrim : s:=Trim(s);
    end;
    {регистровые преобразования}
    case Flags and (efUpCase+efLoCase) of
     efUpCase:s:=UpCaseStr(s);
     efLoCase:s:=LoCaseStr(s);
    end;
   end;
   Result.Addln(s);
  end;
 end;
end;

function TSection.Extract(TheFlags:Cardinal):LongString;
var key:LongString; Temp:TText; i:Integer;
begin
 Result:='';
 if Assigned(Self) then begin
  key:=IntToStr(TheFlags);
  i:=myHotText.IndexOf(key);
  if (i>=0) then Result:=myHotText.Params[i] else begin
   Temp:=SectionExtractByFlags(NewText,TheText,TheFlags);
   try
    myHotText.KeyedParams[key]:=Temp.Text;
    if DebugLogEnabled(dlc_CfgCache)
    then DebugLog(dlc_CfgCache,Format('Exract %s %s %d',[myFName,myTitle,TheFlags]));
   finally
    Kill(Temp);
   end;
   Result:=myHotText.KeyedParams[key];
  end;
 end;
end;

 {
 Объект реализует список секций - или образ конфигурационного файла в памяти
 Так как конфигурационный файл есть на диске и может быть модифицирован,
 хранятся также его атрибуты, чтобы при изменении файла перегрузить его образ
 }
type
 ESectionList=class(EFailException);
 TSectionList=class(TMasterObject)
 private
  myName    : LongString;
  myList    : THashList;
  myTick    : Cardinal;
  myAttr    : LongInt;
  mySize    : Int64;
  myDate    : Int64;
  function    GetCount:Integer;
  function    GetSection(i:Integer):TSection;
  function    ReadSections:Boolean;
 public
  constructor Create(const FileName:LongString; aHasher:THash32Function);
  destructor  Destroy; override;
  property    Count:Integer read GetCount;
  property    Section[i:LongInt]:TSection read GetSection;
  function    FindSection(const s:LongString):TSection;
  function    JustSection(const s:LongString):TSection;
  function    Changed:Boolean;
  function    MemUsed:Integer;
 end;

constructor TSectionList.Create(const FileName:LongString; aHasher:THash32Function);
begin
 inherited Create;
 myName:=UnifyFileAlias(FileName);
 myList:=NewHashList(false,aHasher);
 myList.OwnsObjects:=true;
 ReadSections;
end;

destructor TSectionList.Destroy;
begin
 myName:='';
 Kill(myList);
 inherited Destroy;
end;

function TSectionList.GetCount:LongInt;
begin
 if Assigned(Self) then Result:=myList.Count else Result:=0;
end;

function TSectionList.GetSection(i:LongInt):TSection;
begin
 if Assigned(Self) then Result:=TSection(myList.Objects[i]) else Result:=nil;
end;

// On Unix systems it's faster to get Attr,Size,Time in single FpStat() call.
procedure GetFileParams(const FileName:LongString; out Attr:LongInt; out Size:Int64; out Time:Int64);
{$IFDEF UNIX}var Info:Stat; SystemFileName:LongString;{$ENDIF}
begin
Attr:=-1; Size:=-1; Time:=-1;
if (FileName<>'') then
try
 {$IFDEF UNIX}
 Info:=Default(Stat);
 SystemFileName:=ToSingleByteFileSystemEncodedFileName(FileName);
 if (FpStat(PChar(SystemFileName),Info)>=0) then begin
  Time:=Info.st_mtime;
  Size:=Info.st_size;
  Attr:=Info.st_mode;
 end;
 Exit;
 {$ENDIF}
 Attr:=GetFileAttr(FileName);
 if (Attr<>-1) then begin
  Size:=GetFileSize(FileName);
  Time:=GetFileDate(FileName);
 end;
except
 on E:Exception do BugReport(E,nil,'GetFileParams');
end;
end;

type
 TSectionScanRec = packed record
  SectionList : TSectionList;
  CurrSection : TSection;
 end;

procedure ScanSection(const FileName,Line:LongString; Count:SizeInt;
                        var Terminate:Boolean; CustomData:Pointer);
var SectionTitle:LongString;
begin
 with TSectionScanRec(CustomData^) do begin
  if Assigned(CurrSection) then begin
   if ExtractSectionTitle(Line,SectionTitle)
   then CurrSection:=SectionList.JustSection(SectionTitle)
   else CurrSection.TheText.Addln(Line);
  end else Terminate:=true;
 end;
end;

function TSectionList.ReadSections:Boolean;
var ScanRec:TSectionScanRec; IORes:Integer;
const BuffSize = 1024*64;
begin
 Result:=false;
 if Assigned(Self) then
 try
  myList.Clear;
  GetFileParams(myName,myAttr,mySize,myDate);
  myTick:=GetTickCount;
  if (myAttr<>-1) then begin
   ScanRec.SectionList:=Self;
   ScanRec.CurrSection:=JustSection('[]');
   IORes:=ForEachTextLine(myName,ScanSection,@ScanRec,BuffSize);
   if (IORes<>0) or (ScanRec.CurrSection=nil) then RAISE ESectionList.Create('Fail read : '+myName);
   Result:=true;
  end;
 except
  on E:Exception do begin BugReport(E,Self,'ReadSections'); myList.Clear; end;
 end;
end;
 
function TSectionList.FindSection(const s:LongString):TSection;
var key:LongString;
begin
 Result:=nil;
 if Assigned(Self) then begin
  key:=UnifyAlias(s);
  if (key<>'') then Result:=TSection(myList.KeyedObjects[key]);
 end;
end;

function TSectionList.JustSection(const s:LongString):TSection;
var key:LongString;
begin
 Result:=nil;
 if Assigned(Self) then
 try
  key:=UnifyAlias(s);
  if (key<>'') then begin
   Result:=TSection(myList.KeyedObjects[key]);
   if not Assigned(Result) then begin
    myList.KeyedObjects[key]:=TSection.Create(myName,key,myList.Hasher);
    Result:=TSection(myList.KeyedObjects[key]);
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'JustSection');
 end;
end;

function TSectionList.Changed:Boolean;
var aAttr:LongInt; aSize,aDate:Int64; aTick:Cardinal;
begin
 Result:=false;
 if Assigned(Self) then begin
  aTick:=GetTickCount;
  if (aTick-myTick>=ConfigCacheHoldingTime) then begin
   myTick:=aTick; GetFileParams(myName,aAttr,aSize,aDate);
   Result:=(mySize<>aSize) or (myDate<>aDate) or (myAttr<>aAttr);
   //Result:=Result or (aSize=-1) or (aAttr=-1) or (aDate=-1);
  end;
 end;
end;

function SectionMemUsed(aObject:TObject):Integer;
begin
 Result:=0;
 if (aObject is TObject) then inc(Result,aObject.InstanceSize);
 if (aObject is TSection) then inc(Result,TSection(aObject).MemUsed);
end;

function TSectionList.MemUsed:LongInt;
begin
 Result:=0;
 if Assigned(Self) then begin
  inc(Result,myList.InstanceSize);
  inc(Result,myList.MemUsed(SectionMemUsed));
 end;
end;

 {
 Реализует список файлов конфигурации, причем файлы хранятся в кэш-буферах
 для ускорения загрузок
 }
type
 TConfigFileList=class(TMasterObject)
 private
  myList    : THashList;   // List of config files cached - 2-nd level cache
  myCache   : THashList;   // Cache of sections           - 1-st level cache
  function    GetCount:Integer;
  function    GetSectionList(i:Integer):TSectionList;
 public
  constructor Create(aHasher:THash32Function);
  destructor  Destroy; override;
  property    Count:Integer read GetCount;
  property    SectionList[i:Integer]:TSectionList read GetSectionList;
  function    FindSectionList(const FileName:LongString):TSectionList;
  function    JustSectionList(const FileName:LongString):TSectionList;
  procedure   FreeCache(MaxSize:Integer);
  function    MemUsed:Integer;
  function    GetSectionCache(const key:LongString; var Param:LongString; Tick,HoldTime:Cardinal):Boolean;
  function    SetSectionCache(const key:LongString; const Param:LongString; Tick:Cardinal):Boolean;
  function    Shapshot(mode:Integer):LongString;
 end;

constructor TConfigFileList.Create(aHasher:THash32Function);
begin
 inherited Create;
 myList:=NewHashList(false,aHasher);
 myList.OwnsObjects:=true;
 myCache:=NewHashList(false,aHasher);
end;

destructor TConfigFileList.Destroy;
begin
 Kill(myList);
 Kill(myCache);
 inherited Destroy;
end;

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

function TConfigFileList.GetSectionList(i:Integer):TSectionList;
begin
 if Assigned(Self) then Result:=TSectionList(myList.Objects[i]) else Result:=nil;
end;

function TConfigFileList.FindSectionList(const FileName:LongString):TSectionList;
var key:LongString;
begin
 Result:=nil;
 if Assigned(Self) then begin
  key:=UnifyFileAlias(FileName);
  if (key<>'') then Result:=TSectionList(myList.KeyedObjects[key]);
 end;
end;

function TConfigFileList.JustSectionList(const FileName:LongString):TSectionList;
var key:LongString;
begin
 Result:=nil;
 if Assigned(Self) then
 try
  key:=UnifyFileAlias(FileName);
  if (key<>'') then begin
   Result:=TSectionList(myList.KeyedObjects[key]);
   if Assigned(Result) then begin
    if Result.Changed
    then Result.ReadSections;
   end else begin
    if FileExists(key) then begin
     myList.KeyedObjects[key]:=TSectionList.Create(key,myList.Hasher);
     Result:=TSectionList(myList.KeyedObjects[key]);
    end;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'JustSectionList');
 end;
end;

function SectionListMemUsed(aObject:TObject):Integer;
begin
 Result:=0;
 if (aObject is TObject) then inc(Result,aObject.InstanceSize);
 if (aObject is TSectionList) then inc(Result,TSectionList(aObject).MemUsed);
end;

function TConfigFileList.MemUsed:Integer;
begin
 Result:=0;
 if Assigned(Self) then begin
  inc(Result,myList.MemUsed(SectionListMemUsed));
  inc(Result,myCache.MemUsed);
 end;
end;

procedure TConfigFileList.FreeCache(MaxSize:Integer);
var Iter,maxIter,Limit:Integer;
begin
 if Assigned(Self) then
 try
  if (MaxSize<=0) then myList.Clear else begin
   Iter:=0; maxIter:=myList.Count; Limit:=MaxSize div 2;
   while (myList.Count>0) and (Iter<maxIter) and (myList.MemUsed(SectionListMemUsed)>Limit) do begin
    myList.Delete(Random(myList.Count));
    inc(Iter);
   end;
  end;
  if (MaxSize<=0) then myCache.Clear else begin
   Iter:=0; maxIter:=myCache.Count; Limit:=MaxSize div 2;
   while (myCache.Count>0) and (Iter<maxIter) and (myCache.MemUsed>Limit) do begin
    myCache.Delete(Random(myCache.Count));
    inc(Iter);
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'FreeCache');
 end;
end;

function TConfigFileList.GetSectionCache(const key:LongString; var Param:LongString; Tick,HoldTime:Cardinal):Boolean;
var i:Integer; t:Cardinal;
begin
 Param:='';
 Result:=false;
 if (key<>'') then
 if (HoldTime<>0) then
 if Assigned(Self) then
 try
  i:=myCache.IndexOf(key);
  if (i>=0) then begin
   Integer(t):=myCache.Links[i];
   if (tick-t<HoldTime) then begin
    Param:=myCache.Params[i];
    Result:=true;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetSectionCache');
 end;
end;

function TConfigFileList.SetSectionCache(const key:LongString; const Param:LongString; Tick:Cardinal):Boolean;
begin
 Result:=false;
 if (key<>'') then
 if Assigned(Self) then
 try
  myCache.KeyedParams[key]:=Param;
  myCache.KeyedLinks[key]:=Integer(Tick);
  Result:=true;
 except
  on E:Exception do BugReport(E,Self,'SetSectionCache');
 end;
end;

function TConfigFileList.Shapshot(mode:Integer):LongString;
const Actual:array[Boolean] of PChar=('OutDated','Actual');
var Temp:TText; i,j:Integer; dt,tick:Cardinal;
begin
 Result:='';
 if Assigned(Self) then
 try
  Temp:=NewText;
  try
   tick:=GetTickCount;
   Temp.Addln(Format('%s: -> Config Cache Shapshot information:',[StdDateTimeStr(mSecNow)]));
   Temp.AddLn(Format(' Memory usage : %d byte(s)',[MemUsed]));
   Temp.AddLn(Format(' SectionCache : %d item(s), %d byte(s)',[myCache.Count,myCache.MemUsed]));
   if (mode>0) then begin
    for i:=0 to myCache.Count-1 do begin
     dt:=tick-Cardinal(myCache.Links[i]);
     Temp.AddLn(Format('  SectionCache[%d] = %s : %d byte(s), %d ms age',
               [i,StringReplace(myCache.Keys[i],EOL,' ',[rfReplaceAll]),Length(myCache.Params[i]),dt]));
     if (mode>1) then begin
      ConcatText(Temp,myCache.Params[i]);
     end;
    end;
   end;
   Temp.Addln(Format(' CfgFileCache : %d item(s), %d byte(s)',[myList.Count,myList.MemUsed(SectionListMemUsed)]));
   if (mode>0) then begin
    for i:=0 to myList.Count-1 do begin
     Temp.AddLn(Format('  CfgFileCache[%d] = %s : %d byte(s), %s',
               [i,myList.Keys[i],SectionList[i].MemUsed,Actual[not SectionList[i].Changed]]));
     if (mode>1) then begin
      for j:=0 to SectionList[i].Count-1 do begin
       Temp.Addln(SectionList[i].Section[j].Title);
       ConcatText(Temp,SectionList[i].Section[j].TheText);
      end;
     end;
    end;
   end;
   Result:=Temp.Text;
  finally
   Kill(Temp);
  end;
 except
  on E:Exception do BugReport(E,Self,'Shapshot');
 end;
end;

 {
 Рабочий экземпляр списка конфигурационных файлов
 }
const
 ConfigFileList : TConfigFileList = nil;
 ConfigLatch    : TLatch          = nil;

procedure InitConfigFiles;
begin
 try
  ConfigLatch:=NewLatch;
  ConfigLatch.Lock;
  try
   ConfigFileList:=TConfigFileList.Create(GetHasherByIndex(ConfigCacheHasherMethod));
  finally
   ConfigLatch.Unlock;
  end;
 except
  on E:Exception do BugReport(E,nil,'InitConfigFiles');
 end;
end;

procedure DoneConfigFiles;
begin
 try
  ConfigLatch.Lock;
  try
   OpenIniLogFile('');
   Kill(TObject(ConfigFileList));
  finally
   ConfigLatch.Unlock;
   Kill(ConfigLatch);
  end;
 except
  on E:Exception do BugReport(E,nil,'DoneConfigFiles');
 end;
end;

procedure ResetConfigCache;
begin
 try
  ConfigLatch.Lock;
  try
   Kill(TObject(ConfigFileList));
   ConfigFileList:=TConfigFileList.Create(GetHasherByIndex(ConfigCacheHasherMethod));
  finally
   ConfigLatch.Unlock;
  end;
 except
  on E:Exception do BugReport(E,nil,'ResetConfigCache');
 end;
end;

function ConfigCacheSnapshot(mode:Integer=0):LongString;
begin
 Result:='';
 try
  ConfigLatch.Lock;
  try
   Result:=ConfigFileList.Shapshot(mode);
  finally
   ConfigLatch.Unlock;
  end;
 except
  on E:Exception do BugReport(E,nil,'ConfigCacheSnapshot');
 end;
end;

function FreeConfigCache(MaxSize:LongInt):LongInt;
begin
 Result:=-1;
 try
  ConfigLatch.Lock;
  try
   ConfigFileList.FreeCache(MaxSize);
   Result:=ConfigFileList.MemUsed;
  finally
   ConfigLatch.Unlock;
  end;
 except
  on E:Exception do BugReport(E,nil,'FreeConfigCache');
 end;
end;

function ConfigCacheSize:LongInt;
begin
 Result:=0;
 try
  ConfigLatch.Lock;
  try
   Result:=ConfigFileList.MemUsed;
  finally
   ConfigLatch.Unlock;
  end;
 except
  on E:Exception do BugReport(E,nil,'ConfigCacheSize');
 end;
end;

procedure CheckConfigCache;
const t:Cardinal=0;
begin
 if (GetTickCount-t>ConfigCacheCheck) then begin
  FreeConfigCache(ConfigCacheLimit);
  t:=GetTickCount;
 end;
end;

type
 els_RecPtr = ^els_Rec;
 els_Rec    = record
  List                : TStringList;
  FilesDone           : THashList;
  FileName            : ShortString;
  SectionName         : ShortString;
  ExtractSectionFlags : Cardinal;
  RecursionLevel      : Cardinal;
  Iterator            : procedure ( elsptr: els_RecPtr );
  CfcMode             : Cardinal;
 end;

procedure els_LoadFile(Index:LongInt; const TextLine:LongString;
                  var Terminate:Boolean; CustomData:Pointer);
var
 i   : integer;
 els : els_Rec;
begin
 els:=els_Rec(CustomData^);
 if IsNonEmptyStr(TextLine) then begin
  if IsSameText(UnifyAlias(ExtractWord(1,TextLine,ScanSpaces)),idConfigFile) then
  for i:=2 to WordCount(TextLine,ScanSpaces) do begin
   els.FileName:=ExtractWord(i,TextLine,ScanSpaces);
   els.FileName:=AdaptFileName(els.FileName);
   els.FileName:=SmartFileRef(els.FileName,'.cfg',els_Rec(CustomData^).FileName);
   els.FileName:=UnifyFileAlias(els.FileName);
   if (els.FilesDone.IndexOf(els.FileName)<0) then begin
    inc(els.RecursionLevel);
    if (els.RecursionLevel<=ConfigFileMaxRecursionLevel) then els.Iterator(@els);
   end;
  end;
 end;
end;

procedure els_Iterator( elsptr : els_RecPtr);
var
 Config  : TSectionList;
 els     : els_Rec;
 Temp    : TText;
 Sect    : LongString;
 CFL     : LongString;
begin
 {search for config with given in els record file name}
 els:=elsptr^;
 els.FileName:=UnifyFileAlias(elsptr^.FileName);
 els.SectionName:=UnifyAlias(elsptr^.SectionName);
 Config:=ConfigFileList.JustSectionList(els.FileName);
 {notify that file done}
 if (els.FilesDone.IndexOf(els.FileName)<0) then els.FilesDone.KeyedLinks[els.FileName]:=1;
 if Assigned(Config) then begin
  {read and collect section}
  Sect:=Config.FindSection(els.SectionName).Extract(els.ExtractSectionFlags);
  if (Sect<>'') then els.List[0]:=els.List[0]+Sect;
  {read special section}
  CFL:=Config.FindSection(idConfigFileList).Extract(efConfigNC);
  if (Length(CFL)>0) then begin
   Temp:=NewText;
   try
    Temp.Text:=CFL;
    Temp.ForEach(els_LoadFile,@els);
   finally
    Kill(Temp);
   end;
  end;
 end;
end;

function ExtractListSection(const FileName            : LongString;
                            const SectionName         : LongString;
                                  ExtractSectionFlags : Cardinal) : TText;
begin
 Result:=NewText;
 try
  Result.Text:=ExtractTextSection(FileName,SectionName,ExtractSectionFlags);
 except
  on E:Exception do BugReport(E,nil,'ExtractListSection');
 end;
end;

function ExtractTextSection(const FileName            : LongString;
                            const SectionName         : LongString;
                                  ExtractSectionFlags : Cardinal ) : LongString;
var
 els : els_Rec; key:LongString; tick:Cardinal;
begin
 Result:='';
 try
  els:=Default(els_Rec);
  els.List:=TStringList.Create; els.List.Add(''); // NB!!!
  els.FilesDone:=NewHashList(false,GetHasherByIndex(ConfigCacheHasherMethod));
  els.FileName:=UnifyFileAlias(FileName);
  els.SectionName:=UnifyAlias(UpCaseStr(SectionName)); // Upcase?
  els.ExtractSectionFlags:=ExtractSectionFlags;
  els.RecursionLevel:=0;
  els.Iterator:=els_Iterator;
  if (ConfigCacheHoldingTime<>0) then begin
   key:=els.FileName+EOL+els.SectionName+EOL+IntToStr(els.ExtractSectionFlags)+EOL;
   tick:=GetTickCount;
  end else begin
   key:='';
   tick:=0;
  end;
  ConfigLatch.Lock;
  try
   if (key='') or not ConfigFileList.GetSectionCache(key,Result,tick,ConfigCacheHoldingTime) then begin
    els.Iterator(@els);
    Result:=els.List[0];
    if (key<>'') then ConfigFileList.SetSectionCache(key,Result,tick);
   end;
   CheckConfigCache;
  finally
   ConfigLatch.Unlock;
   Kill(els.FilesDone);
   Kill(els.List);
  end;
 except
  on E:Exception do BugReport(E,nil,'ExtractTextSection');
 end;
end;

function ExtractTextSectionByPrefix(const FileName    : LongString;
                                    const SectionName : LongString;
                                    const Prefix      : LongString;
                                          efMode      : Integer;
                                          svMode      : Integer;
                                          SubSections : Boolean) : LongString;
var List:TText; s:LongString; i:Integer; Buff:TParsingBuffer;
begin
 Result:='';
 try
  s:='';
  if ReadIniFileString(FileName,SectionName,Prefix+'%s',s,efMode,svMode) then begin
   List:=ExtractListSection(FileName,SectionName,efMode);
   try
    for i:=0 to List.Count-1 do
    if (ScanVarString(svMode,StrCopyBuff(Buff,List[i]),Prefix+'%s',s)<>nil) then
    if SubSections and IsSectionName(s)
    then Result:=Result+ExtractTextSection(FileName,s,efMode)
    else Result:=Result+s+EOL;
   finally
    Kill(List);
   end;
  end;
 except
  on E:Exception do BugReport(E,nil,'ExtractTextSectionByPrefix');
 end;
end;

procedure cfc_Iterator( elsptr : els_RecPtr);
var
 Config  : TSectionList;
 els     : els_Rec;
 Temp    : TText;
 i       : Integer;
 CFL     : LongString;
 procedure AddSection(Section:TSection);
 var i:Integer;
 begin
  if Assigned(Section) then
  if not IsSameText(Section.Title,idConfigFileList) then
  if (Section.TheText.Count>0) then begin
   els.List.Add(Section.Title);
   if HasFlags(els.CfcMode,2) then Exit;
   for i:=0 to Section.TheText.Count-1 do els.List.Add(Section.TheText[i]);
  end;
 end;
begin
 {search for config with given in els record file name}
 els:=elsptr^;
 els.FileName:=UnifyFileAlias(elsptr^.FileName);
 els.SectionName:=UnifyAlias(elsptr^.SectionName);
 Config:=ConfigFileList.JustSectionList(els.FileName);
 {notify that file done}
 if (els.FilesDone.IndexOf(els.FileName)<0) then els.FilesDone.KeyedLinks[els.FileName]:=1;
 if Assigned(Config) then begin
  if not HasFlags(els.CfcMode,1)
  then els.List.Add('[] ;### File: '+els.FileName);
  for i:=0 to Config.Count-1 do AddSection(Config.Section[i]);
  {read special section}
  CFL:=Config.FindSection(idConfigFileList).Extract(efConfigNC);
  if (Length(CFL)>0) then begin
   Temp:=NewText;
   try
    Temp.Text:=CFL;
    Temp.ForEach(els_LoadFile,@els);
   finally
    Kill(Temp);
   end;
  end;
 end;
end;

function ConstructFullConfig(const FileName:LongString; CfcMode:Cardinal=0):TText;
var
 els : els_Rec;
begin
 Result:=nil;
 try
  Result:=NewText;
  els:=Default(els_Rec);
  els.List:=TStringList.Create;
  els.FilesDone:=NewHashList(false,GetHasherByIndex(ConfigCacheHasherMethod));
  els.FileName:=UnifyFileAlias(FileName);
  els.SectionName:='[]';
  els.ExtractSectionFlags:=0;
  els.RecursionLevel:=0;
  els.Iterator:=cfc_Iterator;
  els.CfcMode:=CfcMode;
  ConfigLatch.Lock;
  try
   els.Iterator(@els);
   CheckConfigCache;
   Result.Text:=els.List.Text;
  finally
   ConfigLatch.Unlock;
   Kill(els.FilesDone);
   Kill(els.List);
  end;
 except
  on E:Exception do BugReport(E,nil,'ConstructFullConfig');
 end;
end;

type
 ewl_Rec = packed record
  List       : TText;
  WordIndex  : Integer;
  Delimiters : TCharSet;
 end;

procedure ewl_AddName(Index:LongInt; const TextLine:LongString;
                   var Terminate:Boolean; CustomData:Pointer);
var Name:LongString;
begin
 with ewl_Rec(CustomData^) do begin
  Name:=Trim(ExtractWord(WordIndex, TextLine, Delimiters));
  if (Name<>'') then List.AddLn(Name);
 end;
end;

function ExtractWordList(const FileName            : LongString;
                         const SectionName         : LongString;
                               ExtractSectionFlags : Cardinal;
                               WordIndex           : Cardinal;
                         const Delimiters          : TCharSet ) : TText;
var Section:TText; ewl:ewl_Rec;
begin
 Result:=nil;
 try
  ewl.List:=NewText;
  ewl.WordIndex:=WordIndex;
  ewl.Delimiters:=Delimiters;
  Section:=ExtractListSection(FileName,SectionName,ExtractSectionFlags);
  try
   Section.ForEach(ewl_AddName,@ewl);
  finally
   Kill(Section);
   Result:=ewl.List;
  end; 
 except
  on E:Exception do BugReport(E,nil,'ExtractWordList');
 end;
end;

type
 eew_Rec = record
  List   : TText;
  Prefix : ShortString;
 end;

procedure eew_Make(Index:LongInt; const TextLine:LongString;
               var Terminate:Boolean; CustomData:Pointer);
var i:integer;
begin
 with eew_Rec(CustomData^) do
 if IsNonEmptyStr(TextLine) then
 if IsSameText(UnifyAlias(ExtractWord(1,TextLine,ScanSpaces)),Prefix) then
 for i:=2 to WordCount(TextLine,ScanSpaces) do
 List.Addln(ExtractWord(i,TextLine,ScanSpaces));
end;

function ExtractEnumWordList(const IniFile             : LongString;
                             const SectionName         : LongString;
                             const Prefix              : LongString;
                                   ExtractSectionFlags : Cardinal) : TText;
var Section:TText; eew:eew_Rec;
begin
 Result:=nil;
 try
  eew.List:=NewText;
  eew.Prefix:=UnifyAlias(Prefix);
  Section:=ExtractListSection(IniFile,SectionName,ExtractSectionFlags);
  try
   Section.ForEach(eew_Make,@eew);
  finally
   Kill(Section);
   Result:=eew.List;
  end; 
 except
  on E:Exception do BugReport(E,nil,'ExtractEnumWordList');
 end;
end;

function ExtractEnumWordTextEx(const IniFile             : LongString;
                               const SectionName         : LongString;
                               const Prefix              : LongString;
                                     ExtractSectionFlags : Cardinal;
                                     UniqSortSectFlags   : Cardinal) : LongString;
var secList,uniList:TStringList; fUniq,fSect,fSort:Boolean;
 procedure Extract(aSect:LongString);
 var eList:TText; i:Integer; Line:LongString;
 begin
  aSect:=UnifySection(aSect);
  if (secList.IndexOf(aSect)<0) then begin
   secList.Add(aSect); // secList uses to avoid infinite recursion loop
   eList:=ExtractEnumWordList(IniFile,aSect,Prefix,ExtractSectionFlags);
   if Assigned(eList) then
   try
    for i:=0 to eList.Count-1 do begin
     Line:=eList[i]; // if section found, use recursion
     if fSect and IsLexeme(Line,lex_Section) then begin
      Extract(Line);
      continue;
     end;
     if fUniq and (uniList.IndexOf(Line)>=0)
     then continue; // Ignore duplicates?
     uniList.Add(Line);
    end;
   finally
    Kill(eList);
   end;
  end;
 end;
begin
 Result:='';
 try
  secList:=TStringList.Create;
  uniList:=TStringList.Create;
  try
   secList.Sorted:=True;
   secList.Duplicates:=dupIgnore;
   fUniq:=HasFlags(UniqSortSectFlags,ewUnique);
   fSort:=HasFlags(UniqSortSectFlags,ewSorted);
   fSect:=HasFlags(UniqSortSectFlags,ewSectOn);
   if fSort then begin
    uniList.Sorted:=True;
    if fUniq
    then uniList.Duplicates:=dupIgnore
    else uniList.Duplicates:=dupAccept;
   end;
   Extract(SectionName);
   if uniList.Count>0
   then Result:=uniList.Text;
  finally
   Kill(secList);
   Kill(uniList);
  end;
 except
  on E:Exception do BugReport(E,nil,'ExtractEnumWordTextEx');
 end;
end;

function ExtractEnumWordListEx(const IniFile             : LongString;
                               const SectionName         : LongString;
                               const Prefix              : LongString;
                                     ExtractSectionFlags : Cardinal;
                                     UniqSortSectFlags   : Cardinal) : TText;
begin
 Result:=NewText;
 try
  Result.Text:=ExtractEnumWordTextEx(IniFile,
                                     SectionName,
                                     Prefix,
                                     ExtractSectionFlags,
                                     UniqSortSectFlags);
 except
  on E:Exception do BugReport(E,nil,'ExtractEnumWordListEx');
 end;
end;

function ExtractListOfSections(const FileName:LongString):LongString;
var Conf:TText; List:TStringList;
begin
 Result:='';
 try
  Conf:=ConstructFullConfig(FileName,3);
  List:=TStringList.Create;
  try
   List.Sorted:=True;
   List.Duplicates:=dupIgnore;
   List.Text:=Conf.Text;
   Result:=List.Text;
  finally
   Kill(List);
   Kill(Conf);
  end;
 except
  on E:Exception do BugReport(E,nil,'ExtractListOfSections');
 end;
end;

 {
 контрольный вывод в файл отчета чтения ini-файла
 }
procedure IniFileLoggin(nLog    : Byte;
                        Success : Boolean;
                  const IniFile : LongString;
                  const Section : LongString;
                  const Format  : LongString;
                        Data    : Pointer);
var Ptr:Pointer; Fmt,Str:LongString; i,p,n:Integer;
const w=7;
begin
 if DebugOutFifo[nLog].Ok then
 try
  Ptr:=Data;
  if Success and Assigned(Data) then begin
   DebugOut(nLog,'READ : '+IniFile+', '+Section+', '+Format);
   Str:='';
   n:=WordCount(Format,ScanWordDelims);
   for i:=1 to n do begin
    Fmt:=Trim(ExtractWord(i,Format,ScanWordDelims));
    p:=Pos('%',Fmt);
    if (p>0) and (p<Length(Fmt)) then
    case LoCase(StrFetch(Fmt,p+1)) of
     'f':begin
          if (Str='') then Str:=LeftPad(' = ',w) else Str:=Str+', ';
          Str:=Str+f2s(double(Ptr^));
          Ptr:=IncPtr(Ptr,SizeOf(Double));
         end;
     'd':begin
          if (Str='') then Str:=LeftPad(' = ',w) else Str:=Str+', ';
          Str:=Str+d2s(longint(Ptr^));
          Ptr:=IncPtr(Ptr,SizeOf(LongInt));
         end;
     'i':begin
          if (Str='') then Str:=LeftPad(' = ',w) else Str:=Str+', ';
          Str:=Str+d2s(integer(Ptr^));
          Ptr:=IncPtr(Ptr,SizeOf(integer));
         end;
     'w':begin
          if (Str='') then Str:=LeftPad(' = ',w) else Str:=Str+', ';
          Str:=Str+d2s(word(Ptr^));
          Ptr:=IncPtr(Ptr,SizeOf(word));
         end;
     'b':begin
          if (Str='') then Str:=LeftPad(' = ',w) else Str:=Str+', ';
          Str:=Str+d2s(Ord(Boolean(Ptr^)));
          Ptr:=IncPtr(Ptr,SizeOf(Boolean));
         end;
     'c':begin
          if (Str='') then Str:=LeftPad(' = ',w) else Str:=Str+', ';
          Str:=Str+char(Ptr^);
          Ptr:=IncPtr(Ptr,SizeOf(char));
         end;
     's':begin
          if (Str='') then Str:=LeftPad(' = ',w) else Str:=Str+', ';
          Str:=Str+PureString(Ptr^);
          Ptr:=IncPtr(Ptr,SizeOf(PureString));
         end;
     'a':begin
          if (Str='') then Str:=LeftPad(' = ',w) else Str:=Str+', ';
          Str:=Str+PureString(Ptr^);
          Ptr:=IncPtr(Ptr,SizeOf(PureString));
         end;
    end;
   end;
   if (Length(Str)>0) then DebugOut(nLog,Str);
  end else begin
   DebugOut(nLog,'FAIL : '+IniFile+', '+Section+', '+Format);
  end;
 except
  on E:Exception do BugReport(E,nil,'IniFileLoggin');
 end;
end;

procedure OpenIniLogFile(const Path:LongString);
begin
 DebugOutOpenFile(stdfReadIniLog,Path,ReadIniLogFifoSize,ReadIniLogFifoPollPeriod,true,true);
 DebugOutSetFifo(stdfReadIniLog,ReadIniLogFifoSize,ReadIniLogFifoGrowFactor,ReadIniLogFifoGrowLimit);
end;

function ReadIniFileVariable(const FileName    : LongString;
                             const SectionName : LongString;
                             const Format      : LongString;
                               var Data;
                                   efMode      : Integer = efConfig;
                                   svMode      : Integer = svConfig
                                             ) : Boolean;
var Section,FName:LongString;
begin
 Result:=false;
 try
  Section:='';
  ConfigLatch.Lock;
  try
   FName:=UnifyFileAlias(FileName); // Need for CaseSensitive FS
   if FileExists(FName,faAnyFile and not faDirectory) then begin
    Section:=ExtractTextSection(FName,SectionName,efMode);
    if (Section<>'') then Result:=ScanVarRecord(svMode,PChar(Section),Format,Data)<>nil;
   end;
   IniFileLoggin(stdfReadIniLog,Result,FName,SectionName,Format,@Data);
  finally
   ConfigLatch.Unlock;
   Section:='';
  end;
 except
  on E:Exception do BugReport(E,nil,'ReadIniFileVariable');
 end;
end;

function ReadIniFileRecord(const FileName    : LongString;
                           const SectionName : LongString;
                           const Format      : LongString;
                             var Data;
                                 efMode      : Integer = efConfig;
                                 svMode      : Integer = svConfig
                                           ) : Boolean;
begin
 Result:=ReadIniFileVariable(FileName,SectionName,Format,Data,efMode,svMode);
end;

const
 ReadIniKeyFmtErrors:SizeInt=0;
 ReadIniKeyFmtBugs:LongString='';
 ReadIniKeyFmtMaxLen=80;

procedure KeyFmtBug(const Key,Fmt:LongString);
var Item:LongString;
begin
 Inc(ReadIniKeyFmtErrors);
 if (Length(ReadIniKeyFmtBugs)<ReadIniKeyFmtMaxLen) then begin
  Item:=' '+Key+':'+Fmt;
  if (PosI(Item,ReadIniKeyFmtBugs)=0)
  then ReadIniKeyFmtBugs:=ReadIniKeyFmtBugs+Item;
 end;
end;

function KeyFmt(const Key,Fmt:LongString):LongString;
var p:SizeInt;
begin
 p:=Pos('%',Key);
 if (p<1) then Result:=Key+Fmt else Result:=Copy(Key,1,p-1)+Fmt;
 if (p>0) and (SysUtils.StrIComp(PChar(Fmt),@Key[p])<>0) then KeyFmtBug(Key,Fmt);
end;

function ReadIniFileBoolean(const FileName    : LongString;
                            const SectionName : LongString;
                            const Key         : LongString;
                              var Data        : Boolean;
                                  efMode      : Integer = efConfig;
                                  svMode      : Integer = svConfig
                                            ) : Boolean;
begin
 Result:=ReadIniFileVariable(FileName,SectionName,KeyFmt(Key,'%b'),Data,efMode,svMode);
end;

function ReadIniFileDouble(const FileName    : LongString;
                           const SectionName : LongString;
                           const Key         : LongString;
                             var Data        : Double;
                                 efMode      : Integer = efConfig;
                                 svMode      : Integer = svConfig
                                           ) : Boolean;
begin
 Result:=ReadIniFileVariable(FileName,SectionName,KeyFmt(Key,'%f'),Data,efMode,svMode);
end;

function ReadIniFileWord(const FileName    : LongString;
                         const SectionName : LongString;
                         const Key         : LongString;
                           var Data        : Word;
                               efMode      : Integer = efConfig;
                               svMode      : Integer = svConfig
                                         ) : Boolean;
begin
 Result:=ReadIniFileVariable(FileName,SectionName,KeyFmt(Key,'%w'),Data,efMode,svMode);
end;

function ReadIniFileInteger(const FileName    : LongString;
                            const SectionName : LongString;
                            const Key         : LongString;
                              var Data        : Integer;
                                  efMode      : Integer = efConfig;
                                  svMode      : Integer = svConfig
                                            ) : Boolean;
begin
 Result:=ReadIniFileVariable(FileName,SectionName,KeyFmt(Key,'%i'),Data,efMode,svMode);
end;

function ReadIniFileLongInt(const FileName    : LongString;
                            const SectionName : LongString;
                            const Key         : LongString;
                              var Data        : LongInt;
                                  efMode      : Integer = efConfig;
                                  svMode      : Integer = svConfig
                                            ) : Boolean;
begin
 Result:=ReadIniFileVariable(FileName,SectionName,KeyFmt(Key,'%d'),Data,efMode,svMode);
end;

function ReadIniFileAlpha(const FileName    : LongString;
                          const SectionName : LongString;
                          const Key         : LongString;
                            var Data        : PureString;
                                efMode      : Integer = efConfig;
                                svMode      : Integer = svConfig
                                          ) : Boolean;
begin
 Result:=ReadIniFileVariable(FileName,SectionName,KeyFmt(Key,'%a'),Data,efMode,svMode);
end;

function ReadIniFileAlpha(const FileName    : LongString;
                          const SectionName : LongString;
                          const Key         : LongString;
                            var Data        : LongString;
                                efMode      : Integer = efConfig;
                                svMode      : Integer = svConfig
                                          ) : Boolean;
var s:PureString;
begin
 s:=Data;
 Result:=ReadIniFileVariable(FileName,SectionName,KeyFmt(Key,'%a'),s,efMode,svMode);
 if Result then Data:=s;
end;

function ReadIniFileString(const FileName    : LongString;
                           const SectionName : LongString;
                           const Key         : LongString;
                             var Data        : PureString;
                                 efMode      : Integer = efConfig;
                                 svMode      : Integer = svConfig
                                           ) : Boolean;
begin
 Result:=ReadIniFileVariable(FileName,SectionName,KeyFmt(Key,'%s'),Data,efMode,svMode);
end;

function ReadIniFileString(const FileName    : LongString;
                           const SectionName : LongString;
                           const Key         : LongString;
                             var Data        : LongString;
                                 efMode      : Integer = efConfig;
                                 svMode      : Integer = svConfig
                                           ) : Boolean;
var s:PureString;
begin
 s:=Data;
 Result:=ReadIniFileVariable(FileName,SectionName,KeyFmt(Key,'%s'),s,efMode,svMode);
 if Result then Data:=s;
end;

function ReadIniFilePath(const FileName    : LongString;
                         const SectionName : LongString;
                         const Name        : LongString;
                         const StartupPath : LongString;
                           var Path        : PureString;
                               handleUrl   : Boolean = true;
                               efMode      : Integer = efConfigFN;
                               svMode      : Integer = svConfig
                                         ) : Boolean;
begin
 if ReadIniFileAlpha(FileName,SectionName,Name+'%a',Path,efMode,svConfig) then begin
  if HasFlags(efMode,efExpEnv) and MaybeEnvStr(Path) then Path:=ExpEnv(Path);
  if HasFlags(efMode,efAdaptFN) then Path:=AdaptFileName(Path);
  Path:=UnifyFileAlias(SmartFileRef(Path,'',AddPathDelim(StartupPath)+'*.*',sfrDefUserHome,sfrDefProgHome,sfrDefBrackets,handleUrl));
  Result:=true;
 end else begin
  Path:='';
  Result:=false;
 end;
end;

function ReadIniFilePath(const FileName    : LongString;
                         const SectionName : LongString;
                         const Name        : LongString;
                         const StartupPath : LongString;
                           var Path        : LongString;
                               handleUrl   : Boolean = true;
                               efMode      : Integer = efConfigFN;
                               svMode      : Integer = svConfig
                                         ) : Boolean;
var s:PureString;
begin
 s:=Path;
 Result:=ReadIniFilePath(FileName,SectionName,Name,StartupPath,s,handleUrl,efMode,svMode);
 if Result then Path:=s;
end;

 {
 *****************************
 Special directories and files
 *****************************
 }
const
 myProgName     : LongString = '';
 myProgBaseName : LongString = '';
 myHomeDir      : LongString = '';
 myUserHomeDir  : LongString = '';
 myStartAtDir   : LongString = '';
 mySysIniFile   : LongString = '';
 myTempDir      : LongString = '';
 myCrwKitExe    : LongString = '';

function ProgName:LongString;
begin
 Result:=myProgName;
end;

function ProgBaseName:LongString;
begin
 Result:=myProgBaseName;
end;

function HomeDir(const SubDir:LongString=''):LongString;
begin
 Result:=myHomeDir;
 if (SubDir<>'') then Result:=AddPathDelim(Result)+Trim(SubDir);
end;

function UserHomeDir(const SubDir:LongString=''):LongString;
begin
 Result:=myUserHomeDir;
 if (SubDir<>'') then Result:=AddPathDelim(Result)+Trim(SubDir);
end;

function StartupPath(const SubDir:LongString=''):LongString;
begin
 Result:=myHomeDir;
 if (SubDir<>'') then Result:=AddPathDelim(Result)+Trim(SubDir);
end;

function StartAtDir(const SubDir:LongString=''):LongString;
begin
 Result:=myStartAtDir;
 if (SubDir<>'') then Result:=AddPathDelim(Result)+Trim(SubDir);
end;

function SysIniFile:LongString;
begin
 Result:=mySysIniFile;
end;

procedure GoHome;
begin
 SetCurrDir(HomeDir);
end;

function SystemRootDir:LongString;
begin
 {$IFDEF WINDOWS}Result:=WindowsDir;{$ENDIF}
 {$IFDEF UNIX}Result:='/';{$ENDIF}
end;

{$IFDEF WINDOWS}
function WindowsDir:LongString;
var Buffer:TMaxPathBuffer;
begin
 SetString(Result,Buffer,Windows.GetWindowsDirectory(Buffer, SizeOf(Buffer)));
 Result:=DropBackSlash(Result);
end;

function WindowsSystemDir:LongString;
var Buffer:TMaxPathBuffer;
begin
 SetString(Result,Buffer,Windows.GetSystemDirectory(Buffer, SizeOf(Buffer)));
 Result:=DropBackSlash(Result);
end;

function WindowsTempDir:LongString;
var Buffer:TMaxPathBuffer;
begin
 SetString(Result,Buffer,Windows.GetTempPath(SizeOf(Buffer), Buffer));
 Result:=DropBackSlash(Result);
end;
{$ENDIF WINDOWS}

{$IFDEF UNIX}
function WindowsDir:LongString;
begin
 Result:='/';
end;

function WindowsSystemDir:LongString;
begin
 Result:='/bin';
end;

function WindowsTempDir:LongString;
begin
 Result:=GlobalTempDir;
end;
{$ENDIF ~UNIX}

function GlobalTempDir(const SubDir:LongString=''):LongString;
begin
 Result:=DropPathDelim(GetTempDir(true));
 if (SubDir<>'') then Result:=AddPathDelim(Result)+Trim(SubDir);
end;

function LocalTempDir(const SubDir:LongString=''):LongString;
begin
 Result:=DropPathDelim(GetTempDir(false));
 if (SubDir<>'') then Result:=AddPathDelim(Result)+Trim(SubDir);
end;

function TempDir(const SubDir:LongString=''):LongString;
begin
 Result:=myTempDir;
 if (SubDir<>'') then Result:=AddPathDelim(Result)+Trim(SubDir);
end;

procedure SetTempDir(const Dir:LongString);
begin
 myTempDir:=UnifyFileAlias(Dir);
 if not MkDir(myTempDir) then myTempDir:=LocalTempDir;
end;

function  CreateTempFile(const Template:LongString='###.tmp'; const InDir:LongString=''):LongString;
var Dir,Prefix,Ext,tmp:LongString; h:THandle;
begin
 Result:='';
 try
  Dir:=TrimDef(InDir,TempDir);
  Ext:=ExtractFileExt(Template);
  Prefix:=ExtractFileName(Template);
  tmp:=GetTempFileName(Dir,Prefix);
  tmp:=ForceExtension(tmp,Ext);
  if not FileExists(tmp) then begin
   h:=FileCreate(tmp); // Create zero size file
   if (h<>INVALID_HANDLE_VALUE) then FileClose(h);
  end;
  Result:=tmp;
 except
  on E:Exception do BugReport(E,nil,'CreateTempFile');
 end;
end;

{$IFDEF WINDOWS}
function UserName:LongString;
var Len:DWORD; Buf:TParsingBuffer;
begin
 Result:='';
 try
  Len:=SizeOf(Buf);
  if Windows.GetUserName(Buf,Len) then Result:=StrPas(Buf);
 except
  on E:Exception do BugReport(E,nil,'UserName');
 end;
end;
{$ENDIF WINDOWS}
{$IFDEF UNIX}
function UserName:LongString;
begin
 Result:='';
 try
  Result:=GetUserName(fpgetuid);
 except
  on E:Exception do BugReport(E,nil,'UserName');
 end;
end;
{$ENDIF UNIX}

{$IFDEF WINDOWS}
function ComputerName:LongString;
var Len:DWORD; Buf:TParsingBuffer;
begin
 Result:='';
 try
  Len:=SizeOf(Buf);
  if Windows.GetComputerName(Buf,Len) then Result:=StrPas(Buf);
 except
  on E:Exception do BugReport(E,nil,'ComputerName');
 end;
end;
{$ENDIF WINDOWS}
{$IFDEF UNIX}
function ComputerName:LongString;
begin
 Result:='';
 try
  Result:=GetHostName;
 except
  on E:Exception do BugReport(E,nil,'ComputerName');
 end;
end;
{$ENDIF UNIX}

{$IFDEF WINDOWS}
function HostName(Method:Integer):LongString;
var
 WSAData  : TWSAData;
 Buffer   : TMaxPathBuffer;
 HostEnt  : PHostEnt;
begin
 Result:='';
 try
  SafeFillChar(WSAData,SizeOf(WSAData),0);
  if (WinSock.WSAStartup(MakeWord(1,1),WSAData)=ERROR_SUCCESS) then
  try
   case Method of
    0: if (WinSock.GetHostName(Buffer,SizeOf(Buffer))=ERROR_SUCCESS) then Result:=StrPas(Buffer);
    1: if (WinSock.GetHostName(Buffer,SizeOf(Buffer))=ERROR_SUCCESS) then begin
        HostEnt:=WinSock.GetHostByName(Buffer);
        if (StrPos('.',Buffer)=nil) then  // If domain name is not in host name,
        if Assigned(HostEnt) then begin // hope to get it from HostEnt.
         HostEnt:=WinSock.GetHostByAddr(HostEnt.h_addr^, SizeOf(LongInt), AF_INET);
         if Assigned(HostEnt) then StrLCopy(Buffer,HostEnt.h_name,SizeOf(Buffer)-1);
        end;
        Result:=StrPas(Buffer);
       end;
   end;
  finally
   WinSock.WSACleanup;
  end;
 except
  on E:Exception do BugReport(E,nil,'HostName');
 end;
end;
{$ENDIF WINDOWS}
{$IFDEF UNIX}
function HostName(Method:Integer):LongString;
begin
 Result:='';
 try
  case Method of
   0: Result:=GetHostName;
   1: begin
       {$PUSH} {$WARN SYMBOL_DEPRECATED OFF} Result:=GetDomainName; {$POP}
       if (Result='') or IsSameText(Result,'(none)') then Result:=GetHostName;
      end;
  end;
 except
  on E:Exception do BugReport(E,nil,'HostName');
 end;
end;
{$ENDIF UNIX}

function SearchRecValidFolder(const F:TSearchRec):Boolean;
begin
 Result:=((F.Attr and faDirectory)<>0) and
          (F.Name<>'') and (F.Name<>'.') and (F.Name<>'..');
end;

{$IFDEF WINDOWS}
function UserDomain(const aUser:LongString=''; aDef:LongString=''):LongString;
var
 CurUser,Buff:TMaxPathBuffer;
 Count1,Count2:DWORD; Sd:PSID; Snu:SID_Name_Use;
begin
 Result:=aDef;
 try
  if IsEmptyStr(aUser)
  then StrCopyBuff(CurUser,UserName)
  else StrCopyBuff(CurUser,Trim(aUser));
  Count1:=0;
  Count2:=0;
  Snu:=SIDTypeUser;
  Windows.LookUpAccountName(nil, CurUser, nil, Count1, nil, Count2, Snu);
  if (Count1>0) and (Count2>0) then begin
   Sd:=AllocMem(Count1);
   try
    if Windows.LookUpAccountName(nil, CurUser, Sd, Count1, Buff, Count2, Snu)
    then Result:=StrPas(Buff);
   finally
    FreeMem(Sd);
   end;
  end;
 except
  on E:Exception do BugReport(E,nil,'UserDomain');
 end;
end;
{$ENDIF ~WINDOWS}
{$IFDEF UNIX}
function UserDomain(const aUser:LongString=''; aDef:LongString=''):LongString;
var s:LongString;
begin
 Result:=aDef;
 try
  s:='';
  if IsEmptyStr(aUser) or SameText(aUser,UserName) then begin
   if RunCommand('hostname --domain',s) then s:=Trim(s);
   if (s<>'') then Result:=s;
  end;
 except
  on E:Exception do BugReport(E,nil,'UserDomain');
 end;
end;
{$ENDIF ~UNIX}

function col2_Iter(n:SizeInt; Line:LongString; Custom:Pointer):Boolean;
var List:TStringList; s:LongString;
begin
 Result:=true; List:=Custom;
 if (List=nil) then Exit(False);
 s:=ExtractWord(2,Line,ScanSpaces);
 if (s<>'') and (List.IndexOf(s)<0) then List.Add(s);
end;

function GetIfMacAddresses(Delim:LongString=','; Mode:Integer=0):LongString;
var Buff:LongString; List:TStringList;
begin
 Result:='';
 try
  Buff:='';
  List:=TStringList.Create;
  try
   List.Delimiter:=',';
   Buff:=GetListOfNetworkInterfaces(nim_deffast);
   ForEachStringLine(Buff,col2_Iter,List);
   Result:=List.DelimitedText;
  finally
   Kill(List);
   Buff:='';
  end;
  if (Result='') then Exit;
  if (Delim<>',') then Result:=StringReplace(Result,',',Delim,[rfReplaceAll]);
  if (Delim=EOL) then Result:=Result+EOL;
 except
  on E:Exception do BugReport(E,nil,'GetWinIfMacAddresses');
 end;
end;

function col3_Iter(n:SizeInt; Line:LongString; Custom:Pointer):Boolean;
var List:TStringList; s:LongString;
begin
 Result:=true; List:=Custom;
 if (List=nil) then Exit(False);
 s:=ExtractWord(3,Line,ScanSpaces);
 if (s<>'') and (List.IndexOf(s)<0) then List.Add(s);
end;

function GetIfIpAddresses(Delim:LongString=','; Mode:Integer=0):LongString;
var Buff:LongString; List:TStringList;
begin
 Result:='';
 try
  Buff:='';
  List:=TStringList.Create;
  try
   List.Delimiter:=',';
   Buff:=GetListOfNetworkInterfaces(nim_deffast);
   ForEachStringLine(Buff,col3_Iter,List);
   Result:=List.DelimitedText;
  finally
   Kill(List);
   Buff:='';
  end;
  if (Result='') then Exit;
  if (Delim<>',') then Result:=StringReplace(Result,',',Delim,[rfReplaceAll]);
  if (Delim=EOL) then Result:=Result+EOL;
 except
  on E:Exception do BugReport(E,nil,'GetWinIfIpAddresses');
 end;
end;

function IsLocalHostNameMachine(aHostName:LongString):Boolean;
begin
 Result:=false;
 if (aHostName='')
 or SameText(aHostName,'.')
 or SameText(aHostName,HostName)
 or SameText(aHostName,'localhost')
 or SameText(aHostName,ComputerName) then Result:=true;
end;

{$IFDEF WINDOWS}
function GetIPAddress(const aHostName:LongString=''):LongString;
var
  WSAData  : TWSAData;
  HostEnt  : PHostEnt;
  Host     : TMaxPathBuffer;
  SockAddr : TSockAddrIn;
begin
 Result := '';
 try
  SafeFillChar(WSAData,SizeOf(WSAData),0);
  if (WinSock.WSAStartup(MakeWord(1,1),WSAData)=0) then
  try
   if IsEmptyStr(aHostName)
   then StrCopyBuff(Host,HostName)
   else StrCopyBuff(Host,Trim(aHostName));
   HostEnt:=WinSock.GetHostByName(Host);
   if Assigned(HostEnt) then begin
    SockAddr.sin_addr.S_addr:=Longint(PLongint(HostEnt^.h_addr_list^)^);
    Result:=StrPas(inet_ntoa(SockAddr.sin_addr));
   end;
  finally
   WinSock.WSACleanup;
  end;
 except
  on E:Exception do BugReport(E,nil,'GetIPAddress');
 end;
end;
function GetIPAddresses(const aHostName:LongString=''; Delim:LongString=','):LongString;
begin
 Result:=GetIfIpAddresses(Delim);
end;
{$ENDIF ~WINDOWS}
{$IFDEF UNIX}
function  GetIpAddress(const aHostName:LongString=''):LongString;
begin
 Result:=ExtractWord(1,GetIpAddresses(aHostName),ScanSpaces);
end;
function  GetIpAddresses(const aHostName:LongString=''; Delim:LongString=','):LongString;
var s,nifs:LongString; i:Integer;
begin
 Result:='';
 try
  if IsLocalHostNameMachine(aHostName) then begin
   Result:=GetIfIpAddresses(Delim);
   Exit;
   // Obsolete version
   s:=''; nifs:=GetListOfNetworkInterfaces;
   for i:=1 to WordCount(nifs,EolnDelims) do begin
    s:=s+' '+ExtractWord(3,ExtractWord(i,nifs,EolnDelims),JustBlanks);
   end;
   s:=Trim(s);
   if (s='') then begin
    // Fallback solution - use `hostname -I`.
    if RunCommand('hostname -I',s) then s:=Trim(s) else s:='';
   end;
   if (s<>'') then Result:=s;
   if (Result='') then Exit;
   if (Delim<>' ') then Result:=StringReplace(Result,' ',Delim,[rfReplaceAll]);
   if (Delim=EOL) then Result:=Result+EOL;
  end;
 except
  on E:Exception do BugReport(E,nil,'GetIpAddresses');
 end;
end;
{$ENDIF ~UNIX}

{$IFDEF UNIX}
function  GetMacAddresses(const Machine:LongString=''; Delim:LongString=','; Mode:Integer=0):LongString;
var List:TStringList; SR:TSearchRec; f,s:LongString;
const netdir='/sys/class/net/';
begin
 Result:='';
 try
  if IsLocalHostNameMachine(Machine) then begin
   Result:=GetIfMacAddresses(Delim,Mode);
   Exit;
   // Obsolete version:
   if (FindFirst(netdir+'*',faDirectory,SR)<>0) then Exit;
   List:=TStringList.Create;
   try
    repeat
     if SearchRecValidFolder(SR) and
        not SameText(SR.Name,'lo') and
        not SameText(SR.Name,'DOCKER')
     then begin
      f:=netdir+SR.Name+'/address';
      s:=StringFromFile(f,0);
      s:=ExtractWord(1,s,JustSpaces);
      if (s='') then continue;
      if HasFlags(Mode,1)
      then s:=SR.Name+'='+s;
      List.Add(s);
     end;
    until (FindNext(SR)<>0);
    Result:=List.Text;
    if (Delim<>EOL) then Result:=StringReplace(Trim(Result),EOL,Delim,[rfReplaceAll]);
   finally
    List.Free;
    FindClose(SR);
   end;
  end;
 except
  on E:Exception do BugReport(E,nil,'GetMacAddresses');
 end;
end;
{$ENDIF UNIX}


{$IFDEF WINDOWS}

const
 NCBNAMSZ    = 16;  // absolute length of a net name
 MAX_LANA    = 254; // lana's in range 0 to MAX_LANA inclusive
 NRC_GOODRET = $00; // good return
 NCBASTAT    = $33; // NCB ADAPTER STATUS
 NCBRESET    = $32; // NCB RESET
 NCBENUM     = $37; // NCB ENUMERATE LANA NUMBERS

type
 PNCB = ^TNCB;
 TNCBPostProc = procedure (P:PNCB); stdcall;
 TNCB = record
  ncb_command  : Byte;
  ncb_retcode  : Byte;
  ncb_lsn      : Byte;
  ncb_num      : Byte;
  ncb_buffer   : PChar;
  ncb_length   : Word;
  ncb_callname : array [0..NCBNAMSZ - 1] of Char;
  ncb_name     : array [0..NCBNAMSZ - 1] of Char;
  ncb_rto      : Byte;
  ncb_sto      : Byte;
  ncb_post     : TNCBPostProc;
  ncb_lana_num : Byte;
  ncb_cmd_cplt : Byte;
  ncb_reserve  : array [0..9] of Char;
  ncb_event    : THandle;
 end;
 TAdapterStatus = record
  adapter_address: array [0..5] of Char;
  // Remaining fields are unused so let's not declare them and save space
  filler: array [1..4*SizeOf(Char)+19*SizeOf(Word)+3*SizeOf(DWORD)] of Byte;
 end;
 TNameBuffer = record
  name       : array [0..NCBNAMSZ - 1] of Char;
  name_num   : Byte;
  name_flags : Byte;
 end;
 TLanaEnum = record
  length   : Byte;
  lana     : array [0..MAX_LANA] of Byte;
 end;
 ASTAT = record
  adapt   : TAdapterStatus;
  namebuf : array [0..29] of TNameBuffer;
 end;
 TNetBios = function (P: PNCB): Byte; stdcall;

const
  NetBiosLib : HINST    = 0;
  _NetBios   : TNetBios = nil;

procedure ExitNetbios;
begin
 try
  if (NetBiosLib<>0) then begin
   FreeLibrary(NetBiosLib);
   NetBiosLib:=0;
   _NetBios:=nil;
  end;
 except
  on E:Exception do BugReport(E,nil,'ExitNetbios');
 end;
end;

function InitNetbios: Boolean;
begin
 Result:=false;
 try
  Result:=True;
  if (NetBiosLib=0) then begin
   NetBiosLib := SafeLoadLibrary(PChar('netapi32.dll'));
   Result := NetBiosLib <> 0;
   if Result then begin
    @_NetBios := GetProcAddress(NetBiosLib, PChar('Netbios'));
    Result := @_NetBios <> nil;
    if not Result then ExitNetbios;
   end;
  end;
 except
  on E:Exception do BugReport(E,nil,'InitNetbios');
 end;
end;

function NetBios(P: PNCB): Byte;
begin
 Result:=1;
 try
  if InitNetbios then Result:=_NetBios(P) else Result:=1; // anything other then NRC_GOODRET will do
 except
  on E:Exception do BugReport(E,nil,'NetBios');
 end;
end;

function AdapterToString(Adapter: TAdapterStatus):LongString;
begin
 with Adapter do
 Result:=Format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x-%2.2x', [
         Integer(adapter_address[0]), Integer(adapter_address[1]),
         Integer(adapter_address[2]), Integer(adapter_address[3]),
         Integer(adapter_address[4]), Integer(adapter_address[5])]);
end;

function GetMacAddresses(const Machine:LongString; Delim:LongString=','; Mode:Integer=0):LongString;
var
 NCB         : TNCB;
 Enum        : TLanaEnum;
 I,L,NameLen : Integer;
 Adapter     : ASTAT;
 MachineName : LongString;
begin
 Result:='';
 try
  MachineName:=UpCaseStr(Trim(Machine));
  if IsLocalHostNameMachine(Machine) then begin
   Result:=GetIfMacAddresses(Delim,Mode);
   Exit;
  end;
  if IsEmptyStr(MachineName) then MachineName:='*';
  NameLen:=Length(MachineName);
  L:=NCBNAMSZ-NameLen;
  if (L>0) then begin
   SetLength(MachineName, NCBNAMSZ);
   FillChar(MachineName[NameLen + 1], L, ' ');
  end;
  SafeFillChar(NCB,SizeOf(NCB),0);
  NCB.ncb_command:=NCBENUM;
  NCB.ncb_buffer:=Pointer(@Enum);
  NCB.ncb_length:=SizeOf(Enum);
  if (NetBios(@NCB)=NRC_GOODRET) then begin
   for I := 0 to Ord(Enum.Length) - 1 do begin
    FillChar(NCB, SizeOf(NCB), #0);
    NCB.ncb_command := NCBRESET;
    NCB.ncb_lana_num := Enum.lana[I];
    if (NetBios(@NCB)=NRC_GOODRET) then begin
     FillChar(NCB, SizeOf(NCB), #0);
     NCB.ncb_command := NCBASTAT;
     NCB.ncb_lana_num := Enum.lana[I];
     Move(MachineName[1], NCB.ncb_callname, SizeOf(NCB.ncb_callname));
     NCB.ncb_buffer := PChar(@Adapter);
     NCB.ncb_length := SizeOf(Adapter);
     if (NetBios(@NCB)=NRC_GOODRET) then begin
      if (Length(Result)>0) then Result:=Result+',';
      Result:=Result+AdapterToString(Adapter.adapt);
     end;
    end;
   end;
  end;
  if (Result='') then Exit;
  if (Delim<>',') then Result:=StringReplace(Result,',',Delim,[rfReplaceAll]);
  if (Delim=EOL) then Result:=Result+EOL;
 except
  on E:Exception do BugReport(E,nil,'GetMacAddresses');
 end;
end;

function GetLocalUserList(Delim:LongString=EOL):LongString;
begin
 Result:=GetUserList;
 if (Delim<>EOL) then Result:=StringReplace(Trim(Result),EOL,Delim,[rfReplaceAll]);
end;

function GetUserList(const aServer  : LongString ='.';
                           aLevel   : Integer    = 0;
                           aFilter  : DWORD      = FILTER_NORMAL_ACCOUNT;
                           aTimeOut : DWORD      = DefNetEnumTimeout
                                  ) : LongString;
const
 PrefMaxLen   = 1024*4;
var
 Ptr          : Pointer;
 i,j          : Integer;
 List         : TText;
 WordLen      : array[1..4] of Integer;
 WServer      : WideString;
 PWServer     : PWideChar;
 Status       : DWORD;
 ReadEntries  : DWORD;
 TotalEntries : DWORD;
 ResumeHandle : DWORD;
 UserInfoPtr0 : PUserInfo0;
 UserInfoPtr1 : PUserInfo1;
 Str,Line     : ShortString;
 StartTime    : Double;
begin
 Result:='';
 if CanUseNetApi32 then
 try
  List:=NewText;
  try
   ResumeHandle:=0;
   StartTime:=msecnow;
   WServer:=StrToWide('\\'+SysUtils.Trim(aServer));
   if WideSameText(WServer,'\\') or WideSameText(WServer,'\\.') or WideSameText(WServer,'\\localhost')
   then PWServer:=nil else PWServer:=PWideChar(WServer);
   //
   // On level 0 (which available for all users) return simple user list
   //
   if (aLevel=0) then
   repeat
    Ptr:=nil;
    try
     TotalEntries:=0; ReadEntries:=0;
     Status:=NetUserEnum(PWServer,aLevel,aFilter,Ptr,PrefMaxLen,ReadEntries,TotalEntries,@ResumeHandle);
     if (Status=ERROR_MORE_DATA) or (Status=S_OK) then begin
      UserInfoPtr0:=Ptr;
      if (Ptr=nil) then ReadEntries:=0;
      if (ReadEntries=0) then Break;
      while (ReadEntries>0) do begin
       Line:=WideToStr(UserInfoPtr0.usri0_name);
       List.AddLn(Line);
       if (msecnow-StartTime>aTimeOut) then begin
        List.Addln(NetEnumTimeoutId);
        //List.Count:=0;
        Break;
       end;
       Inc(UserInfoPtr0);
       Dec(ReadEntries);
      end;
     end else begin
      SetLastError(Status);
      List.Count:=0;
      Break;
     end;
    finally
     if Assigned(Ptr) then NetApiBufferFree(Ptr);
    end;
   until Status=S_OK;
   //
   // On level 1 (which may not be available for users) return list: (user group state comment)
   // where group=?/Guest/User/Root, state=0n/0ff
   //
   if (aLevel=1) then
   repeat
    Ptr:=nil;
    try
     Status:=NetUserEnum(PWServer,aLevel,aFilter,Ptr,PrefMaxLen,ReadEntries,TotalEntries,@ResumeHandle);
     if (Status=ERROR_MORE_DATA) or (Status=S_OK) then begin
      UserInfoPtr1:=Ptr;
      if (Ptr=nil) then ReadEntries:=0;
      if (ReadEntries=0) then Break;
      while (ReadEntries>0) do begin
       Line:=URL_Packed(WideToStr(UserInfoPtr1.usri1_name));
       case UserInfoPtr1.usri1_priv of
        USER_PRIV_GUEST: Line:=Line+' Guest';
        USER_PRIV_USER:  Line:=Line+' User ';
        USER_PRIV_ADMIN: Line:=Line+' Root ';
        else             Line:=Line+' ?    ';
       end;
       if (UserInfoPtr1.usri1_flags and UF_ACCOUNTDISABLE=0)
       then Line:=Line+' On' else Line:=Line+' Off';
       Line:=Line+' '+URL_Packed(WideToStr(UserInfoPtr1.usri1_comment)+' ');
       List.AddLn(Line);
       if (msecnow-StartTime>aTimeOut) then begin
        List.Addln(NetEnumTimeoutId);
        //List.Count:=0;
        Break;
       end;
       Inc(UserInfoPtr1);
       Dec(ReadEntries);
      end;
     end else begin
      SetLastError(Status);
      List.Count:=0;
      Break;
     end;
    finally
     if Assigned(Ptr) then NetApiBufferFree(Ptr);
    end;
   until Status=S_OK;
   //
   // Format table
   //
   if (aLevel>0) then begin
    SafeFillChar(WordLen,SizeOf(WordLen),0);
    for i:=0 to List.Count-1 do
    for j:=1 to High(WordLen) do
    WordLen[j]:=Max(WordLen[j],Length(URL_Decode(ExtractWord(j,List[i],ScanSpaces))));
    WordLen[1]:=Max(WordLen[1],Length(UserName));
    for i:=0 to List.Count-1 do begin
     Line:='';
     Str:=List[i];
     for j:=1 to High(WordLen) do
     Line:=Line+Format('%-*s ',[WordLen[j],URL_Decode(ExtractWord(j,Str,ScanSpaces))]);
     List[i]:=Trim(Line);
    end;
   end;
   Result:=List.Text;
  finally
   Kill(List);
  end;
 except
  on E:Exception do BugReport(E,nil,'GetUserList');
 end;
end;

function GetHostList(const aServer  : LongString ='.';
                           aDomain  : LongString ='';
                           aLevel   : DWORD      = 0;
                           aType    : DWORD      = SV_TYPE_ALL;
                           aTimeOut : DWORD      = DefNetEnumTimeout
                                  ) : LongString;
const
 PrefMaxLen       = 1024*4;
var
 Ptr              : Pointer;
 i,j              : Integer;
 List             : TText;
 WordLen          : array[1..4] of Integer;
 WServer          : WideString;
 PWServer         : PWideChar;
 WDomain          : WideString;
 PWDomain         : PWideChar;
 Status           : DWORD;
 ReadEntries      : DWORD;
 TotalEntries     : DWORD;
 ResumeHandle     : DWORD;
 ServerInfoPtr100 : PServerInfo100;
 ServerInfoPtr101 : PServerInfo101;
 Str,Line         : ShortString;
 StartTime        : Double;
 function HostTypeStr(a:Integer):LongString;
 begin
  Result:='';
  Result:=AddPathDelim(Result);
  if a and SV_TYPE_WORKSTATION       <>0 then Result:=AddPathDelim(Result)+'WSt';
  if a and SV_TYPE_SERVER	         <>0 then Result:=AddPathDelim(Result)+'Srv';
  if a and SV_TYPE_SQLSERVER	     <>0 then Result:=AddPathDelim(Result)+'SQL';
  if a and SV_TYPE_DOMAIN_CTRL	     <>0 then Result:=AddPathDelim(Result)+'DomCtrl';
  if a and SV_TYPE_DOMAIN_BAKCTRL    <>0 then Result:=AddPathDelim(Result)+'DomBack';
  if a and SV_TYPE_TIME_SOURCE       <>0 then Result:=AddPathDelim(Result)+'TimSrc';
  if a and SV_TYPE_AFP               <>0 then Result:=AddPathDelim(Result)+'AFP';
  if a and SV_TYPE_NOVELL            <>0 then Result:=AddPathDelim(Result)+'Novell';
  if a and SV_TYPE_DOMAIN_MEMBER     <>0 then Result:=AddPathDelim(Result)+'DomMemb';
  if a and SV_TYPE_LOCAL_LIST_ONLY   <>0 then Result:=AddPathDelim(Result)+'LocList';
  if a and SV_TYPE_PRINTQ_SERVER     <>0 then Result:=AddPathDelim(Result)+'Prn';
  if a and SV_TYPE_DIALIN_SERVER     <>0 then Result:=AddPathDelim(Result)+'Deal';
  if a and SV_TYPE_XENIX_SERVER      <>0 then Result:=AddPathDelim(Result)+'Unix';
  if a and SV_TYPE_SERVER_MFPN       <>0 then Result:=AddPathDelim(Result)+'MFPN';
  if a and SV_TYPE_NT                <>0 then Result:=AddPathDelim(Result)+'WinNt';
  if a and SV_TYPE_WFW               <>0 then Result:=AddPathDelim(Result)+'WinFW';
  if a and SV_TYPE_SERVER_NT	     <>0 then Result:=AddPathDelim(Result)+'SrvNt';
  if a and SV_TYPE_POTENTIAL_BROWSER <>0 then Result:=AddPathDelim(Result)+'PBrow';
  if a and SV_TYPE_BACKUP_BROWSER    <>0 then Result:=AddPathDelim(Result)+'BBrow';
  if a and SV_TYPE_MASTER_BROWSER    <>0 then Result:=AddPathDelim(Result)+'MBrow';
  if a and SV_TYPE_DOMAIN_MASTER     <>0 then Result:=AddPathDelim(Result)+'DomMast';
  if a and SV_TYPE_DOMAIN_ENUM	     <>0 then Result:=AddPathDelim(Result)+'DomEnum';
  if a and SV_TYPE_WINDOWS           <>0 then Result:=AddPathDelim(Result)+'Win9x';
  Result:=AddPathDelim(Result);
 end;
begin
 Result:='';
 if CanUseNetApi32 then
 try
  List:=NewText;
  try
   ResumeHandle:=0;
   StartTime:=msecnow;
   WDomain:=StrToWide(SysUtils.Trim(aDomain));
   WServer:=StrToWide('\\'+SysUtils.Trim(aServer));
   if WideSameText(WServer,'\\') or WideSameText(WServer,'\\.') or WideSameText(WServer,'\\localhost')
   then PWServer:=nil else PWServer:=PWideChar(WServer);
   if (WDomain='') then PWDomain:=nil else PWDomain:=PWideChar(WDomain);
   //
   // On level 0 return simple host list
   //
   if (aLevel=0) then
   repeat
    Ptr:=nil;
    try
     TotalEntries:=0; ReadEntries:=0;
     Status:=NetServerEnum(PWServer,100,Ptr,PrefMaxLen,ReadEntries,TotalEntries,aType,PWDomain,@ResumeHandle);
     if (Status=ERROR_MORE_DATA) or (Status=S_OK) then begin
      ServerInfoPtr100:=Ptr;
      if (Ptr=nil) then ReadEntries:=0;
      if (ReadEntries=0) then Break;
      while (ReadEntries>0) do begin
       Line:=WideToStr(ServerInfoPtr100.sv100_name);
       List.AddLn(Line);
       if (msecnow-StartTime>aTimeOut) then begin
        List.Addln(NetEnumTimeoutId);
        //List.Count:=0;
        Break;
       end;
       Inc(ServerInfoPtr100);
       Dec(ReadEntries);
      end;
     end else begin
      SetLastError(Status);
      List.Count:=0;
      Break;
     end;
    finally
     if Assigned(Ptr) then NetApiBufferFree(Ptr);
    end;
   until Status=S_OK;
   //
   // On level 1 return list: hostname IP comment
   //
   if (aLevel=1) then
   repeat
    Ptr:=nil;
    try
     Status:=NetServerEnum(PWServer,101,Ptr,PrefMaxLen,ReadEntries,TotalEntries,aType,PWDomain,@ResumeHandle);
     if (Status=ERROR_MORE_DATA) or (Status=S_OK) then begin
      ServerInfoPtr101:=Ptr;
      if (Ptr=nil) then ReadEntries:=0;
      if (ReadEntries=0) then Break;
      while (ReadEntries>0) do begin
       Line:=URL_Packed(WideToStr(ServerInfoPtr101.sv101_name));
       Str:=GetIpAddress(WideToStr(ServerInfoPtr101.sv101_name));
       if (Length(Str)=0) then Str:='?';
       Line:=Line+' '+Str;
       Line:=Line+' '+HostTypeStr(ServerInfoPtr101.sv101_type);
       Str:=WideToStr(ServerInfoPtr101.sv101_comment);
       if (Length(Str)=0) then Str:='?';
       Line:=Line+' '+URL_Packed(Str);
       List.AddLn(Line);
       if (msecnow-StartTime>aTimeOut) then begin
        List.Addln(NetEnumTimeoutId);
        //List.Count:=0;
        Break;
       end;
       Inc(ServerInfoPtr101);
       Dec(ReadEntries);
      end;
     end else begin
      SetLastError(Status);
      List.Count:=0;
      Break;
     end;
    finally
     if Assigned(Ptr) then NetApiBufferFree(Ptr);
    end;
   until Status=S_OK;
   //
   // Format table
   //
   if (aLevel>0) then begin
    SafeFillChar(WordLen,SizeOf(WordLen),0);
    for i:=0 to List.Count-1 do
    for j:=1 to High(WordLen) do
    WordLen[j]:=Max(WordLen[j],Length(URL_Decode(ExtractWord(j,List[i],ScanSpaces))));
    WordLen[1]:=Max(WordLen[1],Max(Length(ComputerName),Length('localhost')));
    WordLen[2]:=Max(WordLen[2],Length('255.255.255.255'));
    for i:=0 to List.Count-1 do begin
     Line:='';
     Str:=List[i];
     for j:=1 to High(WordLen) do
     Line:=Line+Format('%-*s ',[WordLen[j],URL_Decode(ExtractWord(j,Str,ScanSpaces))]);
     List[i]:=Trim(Line);
    end;
   end;
   Result:=List.Text;
  finally
   Kill(List);
  end;
 except
  on E:Exception do BugReport(E,nil,'GetHostList');
 end;
end;

function GetDomainList(const aServer  : LongString ='.';
                             aLevel   : Integer    = 0;
                             aLocals  : Boolean    = False;
                             aTimeOut : DWORD      = DefNetEnumTimeout
                                    ) : LongString;
var
 i,L1,L2 : Integer;
 DomList : TText;
 DomCtrl : ShortString;
 DomIp   : ShortString;
begin
 Result:='';
 if CanUseNetApi32 then
 try
  DomList:=NewText;
  try
   if (aLevel=0) then begin
    DomList.Text:=GetHostList(aServer,'',0,SV_TYPE_DOMAIN_ENUM,aTimeOut);
    if aLocals then begin
     DomList.InsLn(0,'.');
     DomList.InsLn(1,'localhost');
     DomList.InsLn(2,ComputerName);
    end;
   end;
   if (aLevel=1) then begin
    DomList.Text:=GetHostList(aServer,'',0,SV_TYPE_DOMAIN_ENUM,aTimeOut);
    L1:=Max(DomList.MaxLength,Max(Length(ComputerName),Length('localhost')));
    for i:=0 to DomList.Count-1 do DomList[i]:=Format('%-*s ',[L1,DomList[i]]);
    for i:=0 to DomList.Count-1 do begin
     if IsSameText(DomList[i],NetEnumTimeoutId) then Continue;
     DomCtrl:=ExtractWord(1,GetHostList('',DomList[i],0,SV_TYPE_DOMAIN_CTRL,aTimeOut),ScanSpaces);
     if IsEmptyStr(DomCtrl) then DomCtrl:='?';
     DomList[i]:=DomList[i]+DomCtrl;
    end;
    L2:=Max(DomList.MaxLength,Length(Format('%-*s ',[L1,'.'])+'localhost'));
    for i:=0 to DomList.Count-1 do DomList[i]:=Format('%-*s ',[L2,DomList[i]]);
    for i:=0 to DomList.Count-1 do begin
     if IsSameText(DomList[i],NetEnumTimeoutId) then Continue;
     DomCtrl:=ExtractWord(2,DomList[i],ScanSpaces);
     if IsEmptyStr(DomCtrl) then DomCtrl:='?';
     if IsSameText(DomCtrl,'?') then DomIp:='?' else DomIp:=GetIpAddress(DomCtrl);
     if IsEmptyStr(DomIp) then DomIp:='?';
     DomList[i]:=DomList[i]+DomIp;
    end;
    if aLocals then begin
     DomList.InsLn(0,Format('%-*s ',[L2,Format('%-*s ',[L1,'.'])         +'localhost'])+GetIpAddress('localhost'));
     DomList.InsLn(1,Format('%-*s ',[L2,Format('%-*s ',[L1,'localhost']) +'this_host'])+GetIpAddress('localhost'));
     DomList.InsLn(2,Format('%-*s ',[L2,Format('%-*s ',[L1,ComputerName])+'localhost'])+GetIpAddress(ComputerName));
    end;
   end;
   Result:=DomList.Text;
  finally
   Kill(DomList);
  end;
 except
  on E:Exception do BugReport(E,nil,'GetDomainList');
 end;
end;

{$ENDIF ~WINDOWS}

{$IFDEF UNIX}
function GetLocalUserList(Delim:LongString=EOL):LongString;
var List:TStringList;
begin
 Result:='';
 try
  List:=TStringList.Create;
  try
   users.GetUserList(List);
   Result:=List.Text;
   if (Delim<>EOL) then Result:=StringReplace(Trim(Result),EOL,Delim,[rfReplaceAll]);
  finally
   Kill(List);
  end;
 except
  on E:Exception do BugReport(E,nil,'GetLocalUserList');
 end;
end;
function  GetUserList(const aServer  : LongString ='.';
                            aLevel   : Integer    = 0;
                            aFilter  : DWORD      = FILTER_NORMAL_ACCOUNT;
                            aTimeOut : DWORD      = DefNetEnumTimeout
                                   ) : LongString; // Return list of known users.
var localNames:LongString;
begin
 Result:='';
 localNames:='.'+EOL+'localhost'+EOL+ComputerName+EOL+HostName;
 if (WordIndex(aServer,localNames,ScanSpaces)>0) then begin
  Result:=GetLocalUserList;
  Exit;
 end;
end;

function GetHostList(const aServer  : LongString ='.';
                           aDomain  : LongString ='';
                           aLevel   : DWORD      = 0;
                           aType    : DWORD      = SV_TYPE_ALL;
                           aTimeOut : DWORD      = DefNetEnumTimeout
                                  ) : LongString;
const EtcHosts = '/etc/hosts';
var List:TText; Items,Item:PHostListEntry; line:LongString;
var WordLen:array[1..3] of Integer; i:Integer;
begin
 Result:='';
 if FileExists(EtcHosts) then
 try
  List:=NewText;
  try
   if (WordIndex(aServer,'. localhost '+HostName,ScanSpaces)>0) then begin
    Items:=ProcessHosts(EtcHosts);
    if Assigned(Items) then
    try
     Item:=Items;
     while Assigned(Item) do begin
      line:=Item.Entry.Name;
      // On level 0 return simple host list
      // On level 1 return list: hostname IP Aliases
      if (aLevel>0) then line:=line+' '+NetAddrToStr(Item.Entry.Addr);
      if (aLevel>0) then line:=line+' '+Trim(Item.Entry.Aliases);
      line:=Trim(line);
      List.AddLn(line);
      Item:=Item.Next;
     end;
    finally
     FreeHostsList(Items);
    end;
   end;
   //
   // Format table
   //
   if (aLevel>0) then begin
    SafeFillChar(WordLen,SizeOf(WordLen),0);
    for i:=0 to List.Count-1 do begin
     line:=List[i];
     WordLen[1]:=Max(WordLen[1],Length(ExtractWord(1,line,ScanSpaces)));
     WordLen[2]:=Max(WordLen[2],Length(ExtractWord(2,line,ScanSpaces)));
     WordLen[3]:=Max(WordLen[3],Length(SkipWords(2,line,ScanSpaces)));
    end;
    WordLen[1]:=Max(WordLen[1],Max(Length(ComputerName),Length('localhost')));
    WordLen[2]:=Max(WordLen[2],Length('255.255.255.255'));
    for i:=0 to List.Count-1 do begin
     line:=Format('%-*s ',[WordLen[1],ExtractWord(1,List[i],ScanSpaces)])
          +Format('%-*s ',[WordLen[2],ExtractWord(2,List[i],ScanSpaces)])
          +Trim(SkipWords(2,List[i],ScanSpaces));
     List[i]:=Trim(Line);
    end;
   end;
   Result:=List.Text;
  finally
   Kill(List);
  end;
 except
  on E:Exception do BugReport(E,nil,'GetHostList');
 end;
end;

function GetDomainList(const aServer  : LongString ='.';
                             aLevel   : Integer    = 0;
                             aLocals  : Boolean    = False;
                             aTimeOut : DWORD      = DefNetEnumTimeout
                                    ) : LongString;
var List:TText; line:LongString; i:Integer; WordLen:array[1..3] of Integer;
begin
 Result:='';
 try
  List:=NewText;
  try
   if (aLevel=0) then begin
    List.Text:=GetHostList(aServer,'',aLevel,0,aTimeOut);
    if aLocals then begin
     List.InsLn(0,'.');
     List.InsLn(1,'localhost');
     List.InsLn(2,ComputerName);
    end;
   end;
   if (aLevel=1) then begin
    List.Text:=GetHostList(aServer,'',aLevel,0,aTimeOut);
    if aLocals then begin
     List.InsLn(0,'. '+GetIpAddress('localhost'));
     List.InsLn(1,'localhost '+GetIpAddress('localhost'));
     List.InsLn(2,ComputerName+' '+GetIpAddress(ComputerName));
    end;
   end;
   //
   // Format table
   //
   if (aLevel>0) then begin
    SafeFillChar(WordLen,SizeOf(WordLen),0);
    for i:=0 to List.Count-1 do begin
     line:=List[i];
     WordLen[1]:=Max(WordLen[1],Length(ExtractWord(1,line,ScanSpaces)));
     WordLen[2]:=Max(WordLen[2],Length(ExtractWord(2,line,ScanSpaces)));
     WordLen[3]:=Max(WordLen[3],Length(SkipWords(2,line,ScanSpaces)));
    end;
    WordLen[1]:=Max(WordLen[1],Max(Length(ComputerName),Length('localhost')));
    WordLen[2]:=Max(WordLen[2],Length('255.255.255.255'));
    for i:=0 to List.Count-1 do begin
     line:=Format('%-*s ',[WordLen[1],ExtractWord(1,List[i],ScanSpaces)])
          +Format('%-*s ',[WordLen[2],ExtractWord(2,List[i],ScanSpaces)])
          +Trim(SkipWords(1,List[i],ScanSpaces));
     List[i]:=Trim(Line);
    end;
   end;
   Result:=List.Text;
  finally
   Kill(List);
  end;
 except
  on E:Exception do BugReport(E,nil,'GetDomainList');
 end;
end;
{$ENDIF ~UNIX}

{$IFDEF WINDOWS}

function GetRootKeyByName(const Key:LongString):HKEY;
begin
 if IsSameText(Key,'HKCR')  or IsSameText(Key,'HKEY_CLASSES_ROOT')     then Result:=HKEY_CLASSES_ROOT     else
 if IsSameText(Key,'HKLM')  or IsSameText(Key,'HKEY_LOCAL_MACHINE')    then Result:=HKEY_LOCAL_MACHINE    else
 if IsSameText(Key,'HKCU')  or IsSameText(Key,'HKEY_CURRENT_USER')     then Result:=HKEY_CURRENT_USER     else
 if IsSameText(Key,'HKU')   or IsSameText(Key,'HKEY_USERS')            then Result:=HKEY_USERS            else
 if IsSameText(Key,'HKCC')  or IsSameText(Key,'HKEY_CURRENT_CONFIG')   then Result:=HKEY_CURRENT_CONFIG   else
 if IsSameText(Key,'HKDD')  or IsSameText(Key,'HKEY_DYN_DATA')         then Result:=HKEY_DYN_DATA         else
 if IsSameText(Key,'HKPD')  or IsSameText(Key,'HKEY_PERFORMANCE_DATA') then Result:=HKEY_PERFORMANCE_DATA else
 Result:=0;
end;

function ReadRegistryString(RootKey:HKEY; const Key,Name:LongString):LongString;
var
 Reg : TRegistry;
begin
 Result:='';
 if (RootKey<>0) then
 if (Length(Key)>0) then
 try
  Reg:=TRegistry.Create;
  try
   Reg.RootKey:=RootKey;
   if Reg.KeyExists(Key) then begin
    Reg.OpenKeyReadOnly(Key);
    case Reg.GetDataType(Name) of
     rdString       : Result:=Reg.ReadString(Name);
     rdExpandString : Result:=Reg.ReadString(Name);
     rdInteger      : Result:=Dump(Reg.ReadInteger(Name));
     rdBinary       : begin
                       SetLength(Result,Reg.GetDataSize(Name));
                       SetLength(Result,Reg.ReadBinaryData(Name,PChar(Result)^,Length(Result)));
                      end;
    end;
   end;
  finally
   Reg.Destroy;
  end;
 except
  on E:Exception do BugReport(E,nil,'ReadRegistryString');
 end;
end;

function WriteRegistryString(RootKey:HKEY; const Key,Name,Data:LongString):LongString;
var
 Reg : TRegistry;
begin
 Result:='';
 if (RootKey<>0) then
 if (Length(Key)>0) then
 try
  Reg:=TRegistry.Create;
  try
   Reg.RootKey:=RootKey;
   if Reg.KeyExists(Key) then begin
    Reg.OpenKey(Key,True);
    case Reg.GetDataType(Name) of
     rdString       : Reg.WriteString(Name,Data);
     rdExpandString : Reg.WriteString(Name,Data);
     rdInteger      : Reg.WriteInteger(Name,Dump2i(Data));
     rdBinary       : Reg.WriteBinaryData(Name,PChar(Data)^,Length(Data));
     else             Exit;
    end;
   end;
  finally
   Reg.Destroy;
  end;
  Result:=ReadRegistryString(RootKey,Key,Name);
 except
  on E:Exception do BugReport(E,nil,'WriteRegistryString');
 end;
end;

function ReadRegistryMultiStrings(RootKey:HKey; const Key,Name:LongString; Delim:Char=ASCII_CR):LongString;
var valueKey:HKEY; valueType,valueLeng:DWORD; Buffer:LongString; i:Integer;
begin
 Result:='';
 try
  valueKey:=0; Buffer:='';
  if (RegOpenKeyEx(RootKey,PChar(Key),0,KEY_READ,valueKey)=ERROR_SUCCESS) then
  try
   if (RegQueryValueEx(valueKey,PChar(Name),nil,@valueType,nil,@valueLeng)=ERROR_SUCCESS) then
   if (valueType=REG_MULTI_SZ) and (valueLeng>0) then begin
    SetLength(Buffer,valueLeng);
    if (RegQueryValueEx(valueKey,PChar(Name),nil,nil,Windows.PByte(Buffer),@valueLeng)=ERROR_SUCCESS) then
    if (Integer(valueLeng)=Length(Buffer)) then begin
     if (Delim<>ASCII_NUL) then for i:=1 to Length(Buffer) do if Buffer[i]=ASCII_NUL then Buffer[i]:=Delim;
     if (Delim=ASCII_CR) then Result:=StringReplace(Buffer,Delim,EOL,[rfReplaceAll]);
    end;
    Buffer:='';
   end;
  finally
   RegCloseKey(valueKey);
  end;
 except
  on E:Exception do BugReport(E,nil,'ReadRegistryMultiStrings');
 end;
end;

function  GetWindowsShellFolder(const Name:LongString):LongString;
begin
 Result:=ReadRegistryString(HKEY_CURRENT_USER,
         'Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders',
         Name);
end;

function GetWindowsShellDesktop:LongString;
begin
 Result:=GetWindowsShellFolder('Desktop');
end;

function GetWindowsShellPrograms:LongString;
begin
 Result:=GetWindowsShellFolder('Programs');
end;

function GetWindowsShellStartup:LongString;
begin
 Result:=GetWindowsShellFolder('Startup');
end;

function GetWindowsShellStartMenu:LongString;
begin
 Result:=GetWindowsShellFolder('Start Menu');
end;

function GetWindowsShellFavorites:LongString;
begin
 Result:=GetWindowsShellFolder('Favorites');
end;

function GetWindowsShellFonts:LongString;
begin
 Result:=GetWindowsShellFolder('Fonts');
end;

function GetWindowsShellHistory:LongString;
begin
 Result:=GetWindowsShellFolder('History');
end;

function GetWindowsShellPersonal:LongString;
begin
 Result:=GetWindowsShellFolder('Personal');
end;

function GetWindowsShellSendTo:LongString;
begin
 Result:=GetWindowsShellFolder('SendTo');
end;

procedure CreateFileLink(const ObjectPath,LinkPath,Description,Params:LongString);
var IObject:IUnknown; Buff:TParsingBuffer;
begin
 try
  IObject:=CreateComObject(CLSID_ShellLink);
  with (IObject as IShellLink) do begin
   SetArguments(StrCopyBuff(Buff,Params));
   SetDescription(StrCopyBuff(Buff,Description));
   SetPath(StrCopyBuff(Buff,ObjectPath));
  end;
  (IObject as IPersistFile).Save(PWChar(WideString(DefaultExtension(LinkPath,'.lnk'))), FALSE);
 except
  on E:Exception do BugReport(E,nil,'CreateFileLink');
 end;
end;

function ReadShellLinkAsText(const FileName:LongString):LongString;
var IObject:IUnknown; Buff,Exe,Arg,Exec:LongString; CBuff:PChar;
var hk:Word; ii,sw:LongInt; pfd:WIN32_FIND_DATA;
const BuffSize=KiloByte*64;
 function HotkeyToStr(hk:Word):LongString;
 begin
  Result:=TrimDef(ShortCutToText(hk){%H-},'0');
  if SameText(Result,'Unknown') then Result:='0';
 end;
begin
 Result:='';
 if SameText(ExtractFileExt(FileName),'.lnk') then
 if FileExists(FileName) then
 try
  Buff:=''; hk:=0; ii:=0; sw:=0;
  pfd:=Default(WIN32_FIND_DATA);
  IObject:=CreateComObject(CLSID_ShellLink);
  (IObject as IPersistFile).Load(PWideChar(StrToWide(FileName)),STGM_READ);
  Buff:=StringBuffer(BuffSize); CBuff:=PChar(Buff);
  with (IObject as IShellLink) do begin
   if Succeeded(GetPath(CBuff,BuffSize,pfd,SLGP_RAWPATH)) then Result:=Result+'TargetPath='+StrPas(CBuff)+EOL;
   if Succeeded(GetArguments(CBuff,BuffSize))             then Result:=Result+'Arguments='+StrPas(CBuff)+EOL;
   if Succeeded(GetWorkingDirectory(CBuff,BuffSize))      then Result:=Result+'WorkingDirectory='+StrPas(CBuff)+EOL;
   if Succeeded(GetShowCmd(sw))                           then Result:=Result+'ShowCmd='+IntToStr(sw)+EOL;
   if Succeeded(GetShowCmd(sw))                           then Result:=Result+'WindowStyle='+IntToStr(sw)+EOL;
   if Succeeded(GetIconLocation(CBuff,BuffSize,ii))       then Result:=Result+'IconLocation='+StrPas(CBuff)+EOL;
   if Succeeded(GetDescription(CBuff,BuffSize))           then Result:=Result+'Description='+StrPas(CBuff)+EOL;
   if Succeeded(GetHotkey(hk))                            then Result:=Result+'Hotkey='+HotkeyToStr(hk)+EOL;
   Exe:=CookieScan(Result,'TargetPath');
   Arg:=CookieScan(Result,'Arguments');
   if MaybeEnvStr(Exe) then Exe:=ExpEnv(Exe);
   Exec:=Trim(AnsiQuotedIfNeed(Trim(Exe))+' '+Trim(Arg));
   if (Exec<>'') then Result:='Exec='+Exec+EOL+Result;
  end;
 except
  on E:Exception do BugReport(E,nil,'ReadShellLinkAsText');
 end;
end;
{$ENDIF WINDOWS}

{$IFDEF UNIX}
function GetRootKeyByName(const Key:LongString):HKEY;
begin
 if IsSameText(Key,'HKCR')  or IsSameText(Key,'HKEY_CLASSES_ROOT')     then Result:=HKEY_CLASSES_ROOT     else
 if IsSameText(Key,'HKLM')  or IsSameText(Key,'HKEY_LOCAL_MACHINE')    then Result:=HKEY_LOCAL_MACHINE    else
 if IsSameText(Key,'HKCU')  or IsSameText(Key,'HKEY_CURRENT_USER')     then Result:=HKEY_CURRENT_USER     else
 if IsSameText(Key,'HKU')   or IsSameText(Key,'HKEY_USERS')            then Result:=HKEY_USERS            else
 if IsSameText(Key,'HKCC')  or IsSameText(Key,'HKEY_CURRENT_CONFIG')   then Result:=HKEY_CURRENT_CONFIG   else
 if IsSameText(Key,'HKDD')  or IsSameText(Key,'HKEY_DYN_DATA')         then Result:=HKEY_DYN_DATA         else
 if IsSameText(Key,'HKPD')  or IsSameText(Key,'HKEY_PERFORMANCE_DATA') then Result:=HKEY_PERFORMANCE_DATA else
 Result:=0;
end;

function ReadRegistryString(RootKey:HKEY; const Key,Name:LongString):LongString;
begin
 Result:='';
end;

function WriteRegistryString(RootKey:HKEY; const Key,Name,Data:LongString):LongString;
begin
 Result:='';
end;

function ReadRegistryMultiStrings(RootKey:HKey; const Key,Name:LongString; Delim:Char=ASCII_CR):LongString;
begin
 Result:='';
end;

function  GetWindowsShellFolder(const Name:LongString):LongString;
begin
 Result:=CSIDL_FolderByName(Name,'');
end;

function GetWindowsShellDesktop:LongString;
begin
 Result:=GetWindowsShellFolder('Desktop');
end;

function GetWindowsShellPrograms:LongString;
begin
 Result:=GetWindowsShellFolder('Programs');
end;

function GetWindowsShellStartup:LongString;
begin
 Result:=GetWindowsShellFolder('Startup');
end;

function GetWindowsShellStartMenu:LongString;
begin
 Result:=GetWindowsShellFolder('Start Menu');
end;

function GetWindowsShellFavorites:LongString;
begin
 Result:=GetWindowsShellFolder('Favorites');
end;

function GetWindowsShellFonts:LongString;
begin
 Result:=GetWindowsShellFolder('Fonts');
end;

function GetWindowsShellHistory:LongString;
begin
 Result:=GetWindowsShellFolder('History');
end;

function GetWindowsShellPersonal:LongString;
begin
 Result:=GetWindowsShellFolder('Personal');
end;

function GetWindowsShellSendTo:LongString;
begin
 Result:=GetWindowsShellFolder('SendTo');
end;

procedure CreateFileLink(const ObjectPath,LinkPath,Description,Params:LongString);
begin
 try
  {$IFDEF SKIP_DRAFT}
  // TODO: Create *.desktop file.
  {$ENDIF ~SKIP_DRAFT}
 except
  on E:Exception do BugReport(E,nil,'CreateFileLink');
 end;
end;

function ReadShellLinkAsText(const FileName:LongString):LongString;
begin
 Result:='';
 if SameText(ExtractFileExt(FileName),'.desktop') then
 if FileExists(FileName) then
 try
  Result:=AdjustLineBreaks(StringFromFile(FileName,0));
 except
  on E:Exception do BugReport(E,nil,'ReadShellLinkAsText');
 end;
end;
{$ENDIF ~UNIX}

function ArgChar(const s:LongString):PChar;
begin
 if (Length(s)>0) then Result:=PChar(s) else Result:=nil;
end;

function GetEnvVar(const Name:LongString):LongString;
begin
 Result:=_crw_environ.GetEnv(Name);
end;

function GetEnv(const Name:LongString):LongString;
begin
 Result:=_crw_environ.GetEnv(Name);
end;

function SetEnv(const Name,Value:LongString):Boolean;
begin
 Result:=false;
 try
  Result:=_crw_environ.SetEnv(Name,Value);
 except
  on E:Exception do BugReport(E,nil,'SetEnv');
 end;
end;

function ExpEnv(const Str:LongString):LongString;
begin
 Result:=Str;
 if MaybeEnvStr(Result) then
 try
  Result:=_crw_environ.ExpEnv(Str);
 except
  on E:Exception do BugReport(E,nil,'ExpEnv');
 end;
end;

function MaybeEnvStr(const arg:LongString):Boolean;
begin
 Result:=(arg<>'') and HasChars(arg,['%','!','$','`']);
end;

function MaybeTildeStr(const arg:LongString):Boolean;
begin
 if (arg='') then Exit(false);
 Result:=(Pos(sfrDefUserHome,arg)>0) or (Pos(sfrDefProgHome,arg)>0);
end;

function ExpEnvFilter(const Str:LongString; lBracket,rBracket:Char;
         handleUrl:Boolean=false; GetEnvFunc:TGetEnvFunction=nil):LongString; overload;
var i,p,n,il,Len:Integer; ev:LongString;
 function LooksLikeUrlCode(const s:LongString):Boolean;
 var m:Integer;
 begin
  Result:=handleUrl and (Length(s)=3) and (Copy(s,1,1)='%') and Str2Int('$'+Copy(s,2,2),m);
 end;
begin
 Result:='';
 if not Assigned(GetEnvFunc) then GetEnvFunc:=_crw_fio.GetEnv;
 if Assigned(GetEnvFunc) then
 try
  p:=1; n:=0; il:=0; ev:=''; Len:=Length(Str);
  for i:=1 to Len do begin
   if (il=0) then begin
    if (Str[i]=lBracket) and not LooksLikeUrlCode(Copy(Str,i,3)) then begin
     if (n>0) then Result:=Result+Copy(Str,p,n);
     p:=i; n:=1; il:=i;
     continue;
    end;
   end else begin
    if (Str[i]=rBracket) then begin
     ev:=Copy(Str,il+1,i-il-1);
     if (Length(ev)>0) then ev:=GetEnvFunc(ev);
     if (Length(ev)>0) then Result:=Result+ev else Result:=Result+Copy(Str,il,i-il+1);
     p:=i+1; n:=0; il:=0;
     continue;
    end;
   end;
   inc(n);
  end;
  if (n>0) then Result:=Result+Copy(Str,p,n);
 except
  on E:Exception do BugReport(E,nil,'ExpEnvFilter');
 end;
end;

function ExpEnvFilter(const Str:LongString; const Brackets:LongString;
                      handleUrl:Boolean=false; GetEnvFunc:TGetEnvFunction=nil):LongString; overload;
var i:Integer; lBracket,rBracket:Char;
begin
 Result:=Str;
 for i:=1 to Length(Brackets) div 2 do begin
  lBracket:=Brackets[1+(i-1)*2];
  rBracket:=Brackets[2+(i-1)*2];
  if (Pos(lBracket,Result)>0)
  then Result:=ExpEnvFilter(Result,lBracket,rBracket,handleUrl,GetEnvFunc);
 end;
end;

function CalcExpEnvBrackets(const Brackets:LongString):LongString;
begin
 if (Brackets='*') then Result:=DefaultExpEnvBrackets else Result:=Brackets;
end;

function PathAddDir(const Path,Dir:LongString; AddFirst:Boolean=false; Check:Boolean=true; Delim:Char=PathSep):LongString;
var List1,List2:TStringList; i:Integer;
 procedure AddDir(List:TStringList; const D:LongString; First:Boolean);
 begin
  if (D='') then exit;
  if (List.IndexOf(D)>=0) then exit;
  if Check and not DirExists(D) then exit;
  if First then List.Insert(0,D) else List.Add(D);
 end;
begin
 Result:='';
 try
  List1:=TStringList.Create;
  List2:=TStringList.Create;
  try
   List1.Text:=StringReplace(Path,Delim,EOL,[rfReplaceAll]);
   for i:=0 to List1.Count-1 do AddDir(List2,SysUtils.Trim(List1[i]),false);
   AddDir(List2,SysUtils.Trim(Dir),AddFirst);
   Result:=StringReplace(SysUtils.Trim(List2.Text),EOL,Delim,[rfReplaceAll]);
  finally
   Kill(List1);
   Kill(List2);
  end;
 except
  on E:Exception do BugReport(E,nil,'PathAddDir');
 end;
end;

function PathAddDirEnv(const Dir:LongString; AddFirst:Boolean=false; Check:Boolean=true; Delim:Char=PathSep):Boolean;
begin
 Result:=SetEnv('PATH',PathAddDir(GetEnvVar('PATH'),Dir,AddFirst,Check,Delim));
end;

procedure PathAddDirEnvFromIni(const IniFile,Section,VarName,BaseFile:LongString; First:Boolean=false);
var sect:TText; i:Integer; s:LongString;
begin
 if IsNonEmptyStr(IniFile) then
 if IsNonEmptyStr(Section) then
 if IsNonEmptyStr(VarName) then
 try
  sect:=ExtractListSection(IniFile,Section,efConfigNC);
  try
   for i:=0 to sect.Count-1 do
   if IsSameText(ExtractWord(1,sect[i],ScanSpaces),VarName) then begin
    s:=CookieScan(sect[i],VarName,Ord(PathSep)+csm_Default);
    if (s='') then continue;
    s:=SmartFileRef(s,'',BaseFile);
    if DirExists(s) then PathAddDirEnv(s,First);
   end;
  finally
   Kill(sect);
  end;
 except
  on E:Exception do BugReport(E,nil,'PathAddDirEnvFromIni');
 end;
end;

function SmartFileRef(const FileRef   : LongString;
                      const DefExt    : LongString;
                      const BaseFile  : LongString;
                      const UserHome  : LongString;
                      const ProgHome  : LongString;
                      const Brackets  : LongString;
                            handleUrl : Boolean
                                    ) : LongString;
begin
 Result:=Trim(FileRef);
 if (Length(Result)>0) then begin
  Result:=Trim(ExpEnvFilter(Result,CalcExpEnvBrackets(Brackets),handleUrl));
  if (Length(ProgHome)>0) then
  if IsSameText(Copy(Result,1,Length(ProgHome)),ProgHome)
  then Result:=HomeDir+Copy(Result,Length(ProgHome)+1,Length(Result));
  if (Length(UserHome)>0) then
  if IsSameText(Copy(Result,1,Length(UserHome)),UserHome)
  then Result:=UserHomeDir+Copy(Result,Length(UserHome)+1,Length(Result));
  if IsNonEmptyStr(DefExt)
  then Result:=DefaultExtension(Result,Trim(DefExt));
  if IsNonEmptyStr(BaseFile)
  then Result:=DefaultPath(Result,ExtractFilePath(Trim(BaseFile)));
  Result:=UnifyFileAlias(Result);
  Result:=FExpand(Result);
 end;
end;

function SmartFileRel(const FileRef   : LongString;
                      const BaseFile  : LongString;
                      const UserHome  : LongString;
                      const ProgHome  : LongString;
                      const Brackets  : LongString;
                            handleUrl : Boolean
                                    ) : LongString;
var Template:LongString;
begin
 Result:=Trim(FileRef);
 if (Length(Result)>0) then begin
  Result:=Trim(ExpEnvFilter(Result,CalcExpEnvBrackets(Brackets),handleUrl));
  Template:=AddPathDelim(HomeDir);
  if (Length(ProgHome)>0) then
  if (Length(Result)>Length(Template)) then
  if IsSameText(Copy(Result,1,Length(Template)),Template) then begin
   Result:=AddPathDelim(ProgHome)+Copy(Result,Length(Template)+1,Length(Result));
   Exit;
  end;
  Template:=AddPathDelim(UserHomeDir);
  if (Length(UserHome)>0) then
  if (Length(Result)>Length(Template)) then
  if IsSameText(Copy(Result,1,Length(Template)),Template) then begin
   Result:=AddPathDelim(UserHome)+Copy(Result,Length(Template)+1,Length(Result));
   Exit;
  end;
  Result:=MakeRelativePath(FileRef,BaseFile);
 end;
end;

function SmartFileSearch(const FileName   : LongString;
                         const PathVarStr : LongString;
                         const PathExtVar : LongString;
                         const PathExtStr : LongString
                                        ) : LongString;
var i:SizeInt; ExtList,PathList:LongString; Delims:TCharSet;
begin
 Result:='';
 if IsNonEmptyStr(FileName) then
 if IsNonEmptyStr(PathVarStr) then
 try
  ExtList:='';
  PathList:='';
  try
   Delims:=ScanSpaces+[PathSep];
   for i:=1 to WordCount(PathVarStr,Delims) do begin
    PathList:=PathList+SysUtils.Trim(GetEnv(ExtractWord(i,PathVarStr,Delims)));
    if (Length(PathList)>0) then
    if (Copy(PathList,Length(PathList),1)<>PathSep) then PathList:=PathList+PathSep;
   end;
   if (Length(PathList)>0) then begin
    // Note: Unix don`t use exe file extensions
    if HasExtension(FileName,i) or not IsWindows
    then Result:=SysUtils.FileSearch(FileName,PathList) else begin
     ExtList:=LoCaseStr(GetEnv(PathExtVar));
     if (Length(ExtList)=0) then ExtList:=LoCaseStr(PathExtStr);
     for i:=1 to WordCount(ExtList,Delims) do begin
      Result:=SysUtils.FileSearch(DefaultExtension(FileName,ExtractWord(i,ExtList,Delims)),PathList);
      if IsNonEmptyStr(Result) then Break;
     end;
    end;
   end;
  finally
   ExtList:='';
   PathList:='';
  end;
 except
  on E:Exception do BugReport(E,nil,'SmartFileSearch');
 end;
end;

function AddSearchPath(const EnvVar,Path:LongString; First:Boolean=false):LongString;
var PathList:TStringList; dir:LongString;
begin
 Result:='';
 if IsNonEmptyStr(Path) then
 if IsNonEmptyStr(EnvVar) then
 try
  PathList:=TStringList.Create;
  try
   PathList.Text:=SysUtils.Trim(StringReplace(GetEnv(EnvVar),PathSep,EOL,[rfReplaceAll]));
   dir:=GetRealFilePathName(UnifyFileAlias(DropPathDelim(AdaptFileName(Path))));
   if (PathList.IndexOf(dir)<0) and DirExists(dir) then begin
    if First then PathList.Insert(0,dir) else PathList.Add(dir);
    if not SetEnv(EnvVar,StringReplace(PathList.Text,EOL,PathSep,[rfReplaceAll])) then Exit;
   end;
   Result:=GetEnv(EnvVar);
  finally
   Kill(PathList);
  end;
 except
  on E:Exception do BugReport(E,nil,'AddSearchPath');
 end;
end;

function RemSearchPath(const EnvVar,Path:LongString):LongString;
var PathList:TStringList; dir:LongString;
begin
 Result:='';
 if IsNonEmptyStr(Path) then
 if IsNonEmptyStr(EnvVar) then
 try
  PathList:=TStringList.Create;
  try
   PathList.Text:=SysUtils.Trim(StringReplace(GetEnv(EnvVar),PathSep,EOL,[rfReplaceAll]));
   dir:=GetRealFilePathName(UnifyFileAlias(DropPathDelim(AdaptFileName(Path))));
   if (PathList.IndexOf(dir)>=0) then begin
    PathList.Delete(PathList.IndexOf(dir));
    if not SetEnv(EnvVar,StringReplace(PathList.Text,EOL,PathSep,[rfReplaceAll])) then Exit;
   end;
   Result:=GetEnv(EnvVar);
  finally
   Kill(PathList);
  end;
 except
  on E:Exception do BugReport(E,nil,'RemSearchPath');
 end;
end;

{$IFNDEF WINDOWS}
function GetFileVersionInfoAsText(FileName:LongString):LongString;
var FileVerInfo:TFileVersionInfo;
begin
 Result:='';
 try
  FileVerInfo:=TFileVersionInfo.Create(nil);
  try
   if IsNonEmptyStr(FileName)
   then FileVerInfo.FileName:=Trim(FileName);
   FileVerInfo.ReadFileInfo;
   Result:=FileVerInfo.VersionStrings.Text;
  finally
   FileVerInfo.Free;
  end;
 except
  on E:Exception do BugReport(E,nil,'GetFileVersionInfoAsText');
 end;
end;
{$ELSE}
function GetFileVersionInfoAsText(FileName:LongString):LongString;
type
 PLangAndCP = ^TLangAndCP;
 TLangAndCP = packed record wLanguage,wCodePage:Word; end;
const
 InfoStr : array [1..10] of PChar = ('CompanyName', 'FileDescription',
 'FileVersion', 'InternalName', 'LegalCopyright', 'LegalTradeMarks',
 'OriginalFilename', 'ProductName', 'ProductVersion', 'Comments');
var
  Buffer,Value:PChar; BufLen,i:Integer; ZValue,LangLen,Len:Cardinal;
  Lang:PLangAndCP; SubBlock:LongString;
begin
 Result:='';
 try
  Buffer:=nil;
  try
   ZValue:=0; LangLen:=0; Len:=0; Lang:=nil; Value:=nil;
   BufLen:=GetFileVersionInfoSize(PChar(FileName),ZValue);
   if BufLen>0 then begin
    GetMem(Buffer,BufLen);
    if GetFileVersionInfo(PChar(FileName),0,BufLen,Buffer) then begin
     if VerQueryValue(Buffer,PChar('\\VarFileInfo\\Translation'),Pointer(Lang),LangLen) then
     for i:= Low(InfoStr) to High(InfoStr) do begin
      SubBlock:=Format('\\StringFileInfo\\%.4x%.4x\\'+InfoStr[i],[Lang.wLanguage,Lang.wCodePage]);
      if VerQueryValue(Buffer,PChar(SubBlock),Pointer(Value),Len) then begin
       Result:=Result+Format('%-16s = %s',[InfoStr[i],Value])+EOL;
       continue;
      end;
      SubBlock:=Format('\\StringFileInfo\\%.4x%.4x\\'+InfoStr[i],[0,Lang.wCodePage]);
      if VerQueryValue(Buffer,PChar(SubBlock),Pointer(Value),Len) then begin
       Result:=Result+Format('%-16s = %s',[InfoStr[i],Value])+EOL;
       continue;
      end;
     end;
    end;
   end;
  finally
   if Assigned(Buffer) then FreeMem(Buffer);
  end;
 except
  on E:Exception do BugReport(E,nil,'GetFileVersionInfoAsText');
 end;
end;
{$ENDIF}

{$IFDEF WINDOWS}
function GetLongPathName(lpszShortPath,lpszLongPath:PChar; cchBuffer:DWORD):DWORD;stdcall;
type  ft=function(lpszShortPath,lpszLongPath:PChar; cchBuffer:DWORD):DWORD;stdcall;
const fn:ft=nil;
begin
 if not Assigned(fn) then @fn:=GetProcAddress(GetModuleHandle('kernel32.dll'),'GetLongPathNameA');
 if Assigned(fn) then Result:=fn(lpszShortPath,lpszLongPath,cchBuffer) else Result:=0;
end;

function GetShortPathName(lpszLongPath,lpszShortPath:PChar; cchBuffer:DWORD):DWORD;stdcall;
type  ft=function(lpszLongPath,lpszShortPath:PChar; cchBuffer:DWORD):DWORD;stdcall;
const fn:ft=nil;
begin
 if not Assigned(fn) then @fn:=GetProcAddress(GetModuleHandle('kernel32.dll'),'GetShortPathNameA');
 if Assigned(fn) then Result:=fn(lpszLongPath,lpszShortPath,cchBuffer) else Result:=0;
end;
{$ENDIF WINDOWS}

{$IFDEF WINDOWS}
function GetRealFilePathName(const FileName:LongString; BuffSize:Integer=MAX_PATH; Mode:Integer=0):LongString;
 function GetFQPN(const FileName:LongString):LongString;
 var Handle:THandle; FindData:TWin32FindData; i:Integer;
 begin
  Result:=FileName;
  SafeFillChar(FindData,SizeOf(FindData),0);
  if (Length(Result)>0) then
  for i:=Length(Result) downto 1 do begin
   if (Result[i] in ['\',':','/']) then begin
    if (Result[i]=':') then begin
     if (i=2) then // Drive name X:
     if (Result[i-1] in ['a'..'z'])
     then Result[i-1]:=UpCase(Result[i-1]);
     Break;
    end;
    if (i=2) then begin // UNC \\name
     if (Result[i] in ['\','/']) then
     if (Result[i-1] in ['\','/']) then Break;
    end;
    if (i=Length(Result)) then begin // Trail \
     Result:=GetFQPN(Copy(Result,1,i-1))+Result[i];
     Break;
    end;
    Handle:=Windows.FindFirstFile(PChar(Result),FindData);
    if (Handle<>INVALID_HANDLE_VALUE) then begin
     Windows.FindClose(Handle);
     Result:=GetFQPN(Copy(Result,1,i-1))+Result[i]+FindData.cFileName;
     Break;
    end;
    Break;
   end;
  end;
 end;
var i,err:Integer; Dummy:PChar; Temp,Buff:LongString;
begin
 Result:=FileName;
 if (Mode=0) then Mode:=DefaultGetRealFilePathNameMode;
 if (Mode<>0) and (Length(Result)>0) then            // Skip empty and
 if (Pos('*',Result)=0) and (Pos('?',Result)=0) then // Skip wildcards
 try
  err:=GetLastError; Dummy:=nil; Buff:=''; Temp:='';
  try
   SetLength(Buff,BuffSize); // Use as temporary buffer
   if ((Mode and fm_ReplaceSlash)<>0) then begin // Replace / to \
    for i:=1 to Length(Result) do if (Result[i]='/') then Result[i]:='\';
   end;
   if ((Mode and fm_ApplyFExpand)<>0) then begin // GetFullPathName
    SetString(Temp,PChar(Buff),GetFullPathName(PChar(Result),Length(Buff),PChar(Buff),Dummy));
    if (Length(Temp)>0) then Result:=Temp;
   end;
   if ((Mode and fm_ApplyGLongFN)<>0) then begin // GetLongPathName
    SetString(Temp,PChar(Buff),GetLongPathName(PChar(Result),PChar(Buff),Length(Buff)));
    if (Length(Temp)>0) then Result:=Temp;
   end;
   if ((Mode and fm_ApplyFind1st)<>0) then begin // Fully Qualified Path Name
    Result:=GetFQPN(Result);
   end;
  finally
   SetLastError(err);
   Temp:='';Buff:='';
  end;
 except
  on E:Exception do BugReport(E,nil,'GetRealFilePathName');
 end;
end;
{$ENDIF WINDOWS}
{$IFDEF UNIX}
function GetRealFilePathName(const FileName:LongString; BuffSize:Integer=MAX_PATH; Mode:Integer=0):LongString;
begin
 Result:=FileName;
 if (Mode=0) then Mode:=DefaultGetRealFilePathNameMode;
 if (Mode<>0) and (Length(Result)>0) then            // Skip empty and
 if (Pos('*',Result)=0) and (Pos('?',Result)=0) then // Skip wildcards
 try
  if HasFlags(Mode,fm_ReplaceSlash) then Result:=ValidatePathDelim(Result);
  if HasFlags(Mode,fm_ApplyFExpand) then Result:=FExpand(Result);
  if HasFlags(Mode,fm_ReadSymLinks) then Result:=ReadSymLink(Result);
 except
  on E:Exception do BugReport(E,nil,'GetRealFilePathName');
 end;
end;
{$ENDIF UNIX}

function ReadSymLink(const FileName:LongString; MaxLevel:Integer=10):LongString;
var Target:LongString;
begin
 Result:=Trim(FileName); if (Result='') then Exit;
 while FileGetSymLinkTarget(Result,Target) do begin
  Result:=Target; Dec(MaxLevel);
  if (MaxLevel<0) then Break;
 end;
end;

function ValidatePathList(const PathList:LongString; Delim:Char=PathSep):LongString;
var List:TStringList; i,j,k:Integer;
begin
 Result:=PathList;
 if (Result<>'') then
 try
  List:=TStringList.Create;
  try
   if IsUnix and (Delim=':') and (Pos(';',Result)>0)
   then Result:=StringReplace(Result,';',Delim,[rfReplaceAll]);
   List.Text:=StringReplace(ValidateEOL(Result),Delim,EOL,[rfReplaceAll]);
   // Iteration 1 - Validate directory file names                                          
   for i:=List.Count-1 downto 0 do List[i]:=GetRealFilePathName(DropPathDelim(AdaptFileName(List[i])));
   // Iteration 2 - Drop empty items
   for i:=List.Count-1 downto 0 do if (List[i]='') then List.Delete(i);
   // Iteration 3 - Drop items which not exists
   for i:=List.Count-1 downto 0 do if not DirExists(List[i]) then List.Delete(i);
   // Iteration 4 - Drop dublicate items
   for i:=List.Count-1 downto 0 do begin
    k:=0; for j:=0 to i-1 do if SameText(List[i],List[j]) then inc(k);
    if (k>0) then List.Delete(i);
   end;
   Result:=StringReplace(SysUtils.Trim(List.Text),EOL,Delim,[rfReplaceAll]);
  finally
   Kill(List);
  end;
 except
  on E:Exception do BugReport(E,nil,'ValidatePathList');
 end;
end;

function ValidateEnvPathList(const EnvPathList:LongString; Delim:Char=PathSep):Integer;
var i:Integer; w,v:LongString;
begin
 Result:=0;
 for i:=1 to WordCount(EnvPathList,ScanSpaces) do begin
  w:=ExtractWord(i,EnvPathList,ScanSpaces);
  if IsEmptyStr(GetEnv(w)) then Continue;
  v:=ValidatePathList(GetEnv(w),Delim);
  if SetEnv(w,v) then Inc(Result);
 end;
end;

function file_which(name:LongString):LongString;
begin
 Result:='';
 name:=Trim(name);
 if (name='') then Exit;
 if (LastDelimiter(DosDelimiters,name)=0) // if has no file path
 then Result:=Trim(FileSearch(name,GetEnv('PATH'),false)) else begin
  Result:=name;
  if IsUnix then Result:=UnifyFileAlias(Result);
  if IsWindows then Result:=GetRealFilePathName(Result);
  if not FileExists(Result) then Result:='';
 end;
end;

function GetCrwKitExe:LongString;
var exe,dir,dirs:LongString; i:Integer; NeedUpdate:Boolean;
begin
 exe:=myCrwKitExe;
 NeedUpdate:=IsEmptyStr(exe) or not FileExists(exe);
 if NeedUpdate then begin
  if IsNonEmptyStr(exe) then exe:='';
  dirs:=GetEnv('PATH');
  for i:=1 to WordCount(TheCrwKitPathVars,ScanSpaces) do begin
   dir:=Trim(GetEnv(ExtractWord(i,TheCrwKitPathVars,ScanSpaces)));
   if (dir<>'') and DirectoryExists(dir) then dirs:=dirs+PathSeparator+dir;
  end;
  for i:=WordCount(TheCrwKitCheckList,ScanSpaces) downto 1 do begin
   exe:=ExtractWord(i,TheCrwKitCheckList,ScanSpaces);
   if IsWindows then exe:=ForceExtension(exe,'.exe');
   exe:=Trim(FileSearch(exe,dirs,false));
   if (exe<>'') and FileExists(exe)
   then Break else exe:='';
  end;
  myCrwKitExe:=exe;
 end;
 Result:=exe;
end;

function GetComSpec:LongString;
begin
 Result:=GetShell;
end;

function GetShell:LongString;
begin
 Result:='';
 if IsWindows then begin
  Result:=GetEnv('ComSpec');
  if (Result='') or not FileExists(Result)
  then Result:=FileSearch('cmd.exe',GetEnv('PATH'),false);
  if (Result='') or not FileExists(Result) then Result:='cmd';
 end else
 if IsUnix then begin
  Result:=GetEnv('SHELL');
  if (Result='') or not FileExists(Result)
  then Result:=FileSearch('bash',GetEnv('PATH'),false);
  if (Result='') or not FileExists(Result) then Result:='/bin/sh';
 end;
end;

function GetComSpecCmd(const CmdLine:LongString):LongString;
begin
 Result:=GetShellCmd(CmdLine);
end;

function GetShellCmd(const CmdLine:LongString):LongString;
begin
 Result:=GetShell;
 if IsUnix    then Result:=Trim(Result+' -c '+QArg(CmdLine));
 if IsWindows then Result:=Trim(Result+' /c '+Trim(CmdLine));
end;

procedure AddLineToListOfShells(List:TStringList; Line:LongString);
const BadChars='#!;&|`"?*%$';
begin
 Line:=Trim(Line);
 if IsEmptyStr(Line) then Exit;
 if not Assigned(List) then Exit;
 if HasChars(Line,BadChars) then Exit;
 if (List.IndexOf(Line)>=0) then Exit;
 List.Add(Line);;
end;

function ReadListOfShells:LongString;
var Lines,List:TStringList; i:Integer;
const etc_shells='/etc/shells';
begin
 Result:='';
 try
  List:=TStringList.Create;
  Lines:=TStringList.Create;
  try
   if IsUnix and FileIsReadable(etc_shells) then Lines.LoadFromFile(etc_shells);
   if IsUnix then Lines.Add(GetShell); if IsWindows then Lines.Add(GetComSpec);
   if IsWindows then Lines.Add(FileSearch('cmd.exe',GetEnv('PATH'),false));
   if IsWindows then Lines.Add(FileSearch('powershell.exe',GetEnv('PATH'),false));
   for i:=0 to Lines.Count-1 do AddLineToListOfShells(List,Lines[i]);
   Result:=List.Text;
  finally
   Lines.Free;
   List.Free;
  end;
 except
  on E:Exception do BugReport(E,nil,'ReadListOfShells');
 end;
end;

const
 TheListOfShells:LongString='';

procedure InitListOfShells;
begin
 GetListOfShells(glosh_Refresh);
end;

procedure FreeListOfShells;
begin
 TheListOfShells:='';
end;

function GetListOfShells(Mode:Integer=glosh_Default):LongString;
var List:TStringList; Item:LongString; i:Integer;
begin
 Result:=''; List:=nil;
 try
  if HasFlags(Mode,glosh_Refresh) then TheListOfShells:='';
  if (TheListOfShells='') then TheListOfShells:=ReadListOfShells;
  Result:=TheListOfShells;
  if HasFlags(Mode,glosh_IfExist or glosh_DelPath) then
  try
   List:=TStringList.Create;
   for i:=1 to WordCount(Result,EolnDelims) do begin
    Item:=ExtractWord(i,Result,EolnDelims);
    if HasFlags(Mode,glosh_IfExist) and not FileIsReadable(Item) then Continue;
    if HasFlags(Mode,glosh_DelPath) then Item:=ExtractFileNameExt(Item);
    if (Item<>'') and (List.IndexOf(Item)<0) then List.Add(Item);
   end;
   Result:=List.Text;
  finally
   List.Free;
  end;
 except
  on E:Exception do BugReport(E,nil,'GetListOfShells');
 end;
end;

function GetCommandLine:LongString;
{$IFDEF UNIX}var cmd,w:LongString; iw:Integer;{$ENDIF ~UNIX}
begin
 {$IFDEF WINDOWS}
 Result:=WideToStr(Windows.GetCommandLineW);
 {$ENDIF ~WINDOWS}
 {$IFDEF UNIX}
 Result:='';
 cmd:=StringFromFile('/proc/self/cmdline',0);
 if (cmd<>'') then
 for iw:=1 to WordCount(cmd,[#0]) do begin
  w:=ExtractWord(iw,cmd,[#0]);
  if HasChars(w,[' ',ASCII_TAB])
  then w:=AnsiQuotedStr(w,QuoteMark);
  if (Result='') then Result:=w else Result:=Result+' '+w;
 end;
 Result:=Trim(Result);
 {$ENDIF ~UNIX}
end;

function ValidateEnvTmpDir:Boolean;
const DirList='/tmp,/var/tmp';
var i:Integer; dir:LongString;
begin
 Result:=false;
 if IsUnix then begin
  if not DirExists(GetEnv('TMPDIR')) then begin
   for i:=1 to WordCount(DirList,ScanSpaces) do begin
    dir:=ExtractWord(i,DirList,ScanSpaces);
    if DirExists(dir) then begin
     if SetEnv('TMPDIR',dir)
     then Break;
    end;
   end;
  end;
  Result:=DirExists(GetEnv('TMPDIR'));
 end;
end;

procedure InitStartupInfo;
begin
 if not System.IsLibrary then begin
  myProgName:=UnifyFileAlias(ParamStr(0));
  myProgBaseName:=ExtractBaseName(myProgName);
  myHomeDir:=ExtractFileDir(myProgName);
  myUserHomeDir:=DropPathDelim(GetUserDir);
  myStartAtDir:=UnifyFileAlias(GetCurrDir);
  mySysIniFile:=UnifyFileAlias(ForceExtension(myProgName,'.ini'));
  myTempDir:=LocalTempDir;
  GetCrwKitExe;
 end;
end;

procedure FreeStartupInfo;
begin
 myProgName:='';
 myHomeDir:='';
 myUserHomeDir:='';
 myStartAtDir:='';
 mySysIniFile:='';
 myTempDir:='';
 myCrwKitExe:='';
end;

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

procedure Init_crw_fio;
begin
 dlc_CfgCache;
 Std_IO_Initialization;
 ValidateEnvTmpDir;
 InitStartupInfo;
 InitDebugOut;
 InitConfigFiles;
 InitListOfShells;
end;

procedure Free_crw_fio;
begin
 FreeListOfShells;
 DoneConfigFiles;
 DoneDebugOut;
 FreeStartupInfo;
 Std_IO_Finalization;
 ResourceLeakageLog(Format('%-60s = %d%s',['ReadIniKeyFmtErrors',ReadIniKeyFmtErrors,ReadIniKeyFmtBugs]));
end;

initialization

 Init_crw_fio;

finalization

 Free_crw_fio;

end.

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

