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

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

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// 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    //
// 20201123 - Created by A.K.                                                 //
// 20230501 - Modified for FPC (A.K.)                                         //
////////////////////////////////////////////////////////////////////////////////

unit _crw_fio; { file input / output }

{$I _crw_sysdef}

{$IOCHECKS OFF}

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

interface

uses
 _crw_sharemem, // NB: THIS UNIT MUST BE FIRST !!!
 {$IFDEF UNIX} cthreads, dl, {$ENDIF}
 {$IFDEF WINDOWS} windows, {$ENDIF}
 sysutils, classes, contnrs, math, fileutil, {types, lclintf,}
 {$IFDEF WINDOWS} registry, comobj, shlobj, activex, winsock, accctrl, aclapi, {$ENDIF}
 _crw_alloc, _crw_fifo, _crw_rtc, _crw_str, _crw_dynar, {_crw_lm,} _crw_base64,
 _crw_hash, _crw_hl;

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

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

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

 {
 Standard Input / Output files should be redirected to FIFO in GUI mode.
 }
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.

 // 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
 **********************
 }

{$IFNDEF WINDOWS}
const // Marker for file errors.
 INVALID_HANDLE_VALUE = THandle(-1);
{$ENDIF  WINDOWS}

 {
 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;

 {
 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;

 {
 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;

 {
 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;

 {
 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;

 {
 Simulate Delphi`s stuff.
 }
procedure SetInOutRes(Res:Word);

 {
 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:ShortString; 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:ShortString; 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;

{$IFDEF SKIP_DRAFT}

 {
 *****************
 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:ShortString);
procedure DebugOutText(n:byte; const S:LongString);

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

 {
 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    : ShortString;
                           FifoSize    : Integer = 1024*64;
                           FlushPeriod : Integer = 0;
                           CreateNew   : boolean = true;
                           Hello       : boolean = false);

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

const
 DebugOutFifoSize       : Integer = 1024*64;
 DebugOutFifoGrowFactor : Integer = 2;
 DebugOutFifoGrowLimit  : Integer = 1024*1024*4;

 {
 **************************************
 Функции чтения конфигурационных файлов
 **************************************
 }
 {
 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;             {удаление комментариев}
 efAsIs     = 0;                 {'как есть', без купюр и преобразований}
 {стандартный для конфигурационных файлов}
 efConfig   = efUpCase+efLTrim+efRTrim+efDelCom;
 efConfigNC = efConfig and not efCaseMask;
 esComments = [';'];             {эти символы - признак начала комментариев}
 ConfigCacheLimit        : LongInt  = MegaByte;
 ConfigCacheCheck        : Cardinal = 1000;
 ConfigCacheHoldingTime  : Cardinal = 0;
 ConfigCacheHasherMethod : Integer  = 0;
 ConfigFileMaxRecursionLevel        = 8;
 idConfigFile                       = 'CONFIGFILE';
 idConfigFileList                   = '[CONFIGFILELIST]';

function  ConfigCacheSnapshot(mode:Integer=0):LongString;
function  FreeConfigCache(MaxSize:LongInt):LongInt;
procedure ResetConfigCache;
procedure CheckConfigCache;
function  ExtractListSection(const FileName            : ShortString;
                             const SectionName         : ShortString;
                                   ExtractSectionFlags : Word) : TText;
function  ExtractTextSection(const FileName            : ShortString;
                             const SectionName         : ShortString;
                                   ExtractSectionFlags : Word) : LongString;
function ConstructFullConfig(const FileName:ShortString):TText;
function ExtractWordList(const FileName            : ShortString;
                         const SectionName         : ShortString;
                               ExtractSectionFlags : word;
                               WordIndex           : word;
                         const Delimiters          : TCharSet ) : TText;
function ExtractEnumWordList(const IniFile             : ShortString;
                             const SectionName         : ShortString;
                             const Prefix              : ShortString;
                                   ExtractSectionFlags : word) : TText;
function ExtractSectionTitle(const Line:ShortString; var Title:ShortString):boolean;

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

 {
 ReadIniFileVariable  Чтение переменной из Ini-файла
                      Name%b boolean
                      Name%f double
                      Name%d LongInt
                      Name%w word
                      Name%i integer
                      Name%s strind
 Пример 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    : ShortString;
                             const SectionName : ShortString;
                             const Format      : ShortString;
                               var Data;
                                   efMode      : Integer = efConfig;
                                   svMode      : Integer = svConfig
                                              ):Boolean;

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

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

{$ENDIF SKIP_DRAFT}

 {
 *****************************
 Special directories and files
 *****************************
 }
function  ProgName:LongString;               { Full program file name }
function  HomeDir:LongString;                { Home directory, where program placed }
function  StartupPath:LongString;            { Home directory, where program started }
function  StartAtDir:LongString;             { Current dir, when program start to work }
function  SysIniFile:LongString;             { File where program ini params must be placed }
procedure GoHome;                            { Change dir to home directory }
{$IFDEF WINDOWS}
function  WindowsDir:LongString;             { Where windows placed, such as c:\windows }
function  WindowsSystemDir:LongString;       { Windows system dir, such as c:\windows\system }
function  WindowsTempDir:LongString;         { Windows temporary files directory }
{$ENDIF WINDOWS}
function  GlobalTempDir:LongString;          { Global (system) temporary directory }
function  LocalTempDir:LongString;           { Local (current user) temporary directory }
function  TempDir:LongString;                { Program temporary directory }
procedure SetTempDir(const Dir:LongString);  { Setup program temporary directory }

{$IFDEF SKIP_DRAFT}
function  CreateTempFile(const Template:LongString='###.TMP'):LongString;
function  UserName:LongString;              { Current user name }
function  ComputerName:LongString;          { Computer name}
function  HostName(Method:Integer=0):ShortString; { User host name 0:simple, 1:full }
function  UserDomain(const aUser:ShortString=''):ShortString; { User domain }
function  GetIPAddress(const aHostName:ShortString=''):ShortString; { IP addr  }
function  GetMacAddresses(const Machine:ShortString=''):ShortString; { MAC list }

 {
 ***********************************************************
 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;
{$IFNDEF SKIP_DRAFT}FILTER_NORMAL_ACCOUNT=0;{$ENDIF}
{$IFNDEF SKIP_DRAFT}SV_TYPE_ALL=0;{$ENDIF}

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.

 //
 // 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
 //
{$IFDEF WINDOWS}
function  GetRootKeyByName(const Key:LongString):HKEY;
function  ReadRegistryString(RootKey:HKEY; const Key,Name:ShortString):LongString;
function  WriteRegistryString(RootKey:HKEY; const Key,Name,Data:LongString):String;
function  ReadRegistryMultiStrings(RootKey:HKey; const Key,Name:LongString; Delim:Char=ASCII_CR):LongString;
function  GetWindowsShellFolder(const Name:ShortString):ShortString;
function  GetWindowsShellDesktop:ShortString;      // Windows shell Desktop
function  GetWindowsShellPrograms:ShortString;     // Windows shell Programs menu
function  GetWindowsShellStartup:ShortString;      // Windows shell Startup menu
function  GetWindowsShellStartMenu:ShortString;    // Windows shell Start menu
function  GetWindowsShellFavorites:ShortString;    // Windows shell Favorites
function  GetWindowsShellFonts:ShortString;        // Windows shell Fonts
function  GetWindowsShellHistory:ShortString;      // Windows shell History
function  GetWindowsShellPersonal:ShortString;     // Windows shell My Documents
function  GetWindowsShellSendTo:ShortString;       // Windows shell Send To
procedure CreateFileLink(const ObjectPath, LinkPath, Description, Params: ShortString);
{$ENDIF WINDOWS}

 //
 // 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; BuffSize:Integer=1024*32):LongString;  // ExpandEnvironmentStrings
function GetEnvVar(const Name:LongString; BuffSize:Integer=1024*16):LongString;

const
 BigEnvBuffSize = 1024*64; // For potencially big environment variables like PATH
 TheEnvironmentStrings : PChar = nil; // Just to save initial GetEnvironmentStrings

 //
 // 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=';'):LongString;
function PathAddDirEnv(const Dir:LongString; AddFirst:Boolean=false; Check:Boolean=true; Delim:Char=';'):Boolean;
procedure PathAddDirEnvFromIni(const IniFile,Section,VarName,BaseFile:ShortString; 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
 DefaultPathExt    = '.COM;.EXE;.BAT;.CMD;.VBS;.VBE;.JS;.JSE;.WSF;.WSH';
 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):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;

 {
 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;

 {
 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

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

 {
 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=';'):LongString;

{$ENDIF SKIP_DRAFT}

implementation

{$IFDEF SKIP_DRAFT}
uses
 _Polling;
{$ENDIF SKIP_DRAFT}

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

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

function NullOutput(var F: TTextRec): Integer;
begin
 Result:=0;
 F.BufPos:=0;
 F.BufEnd:=0;
end;

function NullInput(var F: TTextRec): Integer;
begin
 Result:=0;
 F.BufPos:=0;
 F.BufEnd:=0;
end;

function NullFlush(var F: TTextRec): Integer;
begin
 Result:=0;
 F.BufPos:=0;
 F.BufEnd:=0;
end;

function NullClose(var F: TTextRec): Integer;
begin
 Result:=0;
 F.BufPos:=0;
 F.BufEnd:=0;
end;

function NullOpen(var F: TTextRec): Integer;
begin
 Result:=0;
 if (F.Mode=fmInput) then begin
  F.InOutFunc:=@NullInput;
  F.FlushFunc:=@NullFlush;
 end else begin
  F.Mode:=fmOutput;
  F.InOutFunc:=@NullOutput;
  F.FlushFunc:=@NullOutput;
 end;
 F.CloseFunc:=@NullClose;
end;

procedure AssignNull(var T:Text);
begin
 Assign(T,'NULL:');
 TTextRec(T).OpenFunc:=@NullOpen;
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;

const
 FifoMagicSign = $0123456789ABCDEF;

function GetTextFifo(var F: TTextRec):TFifo; inline;
begin
 with PFifoData(@F.UserData)^ do
 if (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
 PFifoData(@F.UserData)^.Fifo:=Fifo;
 PFifoData(@F.UserData)^.Safe:=(not PointerToPtrUInt(Fifo));
 PFifoData(@F.UserData)^.Sign:=FifoMagicSign;
end;

function FifoOutput(var F: TTextRec): Integer;
var
 Fifo : TFifo;
begin
 Fifo:=GetTextFifo(F);
 if Assigned(Fifo) and (Fifo.Put(F.BufPtr,F.BufPos)=F.BufPos)
 then Result:=0
 else Result:=1;
 F.BufPos:=0;
 F.BufEnd:=0;
end;

function FifoInput(var F: TTextRec): Integer;
var
 Fifo : TFifo;
begin
 F.BufPos:=0;
 F.BufEnd:=0;
 Fifo:=GetTextFifo(F);
 if Assigned(Fifo) then begin
  inc(F.BufEnd,Fifo.Get(F.BufPtr,F.BufSize));
  Result:=0;
 end else begin
  Result:=1;
 end;
end;

function FifoFlush(var F: TTextRec): Integer;
begin
 Result:=0;
 F.BufPos:=0;
 F.BufEnd:=0;
end;

function FifoClose(var F: TTextRec): Integer;
begin
 Result:=0;
 F.BufPos:=0;
 F.BufEnd:=0;
end;

function FifoOpen(var F: TTextRec): Integer;
var
 Fifo : TFifo;
begin
 Fifo:=GetTextFifo(F);
 if Assigned(Fifo) then begin
  Result:=0;
  if F.Mode = fmInput then begin
   F.InOutFunc:=@FifoInput;
   F.FlushFunc:=@FifoFlush;
  end else begin
   if F.Mode=fmOutput then Fifo.Clear; { if rewrite called then clear fifo }
   F.Mode:=fmOutput;                   { !!! }
   F.InOutFunc:=@FifoOutput;
   F.FlushFunc:=@FifoOutput;
  end;
  F.CloseFunc:=@FifoClose;
 end else begin
  NullOpen(F);
  Result:=1;
 end;
end;

procedure AssignFifo(var T:Text; Fifo:TFifo=nil);
 function GetFifoName(Fifo:TFifo):LongString;
 begin
  if (Fifo.Name='')
  then Result:='FIFO:'
  else Result:=AddPathDelim('FIFO:','\')+Fifo.Name;
  if (Pos(':',Fifo.Name)>0) then Result:=Fifo.Name;
 end;
begin
 if Assigned(Fifo) then begin
  Assign(T,GetFifoName(Fifo));
  TTextRec(T).OpenFunc:=@FifoOpen;
  SetTextFifo(TTextRec(T),Fifo);
 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, string buffers for faster IO
 SaveInput     : Text;   BuffInput     : LongString;
 SaveOutput    : Text;   BuffOutput    : LongString;
 SaveErrOutput : Text;   BuffErrOutput : LongString;

procedure SetTextBufToString(var T:Text; var S:LongString);
const StdIoBuffSize=MaxTextBufSize;
begin
 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,['0','I','i']) 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,['1','O','o']) then
  if not Redirected(Output) then begin
   TTextRec(SaveOutput):=TTextRec(Output);
   AssignFifo(Output,StdOutputFifo);
   Rewrite(Output);
   SetTextBufToString(Output,BuffOutput);
  end;
  // Redirect Standard ErrOutput to FIFO
  if HasChars(What,['2','E','e']) then
  if not Redirected(ErrOutput) then begin
   TTextRec(SaveErrOutput):=TTextRec(ErrOutput);
   AssignFifo(ErrOutput,StdErrOutputFifo);
   Rewrite(ErrOutput);
   SetTextBufToString(ErrOutput,BuffErrOutput);
  end;
 end else begin
   // Redirect Standard Input back
  if HasChars(What,['0','I','i']) 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,['1','O','o']) 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,['2','E','e']) 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+'0';
 if Redirected(Output) then Result:=Result+'1';
 if Redirected(ErrOutput) then Result:=Result+'2';
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
 **********************
 }

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;

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 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 not IsEmptyStr(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 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 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 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
  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 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;

procedure SetInOutRes(Res:Word);
begin
 System.InOutRes:=Res;
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>128 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;

{$IFDEF SKIP_DRAFT}

 {
 *****************
 Debug file output
 *****************
 }
var
 DebugOutFifo : packed array[byte] of TFifo;
 DebugOutPoll : packed array[byte] of TPolling;

procedure DebugOutPollAction(aPolling:TPolling; var Terminate:Boolean);
 procedure FlushFifo(Fifo:TFifo);
 var
  F : Text;
  s : ShortString;
 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
    if FileExists(s) then System.Append(F) else System.Rewrite(F);
    while Fifo.Gets(s) do begin
     System.Writeln(F,s);
     if IOResult<>0 then Fifo.Lost:=Fifo.Lost+Length(s)+1;
    end;
   finally
    SmartFileClose(F);
    SetInOutRes(0);
   end;
  except
   on E:Exception do BugReport(E);
  end;
 end;
begin
 if aPolling.LinkObject is TFifo
 then FlushFifo(aPolling.LinkObject as TFifo)
 else Terminate:=true;
end;

procedure InitDebugOut;
begin
 SafeFillChar(DebugOutFifo, sizeof(DebugOutFifo), 0);
 SafeFillChar(DebugOutPoll, sizeof(DebugOutPoll), 0);
end;

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

procedure DebugOut(n:byte; const S:ShortString);
begin
 DebugOutFifo[n].Puts(S);
 DebugOutPoll[n].Awake;
end;

procedure DebugOutText(n:byte; const S:LongString);
var p:TText; i:Integer;
begin
 try
  p:=NewText;
  try
   p.Text:=S;
   for i:=0 to p.Count-1 do DebugOut(n,p[i]);
  finally
   Kill(p);
  end;
 except
  on E:Exception do BugReport(E);
 end;
end;

function DebugOutGetFile(n:byte):ShortString;
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);
 end;
end;

procedure DebugOutOpenFile(n           : byte;
                     const FileName    : ShortString;
                           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]);
 if not IsEmptyStr(FileName) then
 try
  DebugOutFifo[n]:=NewFifo(FifoSize,UnifyFileAlias(FileName));
  DebugOutFifo[n].Master:=DebugOutFifo[n];
  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;
   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;
  end;
 except
  on E:Exception do BugReport(E);
 end;
end;

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

 {
 Функция определяет, является ли строка заголовком секции по признакам
 1) Часть строки от символа ";" до конца строки считается комментарием и
    не принимается в расчет
 2) Первый символ, отличный от пробелов - "["
 3) Последний символ, отличный от пробелов - "]"
 4) В строке нет более одного символа "[" и одного символа "]"
 5) Символ "[" предшествует сиволу "]"
 Возвращает заголовок секции в строке Title
 }
function ExtractSectionTitle(const Line:ShortString; var Title:ShortString):boolean;
var i,start,stops:integer;
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));   {выделение заголовка}
 Result:=true;
end;

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

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

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

function TSection.Title:ShortString;
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,myTheText.MemUsed);
  inc(Result,myHotText.MemUsed);
  inc(Result,myTheText.InstanceSize);
  inc(Result,myHotText.InstanceSize);
 end;
end;

function SectionExtractByFlags(Dest,Source:TText; Flags:Word):TText;
var Line,i:integer; s:ShortString;
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:Word):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;
   finally
    Kill(Temp);
   end;
   Result:=myHotText.KeyedParams[key];
  end;
 end;
end;

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

constructor TSectionList.Create(const FileName:ShortString; aHasher:THash32Function);
begin
 inherited Create;
 myName:=UnifyFileAlias(FileName);
 myList:=NewHashList(true,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;

procedure GetFileParams(const FileName:LongString; var Attr:LongInt; var Size:LongInt; var Time:Int64);
var hFile:THandle;
begin
 Attr:=-1; Size:=-1; Time:=-1;
 if (FileName<>'') then
 try
  Attr:=LongInt(Windows.GetFileAttributes(PChar(FileName)));
  if Attr<>-1 then begin
   hFile:=Windows.CreateFile(PChar(FileName),GENERIC_READ,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
   if hFile<>INVALID_HANDLE_VALUE then
   try
    Size:=Windows.GetFileSize(hFile,nil);
    if not Windows.GetFileTime(hFile, nil, nil, @Time) then Time:=-1;
   finally
    Windows.CloseHandle(hFile);
   end;
  end;
 except
  on E:Exception do BugReport(E);
 end;
end;

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

procedure ScanSection(const FileName,Line:ShortString; Count:LongInt;
                        var Terminate:Boolean; CustomData:Pointer);
var SectionTitle:ShortString;
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:=Windows.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:ShortString):TSection;
var key:ShortString;
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:ShortString):TSection;
var key:ShortString;
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(key,myList.Hasher);
    Result:=TSection(myList.KeyedObjects[key]);
   end;
  end;
 except
  on E:Exception do BugReport(E,Self);
 end;
end;

function TSectionList.Changed:Boolean;
var aAttr,aSize:LongInt; aDate:Int64; aTick:Cardinal;
begin
 Result:=false;
 if Assigned(Self) then begin
  aTick:=Windows.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
 EConfigFileList=class(EFailException);
 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:ShortString):TSectionList;
  function    JustSectionList(const FileName:ShortString):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(true,aHasher);
 myList.OwnsObjects:=true;
 myCache:=NewHashList(true,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:ShortString):TSectionList;
var key:ShortString;
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:ShortString):TSectionList;
var key:ShortString;
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);
 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);
 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);
 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);
 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:=Windows.GetTickCount;
   Temp.Addln(Format('%s: -> Config Cache Shapshot information:',[FormatDateTime('yyyy.mm.dd-hh:nn:ss',Now)]));
   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],CRLF,' ',[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);
 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);
 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);
 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);
 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);
 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);
 end;
end;

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

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

procedure els_LoadFile(Index:LongInt; const TextLine:ShortString;
                  var Terminate:boolean; CustomData:Pointer);
var
 i   : integer;
 els : els_Rec;
begin
 els:=els_Rec(CustomData^);
 if not IsEmptyStr(TextLine) then begin
  if UnifyAlias(ExtractWord(1,TextLine,ScanSpaces))=idConfigFile then
  for i:=2 to WordCount(TextLine,ScanSpaces) do begin
   els.FileName:=ExtractWord(i,TextLine,ScanSpaces);
   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(efConfig);
  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            : ShortString;
                            const SectionName         : ShortString;
                                  ExtractSectionFlags : Word) : TText;
begin
 Result:=NewText;
 try
  Result.Text:=ExtractTextSection(FileName,SectionName,ExtractSectionFlags);
 except
  on E:Exception do BugReport(E);
 end;
end;

function ExtractTextSection(const FileName            : ShortString;
                            const SectionName         : ShortString;
                                  ExtractSectionFlags : Word ) : LongString;
var
 els : els_Rec; key:LongString; tick:Cardinal;
begin
 Result:='';
 try
  els.List:=TStringList.Create; els.List.Add(''); // NB!!!
  els.FilesDone:=NewHashList(true,GetHasherByIndex(ConfigCacheHasherMethod));
  els.FileName:=UnifyFileAlias(FileName);
  els.SectionName:=UnifyAlias(SectionName);
  els.ExtractSectionFlags:=ExtractSectionFlags;
  els.RecursionLevel:=0;
  els.Iterator:=els_Iterator;
  if ConfigCacheHoldingTime<>0 then begin
   key:=els.FileName+CRLF+els.SectionName+CRLF+IntToStr(els.ExtractSectionFlags)+CRLF;
   tick:=Windows.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);
 end;
end;

function ExtractTextSectionByPrefix(const FileName    : ShortString;
                                    const SectionName : ShortString;
                                    const Prefix      : ShortString;
                                          efMode      : Integer;
                                          svMode      : Integer;
                                          SubSections : Boolean) : LongString;
var List:TText; s:ShortString; i:Integer; Buff:array[0..255] of char;
begin
 Result:='';
 try
  if ReadIniFileVariable(FileName,SectionName,Prefix+'%s',s,efMode,svMode) then begin
   List:=ExtractListSection(FileName,SectionName,efMode);
   try
    for i:=0 to List.Count-1 do
    if ScanVar(svMode,StrPCopy(Buff,List[i]),Prefix+'%s',s)<>nil then
    if SubSections and IsSectionName(s)
    then Result:=Result+ExtractTextSection(FileName,s,efMode)
    else Result:=Result+s+CRLF;
   finally
    Kill(List);
   end;
  end;
 except
  on E:Exception do BugReport(E);
 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 Section.Title<>idConfigFileList then
  if Section.TheText.Count>0 then begin
   els.List.Add(Section.Title);
   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
  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(efConfig);
  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:ShortString):TText;
var
 els : els_Rec;
begin
 Result:=nil;
 try
  Result:=NewText;
  els.List:=TStringList.Create;
  els.FilesDone:=NewHashList(true,GetHasherByIndex(ConfigCacheHasherMethod));
  els.FileName:=UnifyFileAlias(FileName);
  els.SectionName:='[]';
  els.ExtractSectionFlags:=0;
  els.RecursionLevel:=0;
  els.Iterator:=cfc_Iterator;
  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);
 end;
end;

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

procedure ewl_AddName(Index:LongInt; const TextLine:ShortString;
                   var Terminate:boolean; CustomData:Pointer);
var Name:ShortString;
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            : ShortString;
                         const SectionName         : ShortString;
                               ExtractSectionFlags : word;
                               WordIndex           : word;
                         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);
 end;
end;

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

procedure eew_Make(Index:LongInt; const TextLine:ShortString;
               var Terminate:boolean; CustomData:Pointer);
var i:integer;
begin
 with eew_Rec(CustomData^) do
 if not IsEmptyStr(TextLine) then
 if 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             : ShortString;
                             const SectionName         : ShortString;
                             const Prefix              : ShortString;
                                   ExtractSectionFlags : word) : 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);
 end;
end;

 {
 контрольный вывод в файла отчета чтения ini-файла
 }
procedure IniFileLoggin(nLog    : byte;
                        Success : Boolean;
                  const IniFile : ShortString;
                  const Section : ShortString;
                  const Format  : ShortString;
                        Data    : Pointer);
var Ptr:Pointer; Fmt,Str:ShortString; 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(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+ShortString(Ptr^);
          Ptr:=IncPtr(Ptr,sizeof(ShortString));
         end;
     'a':begin
          if Str='' then Str:=LeftPad(' = ',w) else Str:=Str+', ';
          Str:=Str+ShortString(Ptr^);
          Ptr:=IncPtr(Ptr,sizeof(ShortString));
         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);
 end;
end;

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

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

function ReadIniFilePath(const FileName    : ShortString;
                         const SectionName : ShortString;
                         const Name        : ShortString;
                         const StartupPath : ShortString;
                           var Path        : ShortString;
                               handleUrl   : Boolean
                                          ):Boolean;
begin
 if ReadIniFileVariable(FileName,SectionName,Name+'%a',Path) then begin
  Path:=UnifyFileAlias(SmartFileRef(Path,'',AddBackSlash(StartupPath)+'*.*',sfrDefUserHome,sfrDefProgHome,sfrDefBrackets,handleUrl));
  Result:=true;
 end else begin
  Path:='';
  Result:=false;
 end;
end;

{$ENDIF SKIP_DRAFT}

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

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

function HomeDir:LongString;
begin
 Result:=myHomeDir;
end;

function UserHomeDir:LongString;
begin
 Result:=myUserHomeDir;
end;

function StartupPath:LongString;
begin
 Result:=myHomeDir;
end;

function StartAtDir:LongString;
begin
 Result:=myStartAtDir;
end;

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

procedure GoHome;
begin
 SetCurrentDir(HomeDir);
end;

{$IFDEF WINDOWS}
function WindowsDir:LongString;
var
 Buffer: array[0..MAX_PATH - 1] of Char;
begin
 SetString(Result,Buffer,Windows.GetWindowsDirectory(Buffer, MAX_PATH));
 Result:=DropBackSlash(Result);
end;

function WindowsSystemDir:LongString;
var
 Buffer: array[0..MAX_PATH - 1] of Char;
begin
 SetString(Result,Buffer,Windows.GetSystemDirectory(Buffer, MAX_PATH));
 Result:=DropBackSlash(Result);
end;

function WindowsTempDir:LongString;
var
 Buffer: array[0..MAX_PATH - 1] of Char;
begin
 SetString(Result,Buffer,Windows.GetTempPath(MAX_PATH, Buffer));
 Result:=DropBackSlash(Result);
end;
{$ENDIF WINDOWS}

function GlobalTempDir:LongString;
begin
 Result:=DropPathDelim(GetTempDir(true));
end;

function LocalTempDir:LongString;
begin
 Result:=DropPathDelim(GetTempDir(false));
end;

function TempDir:LongString;
begin
 Result:=myTempDir;
end;

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

{$IFDEF SKIP_DRAFT}

function  CreateTempFile(const Template:ShortString='###.TMP'):ShortString;
var
 lpPathName,lpPrefixString,lpTempFileName:array[0..MAX_PATH-1] of char;
 tmp:ShortString;
begin
 StrPCopy(lpPathName,TempDir);
 StrPCopy(lpPrefixString,Pad(Copy(ExtractFileName(Template),1,3),3,'#'));
 StrPCopy(lpTempFileName,'');
 if Windows.GetTempFileName(lpPathName,lpPrefixString,0,lpTempFileName)<>0
 then begin
  tmp:=UnifyFileAlias(StrPas(lpTempFileName));
  Result:=UnifyFileAlias(ForceExtension(tmp,ExtractFileExt(Template)));
  if tmp<>Result then if not FileRename(tmp,Result) then Result:=tmp;
 end else Result:='';
end;

function UserName:ShortString;
var
 Len : DWORD;
 Buf : packed array[0..255] of Char;
begin
 Result:='';
 try
  Len:=SizeOf(Buf);
  if Windows.GetUserName(Buf,Len) then Result:=StrPas(Buf);
 except
  on E:Exception do BugReport(E);
 end;
end;

function ComputerName:ShortString;
var
 Len : DWORD;
 Buf : packed array[0..255] of Char;
begin
 Result:='';
 try
  Len:=SizeOf(Buf);
  if Windows.GetComputerName(Buf,Len) then Result:=StrPas(Buf);
 except
  on E:Exception do BugReport(E);
 end;
end;

function HostName(Method:Integer):ShortString;
var
 WSAData  : TWSAData;
 Buffer   : packed array[0..MAX_PATH] of Char;
 HostEnt  : PHostEnt;
begin
 Result:='';
 try
  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 StrCopy(Buffer,HostEnt.h_name);
        end;
        Result:=StrPas(Buffer);
       end;
   end;
  finally
   WinSock.WSACleanup;
  end;
 except
  on E:Exception do BugReport(E);
 end;
end;

function UserDomain(const aUser:ShortString):ShortString;
var
 CurUser,Buff:array[0..MAX_PATH] of Char;
 Count1,Count2:DWORD; Sd:PSecurityDescriptor; Snu:SID_Name_Use;
begin
 Result:='';
 try
  if IsEmptyStr(aUser)
  then StrPCopy(CurUser,UserName)
  else StrPCopy(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);
 end;
end;

function GetIPAddress(const aHostName:ShortString):ShortString;
var
  WSAData  : TWSAData;
  HostEnt  : PHostEnt;
  Host     : array[0..MAX_PATH] of Char;
  SockAddr : TSockAddrIn;
begin
 Result := '';
 try
  if WinSock.WSAStartup(MakeWord(1,1),WSAData)=0 then
  try
   if IsEmptyStr(aHostName)
   then StrPCopy(Host,HostName)
   else StrPCopy(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);
 end;
end;

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;
 PAdapterStatus = ^TAdapterStatus;
 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;
 PNameBuffer = ^TNameBuffer;
 TNameBuffer = record
  name       : array [0..NCBNAMSZ - 1] of Char;
  name_num   : Byte;
  name_flags : Byte;
 end;
 PLanaEnum = ^TLanaEnum;
 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);
 end;
end;

function InitNetbios: Boolean;
begin
 Result:=false;
 try
  Result:=True;
  if NetBiosLib=0 then begin
   NetBiosLib := LoadLibrary(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);
 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);
 end;
end;

function AdapterToString(Adapter: TAdapterStatus):ShortString;
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:ShortString):ShortString;
var
 NCB         : TNCB;
 Enum        : TLanaEnum;
 I,L,NameLen : Integer;
 Adapter     : ASTAT;
 MachineName : LongString;
begin
 Result:='';
 try
  MachineName:=UpCaseStr(Trim(Machine));
  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;
  FillChar(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; 
 except
  on E:Exception do BugReport(E);
 end;
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:='\\'+SysUtils.Trim(aServer);
   if SameText(WServer,'\\') or SameText(WServer,'\\.') or SameText(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
     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:=WideString(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(WideString(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(WideString(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
    FillChar(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);
 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):ShortString;
 begin
  Result:='';
  Result:=AddBackSlash(Result);
  if a and SV_TYPE_WORKSTATION       <>0 then Result:=AddBackSlash(Result)+'WSt';
  if a and SV_TYPE_SERVER	     <>0 then Result:=AddBackSlash(Result)+'Srv';
  if a and SV_TYPE_SQLSERVER	     <>0 then Result:=AddBackSlash(Result)+'SQL';
  if a and SV_TYPE_DOMAIN_CTRL	     <>0 then Result:=AddBackSlash(Result)+'DomCtrl';
  if a and SV_TYPE_DOMAIN_BAKCTRL    <>0 then Result:=AddBackSlash(Result)+'DomBack';
  if a and SV_TYPE_TIME_SOURCE       <>0 then Result:=AddBackSlash(Result)+'TimSrc';
  if a and SV_TYPE_AFP               <>0 then Result:=AddBackSlash(Result)+'AFP';
  if a and SV_TYPE_NOVELL            <>0 then Result:=AddBackSlash(Result)+'Novell';
  if a and SV_TYPE_DOMAIN_MEMBER     <>0 then Result:=AddBackSlash(Result)+'DomMemb';
  if a and SV_TYPE_LOCAL_LIST_ONLY   <>0 then Result:=AddBackSlash(Result)+'LocList';
  if a and SV_TYPE_PRINTQ_SERVER     <>0 then Result:=AddBackSlash(Result)+'Prn';
  if a and SV_TYPE_DIALIN_SERVER     <>0 then Result:=AddBackSlash(Result)+'Deal';
  if a and SV_TYPE_XENIX_SERVER      <>0 then Result:=AddBackSlash(Result)+'Unix';
  if a and SV_TYPE_SERVER_MFPN       <>0 then Result:=AddBackSlash(Result)+'MFPN';
  if a and SV_TYPE_NT                <>0 then Result:=AddBackSlash(Result)+'WinNt';
  if a and SV_TYPE_WFW               <>0 then Result:=AddBackSlash(Result)+'WinFW';
  if a and SV_TYPE_SERVER_NT	     <>0 then Result:=AddBackSlash(Result)+'SrvNt';
  if a and SV_TYPE_POTENTIAL_BROWSER <>0 then Result:=AddBackSlash(Result)+'PBrow';
  if a and SV_TYPE_BACKUP_BROWSER    <>0 then Result:=AddBackSlash(Result)+'BBrow';
  if a and SV_TYPE_MASTER_BROWSER    <>0 then Result:=AddBackSlash(Result)+'MBrow';
  if a and SV_TYPE_DOMAIN_MASTER     <>0 then Result:=AddBackSlash(Result)+'DomMast';
  if a and SV_TYPE_DOMAIN_ENUM	     <>0 then Result:=AddBackSlash(Result)+'DomEnum';
  if a and SV_TYPE_WINDOWS	     <>0 then Result:=AddBackSlash(Result)+'Win9x';
  Result:=AddBackSlash(Result);
 end;
begin
 Result:='';
 if CanUseNetApi32 then
 try
  List:=NewText;
  try
   ResumeHandle:=0;
   StartTime:=msecnow;
   WDomain:=SysUtils.Trim(aDomain);
   WServer:='\\'+SysUtils.Trim(aServer);
   if SameText(WServer,'\\') or SameText(WServer,'\\.') or SameText(WServer,'\\localhost')
   then PWServer:=nil else PWServer:=PWideChar(WServer);
   if SameText(WDomain,'') then PWDomain:=nil else PWDomain:=PWideChar(WDomain);
   //
   // On level 0 return simple host list
   //
   if aLevel=0 then
   repeat
    Ptr:=nil;
    try
     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:=WideString(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(WideString(ServerInfoPtr101.sv101_name));
       Str:=GetIpAddress(WideString(ServerInfoPtr101.sv101_name));
       if Length(Str)=0 then Str:='?';
       Line:=Line+' '+Str;
       Line:=Line+' '+HostTypeStr(ServerInfoPtr101.sv101_type);
       Str:=WideString(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
    FillChar(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);
 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);
 end;
end;

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:ShortString):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);
 end;
end;

function WriteRegistryString(RootKey:HKEY; const Key,Name,Data:LongString):String;
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);
 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
  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,CRLF,[rfReplaceAll]);
    end;
    Buffer:='';
   end;
  finally
   RegCloseKey(valueKey);
  end;
 except
  on E:Exception do BugReport(E);
 end;
end;

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

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

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

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

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

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

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

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

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

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

procedure CreateFileLink(const ObjectPath, LinkPath, Description, Params: ShortString);
var
 IObject : IUnknown;
 Buff    : packed array[0..255] of Char;
begin
 try
  IObject := CreateComObject(CLSID_ShellLink);
  with IObject as IShellLink do begin
   SetArguments(StrPCopy(Buff,Params));
   SetDescription(StrPCopy(Buff,Description));
   SetPath(StrPCopy(Buff,ObjectPath));
  end;
  (IObject as IPersistFile).Save(PWChar(WideString(DefaultExtension(LinkPath,'.LNK'))), FALSE);
 except
  on E:Exception do BugReport(E);
 end;
end;

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

function GetEnvVar(const Name:LongString; BuffSize:Integer=1024*16):LongString;
var Len:Integer; Buff:PChar;
begin
 Result:='';
 try
  Buff:=Allocate(BuffSize);
  try
   if AllocSize(Buff)>0 then begin
    Len:=GetEnvironmentVariable(ArgChar(Name),Buff,AllocSize(Buff));
    if (Len>0) and (Len<=AllocSize(Buff)) then Result:=Buff;
   end;
  finally
   Deallocate(Pointer(Buff));
  end;
 except
  on E:Exception do BugReport(E);
 end;
end;

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

function SetEnv(const Name,Value:LongString):BOOL;
begin
 Result:=false;
 try
  Result:=SetEnvironmentVariable(ArgChar(Name),ArgChar(Value));
 except
  on E:Exception do BugReport(E);
 end;
end;

function ExpEnv(const Str:LongString; BuffSize:Integer=1024*32):LongString;
var nSize,nLeng:DWORD; lpSrc,lpDst:PChar; Dst:LongString;
begin
 Result:=Str;
 if Length(Result)>0 then
 if (Pos('%',Result)>0) or (Pos('!',Result)>0) then
 try
  nSize:=BuffSize; SetLength(Dst,nSize);
  lpSrc:=ArgChar(Str); lpDst:=ArgChar(Dst);
  nLeng:=ExpandEnvironmentStrings(lpSrc,lpDst,nSize);
  if (nLeng>0) and (nLeng<nSize) then Result:=lpDst;
 except
  on E:Exception do BugReport(E);
 end;
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:String):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:=_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);
 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=';'):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,CRLF,[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),CRLF,Delim,[rfReplaceAll]);
  finally
   Kill(List1);
   Kill(List2);
  end;
 except
  on E:Exception do BugReport(E);
 end;
end;

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

procedure PathAddDirEnvFromIni(const IniFile,Section,VarName,BaseFile:ShortString; First:Boolean=false);
var sect:TText; i:Integer; s:ShortString;
begin
 if not IsEmptyStr(IniFile) then
 if not IsEmptyStr(Section) then
 if not IsEmptyStr(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(';')+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);
 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 not IsEmptyStr(DefExt)
  then Result:=DefaultExtension(Result,Trim(DefExt));
  if not IsEmptyStr(BaseFile)
  then Result:=DefaultPath(Result,ExtractFilePath(Trim(BaseFile)));
  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:=AddBackSlash(HomeDir);
  if Length(ProgHome)>0 then
  if Length(Result)>Length(Template) then
  if IsSameText(Copy(Result,1,Length(Template)),Template) then begin
   Result:=AddBackSlash(ProgHome)+Copy(Result,Length(Template)+1,Length(Result));
   Exit;
  end;
  Template:=AddBackSlash(UserHomeDir);
  if Length(UserHome)>0 then
  if Length(Result)>Length(Template) then
  if IsSameText(Copy(Result,1,Length(Template)),Template) then begin
   Result:=AddBackSlash(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:Integer; ExtList,PathList:LongString;
begin
 Result:='';
 if not IsEmptyStr(FileName) then
 if not IsEmptyStr(PathVarStr) then
 try
  ExtList:='';
  PathList:='';
  try
   for i:=1 to WordCount(PathVarStr,ScanSpaces) do begin
    PathList:=PathList+SysUtils.Trim(GetEnv(ExtractWord(i,PathVarStr,ScanSpaces)));
    if Length(PathList)>0 then
    if Copy(PathList,Length(PathList),1)<>';' then PathList:=PathList+';';
   end;
   if Length(PathList)>0 then begin
    if HasExtension(FileName,i)
    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,ScanSpaces) do begin
      Result:=SysUtils.FileSearch(DefaultExtension(FileName,ExtractWord(i,ExtList,ScanSpaces)),PathList);
      if not IsEmptyStr(Result) then Break;
     end;
    end;
   end;
  finally
   ExtList:='';
   PathList:='';
  end;
 except
  on E:Exception do BugReport(E);
 end;
end;

function AddSearchPath(const EnvVar,Path:LongString):LongString;
var PathList:TStringList;
begin
 Result:='';
 if not IsEmptyStr(Path) then
 if not IsEmptyStr(EnvVar) then
 try
  PathList:=TStringList.Create;
  try
   PathList.Text:=SysUtils.Trim(StringReplace(GetEnv(EnvVar),';',CRLF,[rfReplaceAll]));
   if PathList.IndexOf(SysUtils.Trim(Path))<0 then begin
    PathList.Add(SysUtils.Trim(Path));
    if not SetEnv(EnvVar,StringReplace(PathList.Text,CRLF,';',[rfReplaceAll])) then Exit;
   end;
   Result:=GetEnv(EnvVar);
  finally
   Kill(PathList);
  end;
 except
  on E:Exception do BugReport(E);
 end;
end;

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

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
   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])+CRLF;
       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])+CRLF;
       continue;
      end;
     end;
    end;
   end;
  finally
   if Assigned(Buffer) then FreeMem(Buffer);
  end;
 except
  on E:Exception do BugReport(E);
 end;
end;

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;

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;
  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);
 end;
end;

function ValidatePathList(const PathList:LongString; Delim:Char=';'):LongString;
var List:TStringList; i,j,k:Integer;
begin
 Result:=PathList;
 if Length(Result)>0 then
 try
  List:=TStringList.Create;
  try
   List.Text:=StringReplace(Result,Delim,CRLF,[rfReplaceAll]);
   // Iteration 1 - Validate directory file names                                          
   for i:=List.Count-1 downto 0 do List[i]:=GetRealFilePathName(ExcludeTrailingBackslash(SysUtils.Trim(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),CRLF,Delim,[rfReplaceAll]);
  finally
   Kill(List);
  end;
 except
  on E:Exception do BugReport(E);
 end;
end;

{$ENDIF SKIP_DRAFT}

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

procedure Init_crw_fio;
begin
 Std_IO_Initialization;
 if not System.IsLibrary then begin
  myProgName:=UnifyFileAlias(ParamStr(0));
  myHomeDir:=ExtractFileDir(myProgName);
  myUserHomeDir:=DropPathDelim(GetUserDir{GetWindowsShellPersonal});
  myStartAtDir:=UnifyFileAlias(GetCurrDir);
  mySysIniFile:=ForceExtension(myProgName,'.ini');
  myTempDir:=LocalTempDir;
 end;
 {$IFDEF SKIP_DRAFT}
 InitDebugOut;
 InitConfigFiles;
 {$ENDIF SKIP_DRAFT}
end;

procedure Free_crw_fio;
begin
 {$IFDEF SKIP_DRAFT}
 DoneConfigFiles;
 DoneDebugOut;
 {$ENDIF SKIP_DRAFT}
 myProgName:='';
 myHomeDir:='';
 myUserHomeDir:='';
 myStartAtDir:='';
 mySysIniFile:='';
 myTempDir:='';
 Std_IO_Finalization;
end;

initialization

 Init_crw_fio;

finalization

 Free_crw_fio;

end.

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

