winscp/source/packages/jcl/JclFileUtils.pas

{**************************************************************************************************}
{                                                                                                  }
{ Project JEDI Code Library (JCL)                                                                  }
{                                                                                                  }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
{ License at http://www.mozilla.org/MPL/                                                           }
{                                                                                                  }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
{ and limitations under the License.                                                               }
{                                                                                                  }
{ The Original Code is JclFileUtils.pas.                                                           }
{                                                                                                  }
{ The Initial Developer of the Original Code is Marcel van Brakel.                                 }
{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. All rights reserved.  }
{                                                                                                  }
{ Contributors:                                                                                    }
{   Andre Snepvangers (asnepvangers)                                                               }
{   Andreas Hausladen (ahuser)                                                                     }
{   Anthony Steele                                                                                 }
{   Rik Barker (rikbarker)                                                                         }
{   Azret Botash                                                                                   }
{   Charlie Calvert                                                                                }
{   David Hervieux                                                                                 }
{   Florent Ouchet (outchy)                                                                        }
{   Jean-Fabien Connault (cycocrew)                                                                }
{   Jens Fudickar (jfudickar)                                                                      }
{   JohnML                                                                                         }
{   John Molyneux                                                                                  }
{   Marcel Bestebroer                                                                              }
{   Marcel van Brakel                                                                              }
{   Massimo Maria Ghisalberti                                                                      }
{   Matthias Thoma (mthoma)                                                                        }
{   Olivier Sannier (obones)                                                                       }
{   Pelle F. S. Liljendal                                                                          }
{   Robert Marquardt (marquardt)                                                                   }
{   Robert Rossmair (rrossmair)                                                                    }
{   Rudy Velthuis                                                                                  }
{   Scott Price                                                                                    }
{   Wim De Cleen                                                                                   }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ This unit contains routines and classes for working with files, directories and path strings.    }
{ Additionally it contains wrapper classes for file mapping objects and version resources.         }
{ Generically speaking, everything that has to do with files and directories. Note that filesystem }
{ specific functionality has been extracted into external units, for example JclNTFS which         }
{ contains NTFS specific utility routines, and that the JclShell unit contains some file related   }
{ routines as well but they are specific to the Windows shell.                                     }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ Last modified: $Date::                                                                         $ }
{ Revision:      $Rev::                                                                          $ }
{ Author:        $Author::                                                                       $ }
{                                                                                                  }
{**************************************************************************************************}

unit JclFileUtils;

{$I jcl.inc}
{$I crossplatform.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$IFDEF HAS_UNIT_LIBC}
  Libc,
  {$ENDIF HAS_UNIT_LIBC}
  {$IFDEF HAS_UNITSCOPE}
  {$IFDEF MSWINDOWS}
  Winapi.Windows, JclWin32,
  {$ENDIF MSWINDOWS}
  System.Classes, System.SysUtils,
  {$ELSE ~HAS_UNITSCOPE}
  {$IFDEF MSWINDOWS}
  Windows, JclWin32,
  {$ENDIF MSWINDOWS}
  Classes, SysUtils,
  {$ENDIF ~HAS_UNITSCOPE}
  JclBase, JclSysUtils;

// Path Manipulation
//
// Various support routines for working with path strings. For example, building a path from
// elements or extracting the elements from a path, interpretation of paths and transformations of
// paths.
const
  {$IFDEF UNIX}
  // renamed to DirDelimiter
  // PathSeparator    = '/';
  DirDelimiter = '/';
  DirSeparator = ':';
  {$ENDIF UNIX}
  {$IFDEF MSWINDOWS}
  PathDevicePrefix = '\\.\';
  // renamed to DirDelimiter
  // PathSeparator    = '\';
  DirDelimiter = '\';
  DirSeparator = ';';
  PathUncPrefix    = '\\';
  {$ENDIF MSWINDOWS}

  faSymLink           = $00000040 {$IFDEF SUPPORTS_PLATFORM} platform {$ENDIF}; // defined since D7
  faNormalFile        = $00000080;
  faTemporary         = $00000100 {$IFDEF SUPPORTS_PLATFORM} platform {$ENDIF};
  faSparseFile        = $00000200 {$IFDEF SUPPORTS_PLATFORM} platform {$ENDIF};
  faReparsePoint      = $00000400 {$IFDEF SUPPORTS_PLATFORM} platform {$ENDIF};
  faCompressed        = $00000800 {$IFDEF SUPPORTS_PLATFORM} platform {$ENDIF};
  faOffline           = $00001000 {$IFDEF SUPPORTS_PLATFORM} platform {$ENDIF};
  faNotContentIndexed = $00002000 {$IFDEF SUPPORTS_PLATFORM} platform {$ENDIF};
  faEncrypted         = $00004000 {$IFDEF SUPPORTS_PLATFORM} platform {$ENDIF};

  // Note: faVolumeID is potentially dangerous and its usage has been discontinued
  // Please see QC report 6003 for details, available online at this URL:
  // http://qc.embarcadero.com/wc/qcmain.aspx?d=6003
  faRejectedByDefault = faHidden + faSysFile + faDirectory;
  faWindowsSpecific   = faArchive + faTemporary + faSparseFile + faReparsePoint +
                        faCompressed + faOffline + faNotContentIndexed + faEncrypted;
  faUnixSpecific      = faSymLink;

type
  TCompactPath = ({cpBegin, }cpCenter, cpEnd);

function CharIsDriveLetter(const C: char): Boolean;
function CharIsInvalidFileNameCharacter(const C: Char): Boolean;
function CharIsInvalidPathCharacter(const C: Char): Boolean;

function PathAddSeparator(const Path: string): string;
function PathAddExtension(const Path, Extension: string): string;
function PathAppend(const Path, Append: string): string;
function PathBuildRoot(const Drive: Byte): string;
function PathCanonicalize(const Path: string): string;
function PathCommonPrefix(const Path1, Path2: string): Integer;
{$IFDEF MSWINDOWS}
function PathCompactPath(const DC: HDC; const Path: string; const Width: Integer;
  CmpFmt: TCompactPath): string;
{$ENDIF MSWINDOWS}
procedure PathExtractElements(const Source: string; var Drive, Path, FileName, Ext: string);
function PathExtractFileDirFixed(const S: string): string;
function PathExtractFileNameNoExt(const Path: string): string;
function PathExtractPathDepth(const Path: string; Depth: Integer): string;
function PathGetDepth(const Path: string): Integer;
{$IFDEF MSWINDOWS}
function PathGetLongName(const Path: string): string;
function PathGetShortName(const Path: string): string;
{$ENDIF MSWINDOWS}
function PathGetRelativePath(Origin, Destination: string): string;
function PathGetTempPath: string;
function PathIsAbsolute(const Path: string): Boolean;
function PathIsChild(const Path, Base: string): Boolean;
function PathIsEqualOrChild(const Path, Base: string): Boolean;
function PathIsDiskDevice(const Path: string): Boolean;
function PathIsUNC(const Path: string): Boolean;
function PathRemoveSeparator(const Path: string): string;
function PathRemoveExtension(const Path: string): string;

// Windows Vista uses localized path names in the Windows Explorer but these
// folders do not really exist on disk. This causes all I/O operations to fail
// if the user specifies such a localized directory like "C:\Benutzer\MyName\Bilder"
// instead of the physical folder "C:\Users\MyName\Pictures".
// These two functions allow to convert the user's input from localized to
// physical paths and vice versa.
function PathGetPhysicalPath(const LocalizedPath: string): string;
function PathGetLocalizedPath(const PhysicalPath: string): string;

// Files and Directories
//
// Routines for working with files and directories. Includes routines to extract various file
// attributes or update them, volume locking and routines for creating temporary files.
type
  TDelTreeProgress = function (const FileName: string; Attr: DWORD): Boolean;
  TFileListOption  = (flFullNames, flRecursive, flMaskedSubfolders);
  TFileListOptions = set of TFileListOption;
  TJclAttributeMatch = (amAny, amExact, amSubSetOf, amSuperSetOf, amCustom);
  TFileMatchFunc = function(const Attr: Integer; const FileInfo: TSearchRec): Boolean;
  TFileHandler = procedure (const FileName: string) of object;
  TFileHandlerEx = procedure (const Directory: string; const FileInfo: TSearchRec) of object;
  TFileInfoHandlerEx = procedure (const FileInfo: TSearchRec) of object;

function BuildFileList(const Path: string; const Attr: Integer; const List: TStrings; IncludeDirectoryName: Boolean =
    False): Boolean;
function AdvBuildFileList(const Path: string; const Attr: Integer; const Files: TStrings;
  const AttributeMatch: TJclAttributeMatch = amSuperSetOf; const Options: TFileListOptions = [];
  const SubfoldersMask: string = ''; const FileMatchFunc: TFileMatchFunc = nil): Boolean;
function VerifyFileAttributeMask(var RejectedAttributes, RequiredAttributes: Integer): Boolean;
function IsFileAttributeMatch(FileAttributes, RejectedAttributes,
  RequiredAttributes: Integer): Boolean;
function FileAttributesStr(const FileInfo: TSearchRec): string;
function IsFileNameMatch(FileName: string; const Mask: string;
  const CaseSensitive: Boolean = {$IFDEF MSWINDOWS} False {$ELSE} True {$ENDIF}): Boolean;
procedure EnumFiles(const Path: string; HandleFile: TFileHandlerEx;
  RejectedAttributes: Integer = faRejectedByDefault; RequiredAttributes: Integer = 0;
  Abort: PBoolean = nil); overload;
procedure EnumFiles(const Path: string; HandleFile: TFileInfoHandlerEx;
  RejectedAttributes: Integer = faRejectedByDefault; RequiredAttributes: Integer = 0;
  Abort: PBoolean = nil); overload;
procedure EnumDirectories(const Root: string; const HandleDirectory: TFileHandler;
  const IncludeHiddenDirectories: Boolean = False; const SubDirectoriesMask: string = '';
  Abort: PBoolean = nil {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF});
{$IFDEF MSWINDOWS}
procedure CreateEmptyFile(const FileName: string);
function CloseVolume(var Volume: THandle): Boolean;
{$IFNDEF FPC}
function DeleteDirectory(const DirectoryName: string; MoveToRecycleBin: Boolean): Boolean;
function CopyDirectory(ExistingDirectoryName, NewDirectoryName: string): Boolean;
function MoveDirectory(ExistingDirectoryName, NewDirectoryName: string): Boolean;
{$ENDIF ~FPC}
function DelTree(const Path: string): Boolean;
function DelTreeEx(const Path: string; AbortOnFailure: Boolean; Progress: TDelTreeProgress): Boolean;
function DiskInDrive(Drive: Char): Boolean;
{$ENDIF MSWINDOWS}
function DirectoryExists(const Name: string {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF}): Boolean;
function FileCreateTemp(var Prefix: string): THandle;
function FileBackup(const FileName: string; Move: Boolean = False): Boolean;
function FileCopy(const ExistingFileName, NewFileName: string; ReplaceExisting: Boolean = False): Boolean;
function FileDateTime(const FileName: string): TDateTime;
function FileDelete(const FileName: string; MoveToRecycleBin: Boolean = False): Boolean;
function FileExists(const FileName: string): Boolean;
/// <summary>procedure FileHistory Creates a list of history files of a specified
/// source file. Each version of the file get's an extention .~<Nr>~ The file with
/// the lowest number is the youngest file.
/// </summary>
/// <param name="FileName"> (string) Name of the source file</param>
/// <param name="HistoryPath"> (string) Folder where the history files should be
/// created. If no folder is defined the folder of the source file is used.</param>
/// <param name="MaxHistoryCount"> (Integer) Max number of files</param>
/// <param name="MinFileDate"> (TDateTime) Timestamp how old the file has to be to
/// create a new history version. For example: NOW-1/24 => Only once per hour a new
/// history file is created. Default 0 means allways
/// <param name="ReplaceExtention"> (boolean) Flag to define that the history file
/// extention should replace the current extention or should be added at the
/// end</param>
/// </param>
procedure FileHistory(const FileName: string; HistoryPath: string = ''; MaxHistoryCount: Integer = 100; MinFileDate:
    TDateTime = 0; ReplaceExtention: Boolean = true);
function FileMove(const ExistingFileName, NewFileName: string; ReplaceExisting: Boolean = False): Boolean;
function FileRestore(const FileName: string): Boolean;
function GetBackupFileName(const FileName: string): string;
function IsBackupFileName(const FileName: string): Boolean;
function FileGetDisplayName(const FileName: string): string;
function FileGetGroupName(const FileName: string {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF}): string;
function FileGetOwnerName(const FileName: string {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF}): string;
function FileGetSize(const FileName: string): Int64;
function FileGetTempName(const Prefix: string): string;
{$IFDEF MSWINDOWS}
function FileGetTypeName(const FileName: string): string;
{$ENDIF MSWINDOWS}
function FindUnusedFileName(FileName: string; const FileExt: string; NumberPrefix: string = ''): string;
function ForceDirectories(Name: string): Boolean;
function GetDirectorySize(const Path: string): Int64;
{$IFDEF MSWINDOWS}
function GetDriveTypeStr(const Drive: Char): string;
function GetFileAgeCoherence(const FileName: string): Boolean;
{$ENDIF MSWINDOWS}
procedure GetFileAttributeList(const Items: TStrings; const Attr: Integer);
{$IFDEF MSWINDOWS}
procedure GetFileAttributeListEx(const Items: TStrings; const Attr: Integer);
{$ENDIF MSWINDOWS}
function GetFileInformation(const FileName: string; out FileInfo: TSearchRec): Boolean; overload;
function GetFileInformation(const FileName: string): TSearchRec; overload;
{$IFDEF UNIX}
function GetFileStatus(const FileName: string; out StatBuf: TStatBuf64;
  const ResolveSymLinks: Boolean): Integer;
{$ENDIF UNIX}
{$IFDEF MSWINDOWS}
function GetFileLastWrite(const FileName: string): TFileTime; overload;
function GetFileLastWrite(const FileName: string; out LocalTime: TDateTime): Boolean; overload;
function GetFileLastAccess(const FileName: string): TFileTime; overload;
function GetFileLastAccess(const FileName: string; out LocalTime: TDateTime): Boolean; overload;
function GetFileCreation(const FileName: string): TFileTime; overload;
function GetFileCreation(const FileName: string; out LocalTime: TDateTime): Boolean; overload;
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
function GetFileLastWrite(const FileName: string; out TimeStamp: Integer; ResolveSymLinks: Boolean = True): Boolean; overload;
function GetFileLastWrite(const FileName: string; out LocalTime: TDateTime; ResolveSymLinks: Boolean = True): Boolean; overload;
function GetFileLastWrite(const FileName: string; ResolveSymLinks: Boolean = True): Integer; overload;
function GetFileLastAccess(const FileName: string; out TimeStamp: Integer; ResolveSymLinks: Boolean = True): Boolean; overload;
function GetFileLastAccess(const FileName: string; out LocalTime: TDateTime; ResolveSymLinks: Boolean = True): Boolean; overload;
function GetFileLastAccess(const FileName: string; ResolveSymLinks: Boolean = True): Integer; overload;
function GetFileLastAttrChange(const FileName: string; out TimeStamp: Integer; ResolveSymLinks: Boolean = True): Boolean; overload;
function GetFileLastAttrChange(const FileName: string; out LocalTime: TDateTime; ResolveSymLinks: Boolean = True): Boolean; overload;
function GetFileLastAttrChange(const FileName: string; ResolveSymLinks: Boolean = True): Integer; overload;
{$ENDIF UNIX}
function GetModulePath(const Module: HMODULE): string;
function GetSizeOfFile(const FileName: string): Int64; overload;
function GetSizeOfFile(const FileInfo: TSearchRec): Int64; overload;
{$IFDEF MSWINDOWS}
function GetSizeOfFile(Handle: THandle): Int64; overload;
function GetStandardFileInfo(const FileName: string): TWin32FileAttributeData;
{$ENDIF MSWINDOWS}
function IsDirectory(const FileName: string {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF}): Boolean;
function IsRootDirectory(const CanonicFileName: string): Boolean;
{$IFDEF MSWINDOWS}
function LockVolume(const Volume: string; var Handle: THandle): Boolean;
function OpenVolume(const Drive: Char): THandle;
function SetDirLastWrite(const DirName: string; const DateTime: TDateTime; RequireBackupRestorePrivileges: Boolean = True): Boolean;
function SetDirLastAccess(const DirName: string; const DateTime: TDateTime; RequireBackupRestorePrivileges: Boolean = True): Boolean;
function SetDirCreation(const DirName: string; const DateTime: TDateTime; RequireBackupRestorePrivileges: Boolean = True): Boolean;
{$ENDIF MSWINDOWS}
function SetFileLastWrite(const FileName: string; const DateTime: TDateTime): Boolean;
function SetFileLastAccess(const FileName: string; const DateTime: TDateTime): Boolean;
{$IFDEF MSWINDOWS}
function SetFileCreation(const FileName: string; const DateTime: TDateTime): Boolean;
procedure ShredFile(const FileName: string; Times: Integer = 1);
function UnlockVolume(var Handle: THandle): Boolean;
{$ENDIF MSWINDOWS}

{$IFDEF UNIX}
function CreateSymbolicLink(const Name, Target: string): Boolean;
{ This function gets the value of the symbolic link filename. }
function SymbolicLinkTarget(const Name: string): string;
{$ENDIF UNIX}

// TJclFileAttributeMask
//
// File search helper class, allows to specify required/rejected attributes
type
  TAttributeInterest = (aiIgnored, aiRejected, aiRequired);

  TJclCustomFileAttrMask = class(TPersistent)
  private
    FRequiredAttr: Integer;
    FRejectedAttr: Integer;
    function GetAttr(Index: Integer): TAttributeInterest;
    procedure SetAttr(Index: Integer; const Value: TAttributeInterest);
    procedure ReadRequiredAttributes(Reader: TReader);
    procedure ReadRejectedAttributes(Reader: TReader);
    procedure WriteRequiredAttributes(Writer: TWriter);
    procedure WriteRejectedAttributes(Writer: TWriter);
  protected
    procedure DefineProperties(Filer: TFiler); override;
    property ReadOnly: TAttributeInterest index faReadOnly
      read GetAttr write SetAttr stored False;
    property Hidden: TAttributeInterest index faHidden
      read GetAttr write SetAttr stored False;
    property System: TAttributeInterest index faSysFile
      read GetAttr write SetAttr stored False;
    property Directory: TAttributeInterest index faDirectory
      read GetAttr write SetAttr stored False;
    property SymLink: TAttributeInterest index faSymLink
      read GetAttr write SetAttr stored False;
    property Normal: TAttributeInterest index faNormalFile
      read GetAttr write SetAttr stored False;
    property Archive: TAttributeInterest index faArchive
      read GetAttr write SetAttr stored False;
    property Temporary: TAttributeInterest index faTemporary
      read GetAttr write SetAttr stored False;
    property SparseFile: TAttributeInterest index faSparseFile
      read GetAttr write SetAttr stored False;
    property ReparsePoint: TAttributeInterest index faReparsePoint
      read GetAttr write SetAttr stored False;
    property Compressed: TAttributeInterest index faCompressed
      read GetAttr write SetAttr stored False;
    property OffLine: TAttributeInterest index faOffline
      read GetAttr write SetAttr stored False;
    property NotContentIndexed: TAttributeInterest index faNotContentIndexed
      read GetAttr write SetAttr stored False;
    property Encrypted: TAttributeInterest index faEncrypted
      read GetAttr write SetAttr stored False;
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    procedure Clear;
    function Match(FileAttributes: Integer): Boolean; overload;
    function Match(const FileInfo: TSearchRec): Boolean; overload;
    property Required: Integer read FRequiredAttr write FRequiredAttr;
    property Rejected: Integer read FRejectedAttr write FRejectedAttr;
    property Attribute[Index: Integer]: TAttributeInterest read GetAttr write SetAttr; default;
  end;

  TJclFileAttributeMask = class(TJclCustomFileAttrMask)
  private
    procedure ReadVolumeID(Reader: TReader);
  protected
    procedure DefineProperties(Filer: TFiler); override;
  published
    property ReadOnly;
    property Hidden;
    property System;
    property Directory;
    property Normal;
    {$IFDEF UNIX}
    property SymLink;
    {$ENDIF UNIX}
    {$IFDEF MSWINDOWS}
    property Archive;
    property Temporary;
    property SparseFile;
    property ReparsePoint;
    property Compressed;
    property OffLine;
    property NotContentIndexed;
    property Encrypted;
    {$ENDIF MSWINDOWS}
  end;

type
  TFileSearchOption = (fsIncludeSubDirectories, fsIncludeHiddenSubDirectories, fsLastChangeAfter,
    fsLastChangeBefore, fsMaxSize, fsMinSize);
  TFileSearchOptions = set of TFileSearchOption;
  TFileSearchTaskID = Integer;
  TFileSearchTerminationEvent = procedure (const ID: TFileSearchTaskID; const Aborted: Boolean) of object;
  TFileEnumeratorSyncMode = (smPerFile, smPerDirectory);

// IJclFileSearchOptions
//
// Interface for file search options
type
  IJclFileSearchOptions = interface
    ['{B73D9E3D-34C5-4DA9-88EF-4CA730328FC9}']
    function GetAttributeMask: TJclFileAttributeMask;
    function GetCaseSensitiveSearch: Boolean;
    function GetRootDirectories: TStrings;
    function GetRootDirectory: string;
    function GetFileMask: string;
    function GetFileMasks: TStrings;
    function GetFileSizeMax: Int64;
    function GetFileSizeMin: Int64;
    function GetIncludeSubDirectories: Boolean;
    function GetIncludeHiddenSubDirectories: Boolean;
    function GetLastChangeAfter: TDateTime;
    function GetLastChangeBefore: TDateTime;
    function GetLastChangeAfterStr: string;
    function GetLastChangeBeforeStr: string;
    function GetSubDirectoryMask: string;
    function GetOption(const Option: TFileSearchOption): Boolean;
    function GetOptions: TFileSearchoptions;
    procedure SetAttributeMask(const Value: TJclFileAttributeMask);
    procedure SetCaseSensitiveSearch(const Value: Boolean);
    procedure SetRootDirectories(const Value: TStrings);
    procedure SetRootDirectory(const Value: string);
    procedure SetFileMask(const Value: string);
    procedure SetFileMasks(const Value: TStrings);
    procedure SetFileSizeMax(const Value: Int64);
    procedure SetFileSizeMin(const Value: Int64);
    procedure SetIncludeSubDirectories(const Value: Boolean);
    procedure SetIncludeHiddenSubDirectories(const Value: Boolean);
    procedure SetLastChangeAfter(const Value: TDateTime);
    procedure SetLastChangeBefore(const Value: TDateTime);
    procedure SetLastChangeAfterStr(const Value: string);
    procedure SetLastChangeBeforeStr(const Value: string);
    procedure SetOption(const Option: TFileSearchOption; const Value: Boolean);
    procedure SetOptions(const Value: TFileSearchOptions);
    procedure SetSubDirectoryMask(const Value: string);
    // properties
    property CaseSensitiveSearch: Boolean read GetCaseSensitiveSearch write SetCaseSensitiveSearch;
    property RootDirectories: TStrings read GetRootDirectories write SetRootDirectories;
    property RootDirectory: string read GetRootDirectory write SetRootDirectory;
    property FileMask: string read GetFileMask write SetFileMask;
    property SubDirectoryMask: string read GetSubDirectoryMask write SetSubDirectoryMask;
    property AttributeMask: TJclFileAttributeMask read GetAttributeMask write SetAttributeMask;
    property FileSizeMin: Int64 read GetFileSizeMin write SetFileSizeMin;
    property FileSizeMax: Int64 read GetFileSizeMax write SetFileSizeMax; // default InvalidFileSize;
    property LastChangeAfter: TDateTime read GetLastChangeAfter write SetLastChangeAfter;
    property LastChangeBefore: TDateTime read GetLastChangeBefore write SetLastChangeBefore;
    property LastChangeAfterAsString: string read GetLastChangeAfterStr write SetLastChangeAfterStr;
    property LastChangeBeforeAsString: string read GetLastChangeBeforeStr write SetLastChangeBeforeStr;
    property IncludeSubDirectories: Boolean read GetIncludeSubDirectories
      write SetIncludeSubDirectories;
    property IncludeHiddenSubDirectories: Boolean read GetIncludeHiddenSubDirectories
      write SetIncludeHiddenSubDirectories;
  end;

// IJclFileSearchOptions
//
// Interface for file search options
type
  TJclFileSearchOptions = class(TJclInterfacedPersistent, IJclFileSearchOptions)
  protected
    FFileMasks: TStringList;
    FRootDirectories: TStringList;
    FSubDirectoryMask: string;
    FAttributeMask: TJclFileAttributeMask;
    FFileSizeMin: Int64;
    FFileSizeMax: Int64;
    FLastChangeBefore: TDateTime;
    FLastChangeAfter: TDateTime;
    FOptions: TFileSearchOptions;
    FCaseSensitiveSearch: Boolean;
    function IsLastChangeAfterStored: Boolean;
    function IsLastChangeBeforeStored: Boolean;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;

    { IJclFileSearchOptions }
    function GetAttributeMask: TJclFileAttributeMask;
    function GetCaseSensitiveSearch: Boolean;
    function GetRootDirectories: TStrings;
    function GetRootDirectory: string;
    function GetFileMask: string;
    function GetFileMasks: TStrings;
    function GetFileSizeMax: Int64;
    function GetFileSizeMin: Int64;
    function GetIncludeSubDirectories: Boolean;
    function GetIncludeHiddenSubDirectories: Boolean;
    function GetLastChangeAfter: TDateTime;
    function GetLastChangeBefore: TDateTime;
    function GetLastChangeAfterStr: string;
    function GetLastChangeBeforeStr: string;
    function GetSubDirectoryMask: string;
    function GetOption(const Option: TFileSearchOption): Boolean;
    function GetOptions: TFileSearchoptions;
    procedure SetAttributeMask(const Value: TJclFileAttributeMask);
    procedure SetCaseSensitiveSearch(const Value: Boolean);
    procedure SetRootDirectories(const Value: TStrings);
    procedure SetRootDirectory(const Value: string);
    procedure SetFileMask(const Value: string);
    procedure SetFileMasks(const Value: TStrings);
    procedure SetFileSizeMax(const Value: Int64);
    procedure SetFileSizeMin(const Value: Int64);
    procedure SetIncludeSubDirectories(const Value: Boolean);
    procedure SetIncludeHiddenSubDirectories(const Value: Boolean);
    procedure SetLastChangeAfter(const Value: TDateTime);
    procedure SetLastChangeBefore(const Value: TDateTime);
    procedure SetLastChangeAfterStr(const Value: string);
    procedure SetLastChangeBeforeStr(const Value: string);
    procedure SetOption(const Option: TFileSearchOption; const Value: Boolean);
    procedure SetOptions(const Value: TFileSearchOptions);
    procedure SetSubDirectoryMask(const Value: string);
  published
    property CaseSensitiveSearch: Boolean read GetCaseSensitiveSearch write SetCaseSensitiveSearch
      default {$IFDEF MSWINDOWS} False {$ELSE} True {$ENDIF};
    property FileMasks: TStrings read GetFileMasks write SetFileMasks;
    property RootDirectories: TStrings read GetRootDirectories write SetRootDirectories;
    property RootDirectory: string read GetRootDirectory write SetRootDirectory;
    property SubDirectoryMask: string read FSubDirectoryMask write FSubDirectoryMask;
    property AttributeMask: TJclFileAttributeMask read FAttributeMask write SetAttributeMask;
    property FileSizeMin: Int64 read FFileSizeMin write FFileSizeMin;
    property FileSizeMax: Int64 read FFileSizeMax write FFileSizeMax;
    property LastChangeAfter: TDateTime read FLastChangeAfter write FLastChangeAfter
      stored IsLastChangeAfterStored;
    property LastChangeBefore: TDateTime read FLastChangeBefore write FLastChangeBefore
      stored IsLastChangeBeforeStored;
    property Options: TFileSearchOptions read FOptions write FOptions
      default [fsIncludeSubDirectories];
  end;

// IJclFileEnumerator
//
// Interface for thread-based file search
type
  IJclFileEnumerator = interface(IJclFileSearchOptions)
    ['{F7E747ED-1C41-441F-B25B-BB314E00C4E9}']
    // property access methods
    function GetRunningTasks: Integer;
    function GetSynchronizationMode: TFileEnumeratorSyncMode;
    function GetOnEnterDirectory: TFileHandler;
    function GetOnTerminateTask: TFileSearchTerminationEvent;
    procedure SetSynchronizationMode(const Value: TFileEnumeratorSyncMode);
    procedure SetOnEnterDirectory(const Value: TFileHandler);
    procedure SetOnTerminateTask(const Value: TFileSearchTerminationEvent);
    // other methods
    function FillList(List: TStrings): TFileSearchTaskID;
    function ForEach(Handler: TFileHandler): TFileSearchTaskID; overload;
    function ForEach(Handler: TFileHandlerEx): TFileSearchTaskID; overload;
    procedure StopTask(ID: TFileSearchTaskID);
    procedure StopAllTasks(Silently: Boolean = False); // Silently: Don't call OnTerminateTask
    // properties
    property RunningTasks: Integer read GetRunningTasks;
    property SynchronizationMode: TFileEnumeratorSyncMode read GetSynchronizationMode
      write SetSynchronizationMode;
    property OnEnterDirectory: TFileHandler read GetOnEnterDirectory write SetOnEnterDirectory;
    property OnTerminateTask: TFileSearchTerminationEvent read GetOnTerminateTask
      write SetOnTerminateTask;
  end;

// TJclFileEnumerator
//
// Class for thread-based file search
type
  TJclFileEnumerator = class(TJclFileSearchOptions, IInterface, IJclFileSearchOptions, IJclFileEnumerator)
  private
    FTasks: TList;
    FOnEnterDirectory: TFileHandler;
    FOnTerminateTask: TFileSearchTerminationEvent;
    FNextTaskID: TFileSearchTaskID;
    FSynchronizationMode: TFileEnumeratorSyncMode;
    function GetNextTaskID: TFileSearchTaskID;
  protected
    function CreateTask: TThread;
    procedure TaskTerminated(Sender: TObject);
    property NextTaskID: TFileSearchTaskID read GetNextTaskID;
  public
    constructor Create;
    destructor Destroy; override;

    { IJclFileEnumerator }
    function GetRunningTasks: Integer;
    function GetSynchronizationMode: TFileEnumeratorSyncMode;
    function GetOnEnterDirectory: TFileHandler;
    function GetOnTerminateTask: TFileSearchTerminationEvent;
    procedure SetSynchronizationMode(const Value: TFileEnumeratorSyncMode);
    procedure SetOnEnterDirectory(const Value: TFileHandler);
    procedure SetOnTerminateTask(const Value: TFileSearchTerminationEvent);

    procedure Assign(Source: TPersistent); override;
    function FillList(List: TStrings): TFileSearchTaskID;
    function ForEach(Handler: TFileHandler): TFileSearchTaskID; overload;
    function ForEach(Handler: TFileHandlerEx): TFileSearchTaskID; overload;
    procedure StopTask(ID: TFileSearchTaskID);
    procedure StopAllTasks(Silently: Boolean = False); // Silently: Don't call OnTerminateTask
    property FileMask: string read GetFileMask write SetFileMask;
    property IncludeSubDirectories: Boolean
      read GetIncludeSubDirectories write SetIncludeSubDirectories;
    property IncludeHiddenSubDirectories: Boolean
      read GetIncludeHiddenSubDirectories write SetIncludeHiddenSubDirectories;
    property SearchOption[const Option: TFileSearchOption]: Boolean read GetOption write SetOption;
    property LastChangeAfterAsString: string read GetLastChangeAfterStr write SetLastChangeAfterStr;
    property LastChangeBeforeAsString: string read GetLastChangeBeforeStr write SetLastChangeBeforeStr;
  published
    property RunningTasks: Integer read GetRunningTasks;
    property SynchronizationMode: TFileEnumeratorSyncMode read FSynchronizationMode write FSynchronizationMode
      default smPerDirectory;
    property OnEnterDirectory: TFileHandler read FOnEnterDirectory write FOnEnterDirectory;
    property OnTerminateTask: TFileSearchTerminationEvent read FOnTerminateTask write FOnTerminateTask;
  end;

function FileSearch: IJclFileEnumerator;

{$IFDEF MSWINDOWS}

// TFileVersionInfo
//
// Class that enables reading the version information stored in a PE file.

type
  TFileFlag = (ffDebug, ffInfoInferred, ffPatched, ffPreRelease, ffPrivateBuild, ffSpecialBuild);
  TFileFlags = set of TFileFlag;

  PLangIdRec = ^TLangIdRec;
  TLangIdRec = packed record
    case Integer of
    0: (
      LangId: Word;
      CodePage: Word);
    1: (
      Pair: DWORD);
  end;

  EJclFileVersionInfoError = class(EJclError);

  TJclFileVersionInfo = class(TObject)
  private
    FBuffer: AnsiString;
    FFixedInfo: PVSFixedFileInfo;
    FFileFlags: TFileFlags;
    FItemList: TStringList;
    FItems: TStringList;
    FLanguages: array of TLangIdRec;
    FLanguageIndex: Integer;
    FTranslations: array of TLangIdRec;
    function GetFixedInfo: TVSFixedFileInfo;
    function GetItems: TStrings;
    function GetLanguageCount: Integer;
    function GetLanguageIds(Index: Integer): string;
    function GetLanguageNames(Index: Integer): string;
    function GetLanguages(Index: Integer): TLangIdRec;
    function GetTranslationCount: Integer;
    function GetTranslations(Index: Integer): TLangIdRec;
    procedure SetLanguageIndex(const Value: Integer);
  protected
    procedure CreateItemsForLanguage;
    procedure CheckLanguageIndex(Value: Integer);
    procedure ExtractData;
    procedure ExtractFlags;
    function GetBinFileVersion: string;
    function GetBinProductVersion: string;
    function GetFileOS: DWORD;
    function GetFileSubType: DWORD;
    function GetFileType: DWORD;
    function GetFileVersionBuild: string;
    function GetFileVersionMajor: string;
    function GetFileVersionMinor: string;
    function GetFileVersionRelease: string;
    function GetProductVersionBuild: string;
    function GetProductVersionMajor: string;
    function GetProductVersionMinor: string;
    function GetProductVersionRelease: string;
    function GetVersionKeyValue(Index: Integer): string;
  public
    constructor Attach(VersionInfoData: Pointer; Size: Integer);
    constructor Create(const FileName: string); overload;
    {$IFDEF MSWINDOWS}
    {$IFDEF FPC}
    constructor Create(const Window: HWND; Dummy: Pointer = nil); overload;
    {$ELSE}
    constructor Create(const Window: HWND); overload;
    {$ENDIF}
    constructor Create(const Module: HMODULE); overload;
    {$ENDIF MSWINDOWS}
    destructor Destroy; override;
    function GetCustomFieldValue(const FieldName: string): string;
    class function VersionLanguageId(const LangIdRec: TLangIdRec): string;
    class function VersionLanguageName(const LangId: Word): string;
    class function FileHasVersionInfo(const FileName: string): boolean;
    function TranslationMatchesLanguages(Exact: Boolean = True): Boolean;
    property BinFileVersion: string read GetBinFileVersion;
    property BinProductVersion: string read GetBinProductVersion;
    property Comments: string index 1 read GetVersionKeyValue;
    property CompanyName: string index 2 read GetVersionKeyValue;
    property FileDescription: string index 3 read GetVersionKeyValue;
    property FixedInfo: TVSFixedFileInfo read GetFixedInfo;
    property FileFlags: TFileFlags read FFileFlags;
    property FileOS: DWORD read GetFileOS;
    property FileSubType: DWORD read GetFileSubType;
    property FileType: DWORD read GetFileType;
    property FileVersion: string index 4 read GetVersionKeyValue;
    property FileVersionBuild: string read GetFileVersionBuild;
    property FileVersionMajor: string read GetFileVersionMajor;
    property FileVersionMinor: string read GetFileVersionMinor;
    property FileVersionRelease: string read GetFileVersionRelease;
    property Items: TStrings read GetItems;
    property InternalName: string index 5 read GetVersionKeyValue;
    property LanguageCount: Integer read GetLanguageCount;
    property LanguageIds[Index: Integer]: string read GetLanguageIds;
    property LanguageIndex: Integer read FLanguageIndex write SetLanguageIndex;
    property Languages[Index: Integer]: TLangIdRec read GetLanguages;
    property LanguageNames[Index: Integer]: string read GetLanguageNames;
    property LegalCopyright: string index 6 read GetVersionKeyValue;
    property LegalTradeMarks: string index 7 read GetVersionKeyValue;
    property OriginalFilename: string index 8 read GetVersionKeyValue;
    property PrivateBuild: string index 12 read GetVersionKeyValue;
    property ProductName: string index 9 read GetVersionKeyValue;
    property ProductVersion: string index 10 read GetVersionKeyValue;
    property ProductVersionBuild: string read GetProductVersionBuild;
    property ProductVersionMajor: string read GetProductVersionMajor;
    property ProductVersionMinor: string read GetProductVersionMinor;
    property ProductVersionRelease: string read GetProductVersionRelease;
    property SpecialBuild: string index 11 read GetVersionKeyValue;
    property TranslationCount: Integer read GetTranslationCount;
    property Translations[Index: Integer]: TLangIdRec read GetTranslations;
  end;

function OSIdentToString(const OSIdent: DWORD): string;
function OSFileTypeToString(const OSFileType: DWORD; const OSFileSubType: DWORD = 0): string;

function VersionResourceAvailable(const FileName: string): Boolean; overload;
function VersionResourceAvailable(const Window: HWND): Boolean; overload;
function VersionResourceAvailable(const Module: HMODULE): Boolean; overload;

function WindowToModuleFileName(const Window: HWND): string;
{$ENDIF MSWINDOWS}

// Version Info formatting
type
  TFileVersionFormat = (vfMajorMinor, vfFull);

function FormatVersionString(const HiV, LoV: Word): string; overload;
function FormatVersionString(const Major, Minor, Build, Revision: Word): string; overload;

{$IFDEF MSWINDOWS}

function FormatVersionString(const FixedInfo: TVSFixedFileInfo; VersionFormat: TFileVersionFormat = vfFull): string; overload;

// Version Info extracting
procedure VersionExtractFileInfo(const FixedInfo: TVSFixedFileInfo; var Major, Minor, Build, Revision: Word);
procedure VersionExtractProductInfo(const FixedInfo: TVSFixedFileInfo; var Major, Minor, Build, Revision: Word);

// Fixed Version Info routines
function VersionFixedFileInfo(const FileName: string; var FixedInfo: TVSFixedFileInfo): Boolean;
function VersionFixedFileInfoString(const FileName: string; VersionFormat: TFileVersionFormat = vfFull;
  const NotAvailableText: string = ''): string;

{$ENDIF MSWINDOWS}

// Streams
//
// TStream descendent classes for dealing with temporary files and for using file mapping objects.
type
  TJclTempFileStream = class(THandleStream)
  private
    FFileName: string;
  public
    constructor Create(const Prefix: string);
    destructor Destroy; override;
    property FileName: string read FFileName;
  end;

{$IFDEF MSWINDOWS}

  TJclCustomFileMapping = class;

  TJclFileMappingView = class(TCustomMemoryStream)
  private
    FFileMapping: TJclCustomFileMapping;
    FOffsetHigh: Cardinal;
    FOffsetLow: Cardinal;
    function GetIndex: Integer;
    function GetOffset: Int64;
  public
    constructor Create(const FileMap: TJclCustomFileMapping;
      Access, Size: Cardinal; ViewOffset: Int64);
    constructor CreateAt(FileMap: TJclCustomFileMapping; Access,
      Size: Cardinal; ViewOffset: Int64; Address: Pointer);
    destructor Destroy; override;
    function Flush(const Count: Cardinal): Boolean;
    procedure LoadFromStream(const Stream: TStream);
    procedure LoadFromFile(const FileName: string);
    function Write(const Buffer; Count: Longint): Longint; override;
    property Index: Integer read GetIndex;
    property FileMapping: TJclCustomFileMapping read FFileMapping;
    property Offset: Int64 read GetOffset;
  end;

  TJclFileMappingRoundOffset = (rvDown, rvUp);

  TJclCustomFileMapping = class(TObject)
  private
    FExisted: Boolean;
    FHandle: THandle;
    FName: string;
    FRoundViewOffset: TJclFileMappingRoundOffset;
    FViews: TList;
    function GetCount: Integer;
    function GetView(Index: Integer): TJclFileMappingView;
  protected
    procedure ClearViews;
    procedure InternalCreate(const FileHandle: THandle; const Name: string;
      const Protect: Cardinal; MaximumSize: Int64; SecAttr: PSecurityAttributes);
    procedure InternalOpen(const Name: string; const InheritHandle: Boolean;
      const DesiredAccess: Cardinal);
  public
    constructor Create;
    constructor Open(const Name: string; const InheritHandle: Boolean; const DesiredAccess: Cardinal);
    destructor Destroy; override;
    function Add(const Access, Count: Cardinal; const Offset: Int64): Integer;
    function AddAt(const Access, Count: Cardinal; const Offset: Int64; const Address: Pointer): Integer;
    procedure Delete(const Index: Integer);
    function IndexOf(const View: TJclFileMappingView): Integer;
    property Count: Integer read GetCount;
    property Existed: Boolean read FExisted;
    property Handle: THandle read FHandle;
    property Name: string read FName;
    property RoundViewOffset: TJclFileMappingRoundOffset read FRoundViewOffset write FRoundViewOffset;
    property Views[index: Integer]: TJclFileMappingView read GetView;
  end;

  TJclFileMapping = class(TJclCustomFileMapping)
  private
    FFileHandle: THandle;
  public
    constructor Create(const FileName: string; FileMode: Cardinal;
      const Name: string; Protect: Cardinal; const MaximumSize: Int64;
      SecAttr: PSecurityAttributes); overload;
    constructor Create(const FileHandle: THandle; const Name: string;
      Protect: Cardinal; const MaximumSize: Int64;
      SecAttr: PSecurityAttributes); overload;
    destructor Destroy; override;
    property FileHandle: THandle read FFileHandle;
  end;

  TJclSwapFileMapping = class(TJclCustomFileMapping)
  public
    constructor Create(const Name: string; Protect: Cardinal;
      const MaximumSize: Int64; SecAttr: PSecurityAttributes);
  end;

  TJclFileMappingStream = class(TCustomMemoryStream)
  private
    FFileHandle: THandle;
    FMapping: THandle;
  protected
    procedure Close;
  public
    constructor Create(const FileName: string; FileMode: Word = fmOpenRead or fmShareDenyWrite);
    destructor Destroy; override;
    function Write(const Buffer; Count: Longint): Longint; override;
  end;

{$ENDIF MSWINDOWS}

  TJclMappedTextReaderIndex = (tiNoIndex, tiFull);

  PPAnsiCharArray = ^TPAnsiCharArray;
  TPAnsiCharArray = array [0..MaxInt div SizeOf(PAnsiChar) - 1] of PAnsiChar;

  TJclAnsiMappedTextReader = class(TPersistent)
  private
    FContent: PAnsiChar;
    FEnd: PAnsiChar;
    FIndex: PPAnsiCharArray;
    FIndexOption: TJclMappedTextReaderIndex;
    FFreeStream: Boolean;
    FLastLineNumber: Integer;
    FLastPosition: PAnsiChar;
    FLineCount: Integer;
    FMemoryStream: TCustomMemoryStream;
    FPosition: PAnsiChar;
    FSize: Integer;
    function GetAsString: AnsiString;
    function GetEof: Boolean;
    function GetChars(Index: Integer): AnsiChar;
    function GetLineCount: Integer;
    function GetLines(LineNumber: Integer): AnsiString;
    function GetPosition: Integer;
    function GetPositionFromLine(LineNumber: Integer): Integer;
    procedure SetPosition(const Value: Integer);
  protected
    procedure AssignTo(Dest: TPersistent); override;
    procedure CreateIndex;
    procedure Init;
    function PtrFromLine(LineNumber: Integer): PAnsiChar;
    function StringFromPosition(var StartPos: PAnsiChar): AnsiString;
  public
    constructor Create(MemoryStream: TCustomMemoryStream; FreeStream: Boolean = True;
      const AIndexOption: TJclMappedTextReaderIndex = tiNoIndex); overload;
    constructor Create(const FileName: TFileName;
      const AIndexOption: TJclMappedTextReaderIndex = tiNoIndex); overload;
    destructor Destroy; override;
    procedure GoBegin;
    function Read: AnsiChar;
    function ReadLn: AnsiString;
    property AsString: AnsiString read GetAsString;
    property Chars[Index: Integer]: AnsiChar read GetChars;
    property Content: PAnsiChar read FContent;
    property Eof: Boolean read GetEof;
    property IndexOption: TJclMappedTextReaderIndex read FIndexOption;
    property Lines[LineNumber: Integer]: AnsiString read GetLines;
    property LineCount: Integer read GetLineCount;
    property PositionFromLine[LineNumber: Integer]: Integer read GetPositionFromLine;
    property Position: Integer read GetPosition write SetPosition;
    property Size: Integer read FSize;
  end;

  PPWideCharArray = ^TPWideCharArray;
  TPWideCharArray = array [0..MaxInt div SizeOf(PWideChar) - 1] of PWideChar;

  TJclWideMappedTextReader = class(TPersistent)
  private
    FContent: PWideChar;
    FEnd: PWideChar;
    FIndex: PPWideCharArray;
    FIndexOption: TJclMappedTextReaderIndex;
    FFreeStream: Boolean;
    FLastLineNumber: Integer;
    FLastPosition: PWideChar;
    FLineCount: Integer;
    FMemoryStream: TCustomMemoryStream;
    FPosition: PWideChar;
    FSize: Integer;
    function GetAsString: WideString;
    function GetEof: Boolean;
    function GetChars(Index: Integer): WideChar;
    function GetLineCount: Integer;
    function GetLines(LineNumber: Integer): WideString;
    function GetPosition: Integer;
    function GetPositionFromLine(LineNumber: Integer): Integer;
    procedure SetPosition(const Value: Integer);
  protected
    procedure AssignTo(Dest: TPersistent); override;
    procedure CreateIndex;
    procedure Init;
    function PtrFromLine(LineNumber: Integer): PWideChar;
    function StringFromPosition(var StartPos: PWideChar): WideString;
  public
    constructor Create(MemoryStream: TCustomMemoryStream; FreeStream: Boolean = True;
      const AIndexOption: TJclMappedTextReaderIndex = tiNoIndex); overload;
    constructor Create(const FileName: TFileName;
      const AIndexOption: TJclMappedTextReaderIndex = tiNoIndex); overload;
    destructor Destroy; override;
    procedure GoBegin;
    function Read: WideChar;
    function ReadLn: WideString;
    property AsString: WideString read GetAsString;
    property Chars[Index: Integer]: WideChar read GetChars;
    property Content: PWideChar read FContent;
    property Eof: Boolean read GetEof;
    property IndexOption: TJclMappedTextReaderIndex read FIndexOption;
    property Lines[LineNumber: Integer]: WideString read GetLines;
    property LineCount: Integer read GetLineCount;
    property PositionFromLine[LineNumber: Integer]: Integer read GetPositionFromLine;
    property Position: Integer read GetPosition write SetPosition;
    property Size: Integer read FSize;
  end;

{ TODO : UNTESTED/UNDOCUMENTED }

type
  TJclFileMaskComparator = class(TObject)
  private
    FFileMask: string;
    FExts: array of string;
    FNames: array of string;
    FWildChars: array of Byte;
    FSeparator: Char;
    procedure CreateMultiMasks;
    function GetCount: Integer;
    function GetExts(Index: Integer): string;
    function GetMasks(Index: Integer): string;
    function GetNames(Index: Integer): string;
    procedure SetFileMask(const Value: string);
    procedure SetSeparator(const Value: Char);
  public
    constructor Create;
    function Compare(const NameExt: string): Boolean;
    property Count: Integer read GetCount;
    property Exts[Index: Integer]: string read GetExts;
    property FileMask: string read FFileMask write SetFileMask;
    property Masks[Index: Integer]: string read GetMasks;
    property Names[Index: Integer]: string read GetNames;
    property Separator: Char read FSeparator write SetSeparator;
  end;

  EJclPathError = class(EJclError);
  EJclFileUtilsError = class(EJclError);
  {$IFDEF UNIX}
  EJclTempFileStreamError = class(EJclFileUtilsError);
  {$ENDIF UNIX}
  {$IFDEF MSWINDOWS}
  EJclTempFileStreamError = class(EJclWin32Error);
  EJclFileMappingError = class(EJclWin32Error);
  EJclFileMappingViewError = class(EJclWin32Error);
  {$ENDIF MSWINDOWS}

function SamePath(const Path1, Path2: string): Boolean;

// functions to add/delete paths from a separated list of paths
// on windows the separator is a semi-colon ';'
// on linux the separator is a colon ':'
// add items at the end
procedure PathListAddItems(var List: string; const Items: string);
// add items at the end if they are not present
procedure PathListIncludeItems(var List: string; const Items: string);
// delete multiple items
procedure PathListDelItems(var List: string; const Items: string);
// delete one item
procedure PathListDelItem(var List: string; const Index: Integer);
// return the number of item
function PathListItemCount(const List: string): Integer;
// return the Nth item
function PathListGetItem(const List: string; const Index: Integer): string;
// set the Nth item
procedure PathListSetItem(var List: string; const Index: Integer; const Value: string);
// return the index of an item
function PathListItemIndex(const List, Item: string): Integer;


// additional functions to access the commandline parameters of an application

// returns the name of the command line parameter at position index, which is
// separated by the given separator, if the first character of the name part
// is one of the AllowedPrefixCharacters, this character will be deleted.
function ParamName(Index: Integer; const Separator: string = '=';
  const AllowedPrefixCharacters: string = '-/'; TrimName: Boolean = True): string;
// returns the value of the command line parameter at position index, which is
// separated by the given separator
function ParamValue (Index: Integer; const Separator: string = '='; TrimValue: Boolean = True): string; overload;
// seaches a command line parameter where the namepart is the searchname
// and returns the value which is which by the given separator.
// CaseSensitive defines the search type. if the first character of the name part
// is one of the AllowedPrefixCharacters, this character will be deleted.
function ParamValue (const SearchName: string; const Separator: string = '=';
             CaseSensitive: Boolean = False;
             const AllowedPrefixCharacters: string = '-/'; TrimValue: Boolean = True): string; overload;
// seaches a command line parameter where the namepart is the searchname
// and returns the position index. if no separator is defined, the full paramstr is compared.
// CaseSensitive defines the search type. if the first character of the name part
// is one of the AllowedPrefixCharacters, this character will be deleted.
function ParamPos (const SearchName: string; const Separator: string = '=';
             CaseSensitive: Boolean = False;
             const AllowedPrefixCharacters: string = '-/'): Integer;


{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$URL$';
    Revision: '$Revision$';
    Date: '$Date$';
    LogPath: 'JCL\source\common';
    Extra: '';
    Data: nil
    );
{$ENDIF UNITVERSIONING}

implementation

uses
  {$IFDEF HAS_UNITSCOPE}
  System.Types, // inlining of TList.Remove
  {$IFDEF HAS_UNIT_CHARACTER}
  System.Character,
  {$ENDIF HAS_UNIT_CHARACTER}
  System.Math,
  {$IFDEF MSWINDOWS}
  Winapi.ShellApi, Winapi.ActiveX, System.Win.ComObj, Winapi.ShlObj,
  JclShell, JclSysInfo, JclSecurity,
  {$ENDIF MSWINDOWS}
  {$ELSE ~HAS_UNITSCOPE}
  {$IFDEF HAS_UNIT_CHARACTER}
  Character,
  {$ENDIF HAS_UNIT_CHARACTER}
  Math,
  {$IFDEF MSWINDOWS}
  ShellApi, ActiveX, ComObj, ShlObj,
  JclShell, JclSysInfo, JclSecurity,
  {$ENDIF MSWINDOWS}
  {$ENDIF ~HAS_UNITSCOPE}
  JclDateTime, JclResources,
  JclStrings;

{ Some general notes:

  This unit redeclares some functions from FileCtrl.pas to avoid a dependency on that unit in the
  JCL. The problem is that FileCtrl.pas uses some units (eg Forms.pas) which have ridiculous
  initialization requirements. They add 4KB (!) to the executable and roughly 1 second of startup.
  That initialization is only necessary for GUI applications and is unacceptable for high
  performance services or console apps.

  The routines which query files or directories for their attributes deliberately use FindFirst
  even though there may be easier ways to get at the required information. This is because FindFirst
  is about the only routine which doesn't cause the file's last modification/accessed time to be
  changed which is usually an undesired side-effect. }

{$IFDEF UNIX}
const
  ERROR_NO_MORE_FILES  = -1;
  INVALID_HANDLE_VALUE = THandle(-1);
{$ENDIF UNIX}

//=== { TJclTempFileStream } =================================================

constructor TJclTempFileStream.Create(const Prefix: string);
var
  FileHandle: THandle;
begin
  FFileName := Prefix;
  FileHandle := FileCreateTemp(FFileName);
  // (rom) is it really wise to throw an exception before calling inherited?
  if FileHandle = INVALID_HANDLE_VALUE then
    raise EJclTempFileStreamError.CreateRes(@RsFileStreamCreate);
  inherited Create(FileHandle);
end;

destructor TJclTempFileStream.Destroy;
begin
  if THandle(Handle) <> INVALID_HANDLE_VALUE then
    FileClose(Handle);
  inherited Destroy;
end;

//=== { TJclFileMappingView } ================================================

{$IFDEF MSWINDOWS}

constructor TJclFileMappingView.Create(const FileMap: TJclCustomFileMapping;
  Access, Size: Cardinal; ViewOffset: Int64);
var
  BaseAddress: Pointer;
  OffsetLow, OffsetHigh: Cardinal;
begin
  inherited Create;
  if FileMap = nil then
    raise EJclFileMappingViewError.CreateRes(@RsViewNeedsMapping);
  FFileMapping := FileMap;
  // Offset must be a multiple of system memory allocation granularity
  RoundToAllocGranularity64(ViewOffset, FFileMapping.RoundViewOffset = rvUp);
  I64ToCardinals(ViewOffset, OffsetLow, OffsetHigh);
  FOffsetHigh := OffsetHigh;
  FOffsetLow := OffsetLow;
  BaseAddress := MapViewOfFile(FFileMapping.Handle, Access, FOffsetHigh, FOffsetLow, Size);
  if BaseAddress = nil then
    raise EJclFileMappingViewError.CreateRes(@RsCreateFileMappingView);
  // If we are mapping a file and size = 0 then MapViewOfFile has mapped the entire file. We must
  // figure out the size ourselves before we can call SetPointer. Since in case of failure to
  // retrieve the size we raise an exception, we also have to explicitly unmap the view which
  // otherwise would have been done by the destructor.
  if (Size = 0) and (FileMap is TJclFileMapping) then
  begin
    Size := GetFileSize(TJclFileMapping(FileMap).FFileHandle, nil);
    if Size = DWORD(-1) then
    begin
      UnMapViewOfFile(BaseAddress);
      raise EJclFileMappingViewError.CreateRes(@RsFailedToObtainSize);
    end;
  end;
  SetPointer(BaseAddress, Size);
  FFileMapping.FViews.Add(Self);
end;

constructor TJclFileMappingView.CreateAt(FileMap: TJclCustomFileMapping;
  Access, Size: Cardinal; ViewOffset: Int64; Address: Pointer);
var
  BaseAddress: Pointer;
  OffsetLow, OffsetHigh: Cardinal;
begin
  inherited Create;
  if FileMap = nil then
    raise EJclFileMappingViewError.CreateRes(@RsViewNeedsMapping);
  FFileMapping := FileMap;
  // Offset must be a multiple of system memory allocation granularity
  RoundToAllocGranularity64(ViewOffset, FFileMapping.RoundViewOffset = rvUp);
  RoundToAllocGranularityPtr(Address, FFileMapping.RoundViewOffset = rvUp);
  I64ToCardinals(ViewOffset, OffsetLow, OffsetHigh);
  FOffsetHigh := OffsetHigh;
  FOffsetLow := OffsetLow;
  BaseAddress := MapViewOfFileEx(FFileMapping.Handle, Access, FOffsetHigh,
    FOffsetLow, Size, Address);
  if BaseAddress = nil then
    raise EJclFileMappingViewError.CreateRes(@RsCreateFileMappingView);
  // If we are mapping a file and size = 0 then MapViewOfFile has mapped the entire file. We must
  // figure out the size ourselves before we can call SetPointer. Since in case of failure to
  // retrieve the size we raise an exception, we also have to explicitly unmap the view which
  // otherwise would have been done by the destructor.
  if (Size = 0) and (FileMap is TJclFileMapping) then
  begin
    Size := GetFileSize(TJclFileMapping(FileMap).FFileHandle, nil);
    if Size = DWORD(-1) then
    begin
      UnMapViewOfFile(BaseAddress);
      raise EJclFileMappingViewError.CreateRes(@RsFailedToObtainSize);
    end;
  end;
  SetPointer(BaseAddress, Size);
  FFileMapping.FViews.Add(Self);
end;

destructor TJclFileMappingView.Destroy;
var
  IndexOfSelf: Integer;
begin
  if Memory <> nil then
  begin
    UnMapViewOfFile(Memory);
    SetPointer(nil, 0);
  end;
  if FFileMapping <> nil then
  begin
    IndexOfSelf := FFileMapping.IndexOf(Self);
    if IndexOfSelf <> -1 then
      FFileMapping.FViews.Delete(IndexOfSelf);
  end;
  inherited Destroy;
end;

function TJclFileMappingView.Flush(const Count: Cardinal): Boolean;
begin
  Result := FlushViewOfFile(Memory, Count);
end;

function TJclFileMappingView.GetIndex: Integer;
begin
  Result := FFileMapping.IndexOf(Self);
end;

function TJclFileMappingView.GetOffset: Int64;
begin
  CardinalsToI64(Result, FOffsetLow, FOffsetHigh);
end;

procedure TJclFileMappingView.LoadFromFile(const FileName: string);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(Filename, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(Stream);
  finally
    FreeAndNil(Stream);
  end;
end;

procedure TJclFileMappingView.LoadFromStream(const Stream: TStream);
begin
  if Stream.Size > Size then
    raise EJclFileMappingViewError.CreateRes(@RsLoadFromStreamSize);
  Stream.Position := 0;
  Stream.ReadBuffer(Memory^, Stream.Size);
end;

function TJclFileMappingView.Write(const Buffer; Count: Integer): Longint;
begin
  Result := 0;
  if (Size - Position) >= Count then
  begin
    System.Move(Buffer, Pointer(TJclAddr(Memory) + TJclAddr(Position))^, Count);
    Position := Position + Count;
    Result := Count;
  end;
end;

//=== { TJclCustomFileMapping } ==============================================

constructor TJclCustomFileMapping.Create;
begin
  inherited Create;
  FViews := TList.Create;
  FRoundViewOffset := rvDown;
end;

constructor TJclCustomFileMapping.Open(const Name: string;
  const InheritHandle: Boolean; const DesiredAccess: Cardinal);
begin
  Create;
  InternalOpen(Name, InheritHandle, DesiredAccess);
end;

destructor TJclCustomFileMapping.Destroy;
begin
  ClearViews;
  if FHandle <> 0 then
    CloseHandle(FHandle);
  FreeAndNil(FViews);
  inherited Destroy;
end;

function TJclCustomFileMapping.Add(const Access, Count: Cardinal; const Offset: Int64): Integer;
var
  View: TJclFileMappingView;
begin
  // The view adds itself to the FViews list
  View := TJclFileMappingView.Create(Self, Access, Count, Offset);
  Result := View.Index;
end;

function TJclCustomFileMapping.AddAt(const Access, Count: Cardinal;
  const Offset: Int64; const Address: Pointer): Integer;
var
  View: TJclFileMappingView;
begin
  // The view adds itself to the FViews list
  View := TJclFileMappingView.CreateAt(Self, Access, Count, Offset, Address);
  Result := View.Index;
end;

procedure TJclCustomFileMapping.ClearViews;
var
  I: Integer;
begin
  // Note that the view destructor removes the view object from the FViews list so we must loop
  // downwards from count to 0
  for I := FViews.Count - 1 downto 0 do
    TJclFileMappingView(FViews[I]).Free;
end;

procedure TJclCustomFileMapping.Delete(const Index: Integer);
begin
  // Note that the view destructor removes itself from FViews
  TJclFileMappingView(FViews[Index]).Free;
end;

function TJclCustomFileMapping.GetCount: Integer;
begin
  Result := FViews.Count;
end;

function TJclCustomFileMapping.GetView(Index: Integer): TJclFileMappingView;
begin
  Result := TJclFileMappingView(FViews.Items[index]);
end;

function TJclCustomFileMapping.IndexOf(const View: TJclFileMappingView): Integer;
begin
  Result := FViews.IndexOf(View);
end;

procedure TJclCustomFileMapping.InternalCreate(const FileHandle: THandle;
  const Name: string; const Protect: Cardinal; MaximumSize: Int64;
  SecAttr: PSecurityAttributes);
var
  MaximumSizeLow, MaximumSizeHigh: Cardinal;
begin
  FName := Name;
  I64ToCardinals(MaximumSize, MaximumSizeLow, MaximumSizeHigh);
  FHandle := CreateFileMapping(FileHandle, SecAttr, Protect, MaximumSizeHigh,
    MaximumSizeLow, PChar(Name));
  if FHandle = 0 then
    raise EJclFileMappingError.CreateRes(@RsCreateFileMapping);
  FExisted := GetLastError = ERROR_ALREADY_EXISTS;
end;

procedure TJclCustomFileMapping.InternalOpen(const Name: string;
  const InheritHandle: Boolean; const DesiredAccess: Cardinal);
begin
  FExisted := True;
  FName := Name;
  FHandle := OpenFileMapping(DesiredAccess, InheritHandle, PChar(Name));
  if FHandle = 0 then
    raise EJclFileMappingError.CreateRes(@RsCreateFileMapping);
end;

//=== { TJclFileMapping } ====================================================

constructor TJclFileMapping.Create(const FileName: string; FileMode: Cardinal;
  const Name: string; Protect: Cardinal; const MaximumSize: Int64;
  SecAttr: PSecurityAttributes);
begin
  FFileHandle := INVALID_HANDLE_VALUE;
  inherited Create;
  FFileHandle := THandle(FileOpen(FileName, FileMode));
  if FFileHandle = INVALID_HANDLE_VALUE then
    raise EJclFileMappingError.CreateRes(@RsFileMappingOpenFile);
  InternalCreate(FFileHandle, Name, Protect, MaximumSize, SecAttr);
end;

constructor TJclFileMapping.Create(const FileHandle: THandle; const Name: string;
  Protect: Cardinal; const MaximumSize: Int64; SecAttr: PSecurityAttributes);
begin
  FFileHandle := INVALID_HANDLE_VALUE;
  inherited Create;
  if FileHandle = INVALID_HANDLE_VALUE then
    raise EJclFileMappingError.CreateRes(@RsFileMappingInvalidHandle);
  InternalCreate(FileHandle, Name, Protect, MaximumSize, SecAttr);
  // Duplicate the handle into FFileHandle as opposed to assigning it directly. This will cause
  // FFileHandle to retrieve a unique copy which is independent of FileHandle. This makes the
  // remainder of the class, especially the destructor, easier. The caller will have to close it's
  // own copy of the handle explicitly.
  DuplicateHandle(GetCurrentProcess, FileHandle, GetCurrentProcess,
    @FFileHandle, 0, False, DUPLICATE_SAME_ACCESS);
end;

destructor TJclFileMapping.Destroy;
begin
  if FFileHandle <> INVALID_HANDLE_VALUE then
    CloseHandle(FFileHandle);
  inherited Destroy;
end;

//=== { TJclSwapFileMapping } ================================================

constructor TJclSwapFileMapping.Create(const Name: string; Protect: Cardinal;
  const MaximumSize: Int64; SecAttr: PSecurityAttributes);
begin
  inherited Create;
  InternalCreate(INVALID_HANDLE_VALUE, Name, Protect, MaximumSize, SecAttr);
end;

//=== { TJclFileMappingStream } ==============================================

constructor TJclFileMappingStream.Create(const FileName: string; FileMode: Word);
var
  Protect, Access, Size: DWORD;
  BaseAddress: Pointer;
begin
  inherited Create;
  FFileHandle := THandle(FileOpen(FileName, FileMode));
  if FFileHandle = INVALID_HANDLE_VALUE then
    RaiseLastOSError;
  if (FileMode and $0F) = fmOpenReadWrite then
  begin
    Protect := PAGE_WRITECOPY;
    Access := FILE_MAP_COPY;
  end
  else
  begin
    Protect := PAGE_READONLY;
    Access := FILE_MAP_READ;
  end;
  FMapping := CreateFileMapping(FFileHandle, nil, Protect, 0, 0, nil);
  if FMapping = 0 then
  begin
    Close;
    raise EJclFileMappingError.CreateRes(@RsCreateFileMapping);
  end;
  BaseAddress := MapViewOfFile(FMapping, Access, 0, 0, 0);
  if BaseAddress = nil then
  begin
    Close;
    raise EJclFileMappingViewError.CreateRes(@RsCreateFileMappingView);
  end;
  Size := GetFileSize(FFileHandle, nil);
  if Size = DWORD(-1) then
  begin
    UnMapViewOfFile(BaseAddress);
    Close;
    raise EJclFileMappingViewError.CreateRes(@RsFailedToObtainSize);
  end;
  SetPointer(BaseAddress, Size);
end;

destructor TJclFileMappingStream.Destroy;
begin
  Close;
  inherited Destroy;
end;

procedure TJclFileMappingStream.Close;
begin
  if Memory <> nil then
  begin
    UnMapViewOfFile(Memory);
    SetPointer(nil, 0);
  end;
  if FMapping <> 0 then
  begin
    CloseHandle(FMapping);
    FMapping := 0;
  end;
  if FFileHandle <> INVALID_HANDLE_VALUE then
  begin
    FileClose(FFileHandle);
    FFileHandle := INVALID_HANDLE_VALUE;
  end;
end;

function TJclFileMappingStream.Write(const Buffer; Count: Integer): Longint;
begin
  Result := 0;
  if (Size - Position) >= Count then
  begin
    System.Move(Buffer, Pointer(TJclAddr(Memory) + TJclAddr(Position))^, Count);
    Position := Position + Count;
    Result := Count;
  end;
end;

{$ENDIF MSWINDOWS}

//=== { TJclAnsiMappedTextReader } ===========================================

constructor TJclAnsiMappedTextReader.Create(MemoryStream: TCustomMemoryStream; FreeStream: Boolean;
  const AIndexOption: TJclMappedTextReaderIndex);
begin
  inherited Create;
  FMemoryStream := MemoryStream;
  FFreeStream := FreeStream;
  FIndexOption := AIndexOption;
  Init;
end;

constructor TJclAnsiMappedTextReader.Create(const FileName: TFileName;
  const AIndexOption: TJclMappedTextReaderIndex);
begin
  inherited Create;
  {$IFDEF MSWINDOWS}
  FMemoryStream := TJclFileMappingStream.Create(FileName);
  {$ELSE ~ MSWINDOWS}
  FMemoryStream := TMemoryStream.Create;
  TMemoryStream(FMemoryStream).LoadFromFile(FileName);
  {$ENDIF ~ MSWINDOWS}
  FFreeStream := True;
  FIndexOption := AIndexOption;
  Init;
end;

destructor TJclAnsiMappedTextReader.Destroy;
begin
  if FFreeStream then
    FMemoryStream.Free;
  FreeMem(FIndex);
  inherited Destroy;
end;

procedure TJclAnsiMappedTextReader.AssignTo(Dest: TPersistent);
begin
  if Dest is TStrings then
  begin
    GoBegin;
    TStrings(Dest).BeginUpdate;
    try
      while not Eof do
        TStrings(Dest).Add(string(ReadLn));
    finally
      TStrings(Dest).EndUpdate;
    end;
  end
  else
    inherited AssignTo(Dest);
end;

procedure TJclAnsiMappedTextReader.CreateIndex;
var
  P, LastLineStart: PAnsiChar;
  I: Integer;
begin
  {$RANGECHECKS OFF}
  P := FContent;
  I := 0;
  LastLineStart := P;
  while P < FEnd do
  begin
    // CRLF, CR, LF and LFCR are seen as valid sets of chars for EOL marker
    if CharIsReturn(Char(P^)) then
    begin
      if I and $FFFF = 0 then
        ReallocMem(FIndex, (I + $10000) * SizeOf(Pointer));
      FIndex[I] := LastLineStart;
      Inc(I);

      case P^ of
        NativeLineFeed:
          begin
            Inc(P);
            if (P < FEnd) and (P^ = NativeCarriageReturn) then
             Inc(P);
          end;
        NativeCarriageReturn:
          begin
            Inc(P);
            if (P < FEnd) and (P^ = NativeLineFeed) then
              Inc(P);
          end;
      end;
      LastLineStart := P;
    end
    else
      Inc(P);
  end;
  if P > LastLineStart then
  begin
    ReallocMem(FIndex, (I + 1) * SizeOf(Pointer));
    FIndex[I] := LastLineStart;
    Inc(I);
  end
  else
    ReallocMem(FIndex, I * SizeOf(Pointer));
  FLineCount := I;
  {$IFDEF RANGECHECKS_ON}
  {$RANGECHECKS ON}
  {$ENDIF RANGECHECKS_ON}
end;

function TJclAnsiMappedTextReader.GetEof: Boolean;
begin
  Result := FPosition >= FEnd;
end;

function TJclAnsiMappedTextReader.GetAsString: AnsiString;
begin
  SetString(Result, Content, Size);
end;

function TJclAnsiMappedTextReader.GetChars(Index: Integer): AnsiChar;
begin
  if (Index < 0) or (Index >= Size) then
    raise EJclError.CreateRes(@RsFileIndexOutOfRange);
  Result := AnsiChar(PByte(FContent + Index)^);
end;

function TJclAnsiMappedTextReader.GetLineCount: Integer;
var
  P: PAnsiChar;
begin
  if FLineCount = -1 then
  begin
    FLineCount := 0;
    if FContent < FEnd then
    begin
      P := FContent;
      while P < FEnd do
      begin
        case P^ of
          NativeLineFeed:
            begin
              Inc(FLineCount);
              Inc(P);
              if (P < FEnd) and (P^ = NativeCarriageReturn) then
                Inc(P);
            end;
          NativeCarriageReturn:
            begin
              Inc(FLineCount);
              Inc(P);
              if (P < FEnd) and (P^ = NativeLineFeed) then
                Inc(P);
            end;
        else
          Inc(P);
        end;
      end;
      if (P = FEnd) and (P > FContent) and not CharIsReturn(Char((P-1)^)) then
        Inc(FLineCount);
    end;
  end;

  Result := FLineCount;
end;

function TJclAnsiMappedTextReader.GetLines(LineNumber: Integer): AnsiString;
var
  P: PAnsiChar;
begin
  P := PtrFromLine(LineNumber);
  Result := StringFromPosition(P);
end;

function TJclAnsiMappedTextReader.GetPosition: Integer;
begin
  Result := FPosition - FContent;
end;

procedure TJclAnsiMappedTextReader.GoBegin;
begin
  Position := 0;
end;

procedure TJclAnsiMappedTextReader.Init;
begin
  FContent := FMemoryStream.Memory;
  FSize := FMemoryStream.Size;
  FEnd := FContent + FSize;
  FPosition := FContent;
  FLineCount := -1;
  FLastLineNumber := 0;
  FLastPosition := FContent;
  if IndexOption = tiFull then
    CreateIndex;
end;

function TJclAnsiMappedTextReader.GetPositionFromLine(LineNumber: Integer): Integer;
var
  P: PAnsiChar;
begin
  P := PtrFromLine(LineNumber);
  if P = nil then
    Result := -1
  else
    Result := P - FContent;
end;

function TJclAnsiMappedTextReader.PtrFromLine(LineNumber: Integer): PAnsiChar;
var
  LineOffset: Integer;
begin
  Result := nil;
  {$RANGECHECKS OFF}
  if (IndexOption <> tiNoIndex) and (LineNumber < FLineCount) and (FIndex[LineNumber] <> nil) then
    Result := FIndex[LineNumber]
  {$IFDEF RANGECHECKS_ON}
  {$RANGECHECKS ON}
  {$ENDIF RANGECHECKS_ON}
  else
  begin
    LineOffset := LineNumber - FLastLineNumber;
    if (FLineCount <> -1) and (LineNumber > 0) then
    begin
      if -LineOffset > LineNumber then
      begin
        FLastLineNumber := 0;
        FLastPosition := FContent;
        LineOffset := LineNumber;
      end
      else
      if LineOffset > FLineCount - LineNumber then
      begin
        FLastLineNumber := FLineCount;
        FLastPosition := FEnd;
        LineOffset := LineNumber - FLineCount;
      end;
    end;
    if LineNumber <= 0 then
      Result := FContent
    else
    if LineOffset = 0 then
      Result := FLastPosition
    else
    if LineOffset > 0 then
    begin
      Result := FLastPosition;
      while (Result < FEnd) and (LineOffset > 0) do
      begin
        case Result^ of
          NativeLineFeed:
            begin
              Dec(LineOffset);
              Inc(Result);
              if (Result < FEnd) and (Result^ = NativeCarriageReturn) then
                Inc(Result);
            end;
          NativeCarriageReturn:
            begin
              Dec(LineOffset);
              Inc(Result);
              if (Result < FEnd) and (Result^ = NativeLineFeed) then
                Inc(Result);
            end;
        else
          Inc(Result);
        end;
      end;
    end
    else
    if LineOffset < 0 then
    begin
      Result := FLastPosition;
      while (Result > FContent) and (LineOffset < 1) do
      begin
        Dec(Result);
        case Result^ of
          NativeLineFeed:
            begin
              Inc(LineOffset);
              if LineOffset >= 1 then
                Inc(Result)
              else
              if (Result > FContent) and ((Result-1)^ = NativeCarriageReturn) then
                Dec(Result);
            end;
          NativeCarriageReturn:
            begin
              Inc(LineOffset);
              if LineOffset >= 1 then
                Inc(Result)
              else
              if (Result > FContent) and ((Result-1)^ = NativeLineFeed) then
                Dec(Result);
            end;
        end;
      end;
    end;
    FLastLineNumber := LineNumber;
    FLastPosition := Result;
  end;
end;

function TJclAnsiMappedTextReader.Read: AnsiChar;
begin
  if FPosition >= FEnd then
    Result := #0
  else
  begin
    Result := FPosition^;
    Inc(FPosition);
  end;
end;

function TJclAnsiMappedTextReader.ReadLn: AnsiString;
begin
  Result := StringFromPosition(FPosition);
end;

procedure TJclAnsiMappedTextReader.SetPosition(const Value: Integer);
begin
  FPosition := FContent + Value;
end;

function TJclAnsiMappedTextReader.StringFromPosition(var StartPos: PAnsiChar): AnsiString;
var
  P: PAnsiChar;
begin
  if (StartPos = nil) or (StartPos >= FEnd) then
    Result := ''
  else
  begin
    P := StartPos;
    while (P < FEnd) and (not CharIsReturn(Char(P^))) do
      Inc(P);
    SetString(Result, StartPos, P - StartPos);
    if P < FEnd then
    begin
      case P^ of
        NativeLineFeed:
          begin
            Inc(P);
            if (P < FEnd) and (P^ = NativeCarriageReturn) then
              Inc(P);
          end;
        NativeCarriageReturn:
          begin
            Inc(P);
            if (P < FEnd) and (P^ = NativeLineFeed) then
              Inc(P);
          end;
      end;
    end;
    StartPos := P;
  end;
end;

//=== { TJclWideMappedTextReader } ===========================================

constructor TJclWideMappedTextReader.Create(MemoryStream: TCustomMemoryStream; FreeStream: Boolean;
  const AIndexOption: TJclMappedTextReaderIndex);
begin
  inherited Create;
  FMemoryStream := MemoryStream;
  FFreeStream := FreeStream;
  FIndexOption := AIndexOption;
  Init;
end;

constructor TJclWideMappedTextReader.Create(const FileName: TFileName;
  const AIndexOption: TJclMappedTextReaderIndex);
begin
  inherited Create;
  {$IFDEF MSWINDOWS}
  FMemoryStream := TJclFileMappingStream.Create(FileName);
  {$ELSE ~ MSWINDOWS}
  FMemoryStream := TMemoryStream.Create;
  TMemoryStream(FMemoryStream).LoadFromFile(FileName);
  {$ENDIF ~ MSWINDOWS}
  FFreeStream := True;
  FIndexOption := AIndexOption;
  Init;
end;

destructor TJclWideMappedTextReader.Destroy;
begin
  if FFreeStream then
    FMemoryStream.Free;
  FreeMem(FIndex);
  inherited Destroy;
end;

procedure TJclWideMappedTextReader.AssignTo(Dest: TPersistent);
begin
  if Dest is TStrings then
  begin
    GoBegin;
    TStrings(Dest).BeginUpdate;
    try
      while not Eof do
        TStrings(Dest).Add(string(ReadLn));
    finally
      TStrings(Dest).EndUpdate;
    end;
  end
  else
    inherited AssignTo(Dest);
end;

procedure TJclWideMappedTextReader.CreateIndex;
var
  P, LastLineStart: PWideChar;
  I: Integer;
begin
  {$RANGECHECKS OFF}
  P := FContent;
  I := 0;
  LastLineStart := P;
  while P < FEnd do
  begin
    // CRLF, CR, LF and LFCR are seen as valid sets of chars for EOL marker
    if CharIsReturn(Char(P^)) then
    begin
      if I and $FFFF = 0 then
        ReallocMem(FIndex, (I + $10000) * SizeOf(Pointer));
      FIndex[I] := LastLineStart;
      Inc(I);

      case P^ of
        NativeLineFeed:
          begin
            Inc(P);
            if (P < FEnd) and (P^ = NativeCarriageReturn) then
             Inc(P);
          end;
        NativeCarriageReturn:
          begin
            Inc(P);
            if (P < FEnd) and (P^ = NativeLineFeed) then
              Inc(P);
          end;
      end;
      LastLineStart := P;
    end
    else
      Inc(P);
  end;
  if P > LastLineStart then
  begin
    ReallocMem(FIndex, (I + 1) * SizeOf(Pointer));
    FIndex[I] := LastLineStart;
    Inc(I);
  end
  else
    ReallocMem(FIndex, I * SizeOf(Pointer));
  FLineCount := I;
  {$IFDEF RANGECHECKS_ON}
  {$RANGECHECKS ON}
  {$ENDIF RANGECHECKS_ON}
end;

function TJclWideMappedTextReader.GetEof: Boolean;
begin
  Result := FPosition >= FEnd;
end;

function TJclWideMappedTextReader.GetAsString: WideString;
begin
  SetString(Result, Content, Size);
end;

function TJclWideMappedTextReader.GetChars(Index: Integer): WideChar;
begin
  if (Index < 0) or (Index >= Size) then
    raise EJclError.CreateRes(@RsFileIndexOutOfRange);
  Result := WideChar(PByte(FContent + Index)^);
end;

function TJclWideMappedTextReader.GetLineCount: Integer;
var
  P: PWideChar;
begin
  if FLineCount = -1 then
  begin
    FLineCount := 0;
    if FContent < FEnd then
    begin
      P := FContent;
      while P < FEnd do
      begin
        case P^ of
          NativeLineFeed:
            begin
              Inc(FLineCount);
              Inc(P);
              if (P < FEnd) and (P^ = NativeCarriageReturn) then
                Inc(P);
            end;
          NativeCarriageReturn:
            begin
              Inc(FLineCount);
              Inc(P);
              if (P < FEnd) and (P^ = NativeLineFeed) then
                Inc(P);
            end;
        else
          Inc(P);
        end;
      end;
      if (P = FEnd) and (P > FContent) and not CharIsReturn(Char((P-1)^)) then
        Inc(FLineCount);
    end;
  end;

  Result := FLineCount;
end;

function TJclWideMappedTextReader.GetLines(LineNumber: Integer): WideString;
var
  P: PWideChar;
begin
  P := PtrFromLine(LineNumber);
  Result := StringFromPosition(P);
end;

function TJclWideMappedTextReader.GetPosition: Integer;
begin
  Result := FPosition - FContent;
end;

procedure TJclWideMappedTextReader.GoBegin;
begin
  Position := 0;
end;

procedure TJclWideMappedTextReader.Init;
begin
  FContent := FMemoryStream.Memory;
  FSize := FMemoryStream.Size;
  FEnd := FContent + FSize;
  FPosition := FContent;
  FLineCount := -1;
  FLastLineNumber := 0;
  FLastPosition := FContent;
  if IndexOption = tiFull then
    CreateIndex;
end;

function TJclWideMappedTextReader.GetPositionFromLine(LineNumber: Integer): Integer;
var
  P: PWideChar;
begin
  P := PtrFromLine(LineNumber);
  if P = nil then
    Result := -1
  else
    Result := P - FContent;
end;

function TJclWideMappedTextReader.PtrFromLine(LineNumber: Integer): PWideChar;
var
  LineOffset: Integer;
begin
  Result := nil;
  {$RANGECHECKS OFF}
  if (IndexOption <> tiNoIndex) and (LineNumber < FLineCount) and (FIndex[LineNumber] <> nil) then
    Result := FIndex[LineNumber]
  {$IFDEF RANGECHECKS_ON}
  {$RANGECHECKS ON}
  {$ENDIF RANGECHECKS_ON}
  else
  begin
    LineOffset := LineNumber - FLastLineNumber;
    if (FLineCount <> -1) and (LineNumber > 0) then
    begin
      if -LineOffset > LineNumber then
      begin
        FLastLineNumber := 0;
        FLastPosition := FContent;
        LineOffset := LineNumber;
      end
      else
      if LineOffset > FLineCount - LineNumber then
      begin
        FLastLineNumber := FLineCount;
        FLastPosition := FEnd;
        LineOffset := LineNumber - FLineCount;
      end;
    end;
    if LineNumber <= 0 then
      Result := FContent
    else
    if LineOffset = 0 then
      Result := FLastPosition
    else
    if LineOffset > 0 then
    begin
      Result := FLastPosition;
      while (Result < FEnd) and (LineOffset > 0) do
      begin
        case Result^ of
          NativeLineFeed:
            begin
              Dec(LineOffset);
              Inc(Result);
              if (Result < FEnd) and (Result^ = NativeCarriageReturn) then
                Inc(Result);
            end;
          NativeCarriageReturn:
            begin
              Dec(LineOffset);
              Inc(Result);
              if (Result < FEnd) and (Result^ = NativeLineFeed) then
                Inc(Result);
            end;
        else
          Inc(Result);
        end;
      end;
    end
    else
    if LineOffset < 0 then
    begin
      Result := FLastPosition;
      while (Result > FContent) and (LineOffset < 1) do
      begin
        Dec(Result);
        case Result^ of
          NativeLineFeed:
            begin
              Inc(LineOffset);
              if LineOffset >= 1 then
                Inc(Result)
              else
              if (Result > FContent) and ((Result-1)^ = NativeCarriageReturn) then
                Dec(Result);
            end;
          NativeCarriageReturn:
            begin
              Inc(LineOffset);
              if LineOffset >= 1 then
                Inc(Result)
              else
              if (Result > FContent) and ((Result-1)^ = NativeLineFeed) then
                Dec(Result);
            end;
        end;
      end;
    end;
    FLastLineNumber := LineNumber;
    FLastPosition := Result;
  end;
end;

function TJclWideMappedTextReader.Read: WideChar;
begin
  if FPosition >= FEnd then
    Result := #0
  else
  begin
    Result := FPosition^;
    Inc(FPosition);
  end;
end;

function TJclWideMappedTextReader.ReadLn: WideString;
begin
  Result := StringFromPosition(FPosition);
end;

procedure TJclWideMappedTextReader.SetPosition(const Value: Integer);
begin
  FPosition := FContent + Value;
end;

function TJclWideMappedTextReader.StringFromPosition(var StartPos: PWideChar): WideString;
var
  P: PWideChar;
begin
  if (StartPos = nil) or (StartPos >= FEnd) then
    Result := ''
  else
  begin
    P := StartPos;
    while (P < FEnd) and (not CharIsReturn(Char(P^))) do
      Inc(P);
    SetString(Result, StartPos, P - StartPos);
    if P < FEnd then
    begin
      case P^ of
        NativeLineFeed:
          begin
            Inc(P);
            if (P < FEnd) and (P^ = NativeCarriageReturn) then
              Inc(P);
          end;
        NativeCarriageReturn:
          begin
            Inc(P);
            if (P < FEnd) and (P^ = NativeLineFeed) then
              Inc(P);
          end;
      end;
    end;
    StartPos := P;
  end;
end;

function CharIsDriveLetter(const C: Char): Boolean;
begin
  case C of
    'a'..'z',
    'A'..'Z':
      Result := True;
  else
    Result := False;
  end;
end;

//=== Path manipulation ======================================================

function PathAddSeparator(const Path: string): string;
begin
  Result := Path;
  if (Path = '') or (Path[Length(Path)] <> DirDelimiter) then
    Result := Path + DirDelimiter;
end;

function PathAddExtension(const Path, Extension: string): string;
begin
  Result := Path;
  // (obones) Extension may not contain the leading dot while ExtractFileExt
  // always returns it. Hence the need to use StrEnsurePrefix for the SameText
  // test to return an accurate value.
  if (Path <> '') and (Extension <> '') and
    not SameText(ExtractFileExt(Path), StrEnsurePrefix('.', Extension)) then
  begin
    if Path[Length(Path)] = '.' then
      Delete(Result, Length(Path), 1);
    if Extension[1] = '.' then
      Result := Result + Extension
    else
      Result := Result + '.' + Extension;
  end;
end;

function PathAppend(const Path, Append: string): string;
var
  PathLength: Integer;
  B1, B2: Boolean;
begin
  if Append = '' then
    Result := Path
  else
  begin
    PathLength := Length(Path);
    if PathLength = 0 then
      Result := Append
    else
    begin
      // The following code may look a bit complex but all it does is add Append to Path ensuring
      // that there is one and only one path separator character between them
      B1 := Path[PathLength] = DirDelimiter;
      B2 := Append[1] = DirDelimiter;
      if B1 and B2 then
        Result := Copy(Path, 1, PathLength - 1) + Append
      else
      begin
        if not (B1 or B2) then
          Result := Path + DirDelimiter + Append
        else
          Result := Path + Append;
      end;
    end;
  end;
end;

function PathBuildRoot(const Drive: Byte): string;
begin
  {$IFDEF UNIX}
  Result := DirDelimiter;
  {$ENDIF UNIX}
  {$IFDEF MSWINDOWS}
  // Remember, Win32 only allows 'a' to 'z' as drive letters (mapped to 0..25)
  if Drive < 26 then
    Result := Char(Drive + 65) + ':\'
  else
    raise EJclPathError.CreateResFmt(@RsPathInvalidDrive, [IntToStr(Drive)]);
  {$ENDIF MSWINDOWS}
end;

function PathCanonicalize(const Path: string): string;
var
  List: TStringList;
  S: string;
  I, K: Integer;
  IsAbsolute: Boolean;
begin
  I := Pos(':', Path); // for Windows' sake
  K := Pos(DirDelimiter, Path);
  IsAbsolute := K - I = 1;
  if IsAbsolute then begin
    if Copy(Path, 1, Length(PathUncPrefix)) = PathUncPrefix then // UNC path
      K := 2;
  end else
    K := I;
  if K = 0 then
    S := Path
  else
    S := Copy(Path, K + 1, Length(Path));
  List := TStringList.Create;
  try
    StrIToStrings(S, DirDelimiter, List, True);
    I := 0;
    while I < List.Count do
    begin
      if List[I] = '.' then
        List.Delete(I)
      else
      if (IsAbsolute or (I > 0) and not (List[I-1] = '..')) and (List[I] = '..') then
      begin
        List.Delete(I);
        if I > 0 then
        begin
          Dec(I);
          List.Delete(I);
        end;
      end
      else Inc(I);
    end;
    Result := StringsToStr(List, DirDelimiter, True);
  finally
    List.Free;
  end;
  if K > 0 then
    Result := Copy(Path, 1, K) + Result
  else
  if Result = '' then
    Result := '.';
end;

function PathCommonPrefix(const Path1, Path2: string): Integer;
var
  Index1, Index2: Integer;
  LastSeparator, LenS1: Integer;
  S1, S2: string;
begin
  Result := 0;
  if (Path1 <> '') and (Path2 <> '') then
  begin
    // Initialize P1 to the shortest of the two paths so that the actual comparison loop below can
    // use the terminating #0 of that string to terminate the loop.
    if Length(Path1) <= Length(Path2) then
    begin
      S1 := Path1;
      S2 := Path2;
    end
    else
    begin
      S1 := Path2;
      S2 := Path1;
    end;
    Index1 := 1;
    Index2 := 1;
    LenS1 := Length(S1);
    LastSeparator := 0;
    while (S1[Index1] = S2[Index2]) and (Index1 <= LenS1) do
    begin
      Inc(Result);
      if (S1[Index1] = DirDelimiter) or (S1[Index1] = ':') then
        LastSeparator := Result;
      Inc(Index1);
      Inc(Index2);
    end;
    if (LastSeparator < Result) and (Index1 <= LenS1) then
      Result := LastSeparator;
  end;
end;

{$IFDEF MSWINDOWS}
function PathCompactPath(const DC: HDC; const Path: string;
  const Width: Integer; CmpFmt: TCompactPath): string;
const
  Compacts: array [TCompactPath] of Cardinal = (DT_PATH_ELLIPSIS, DT_END_ELLIPSIS);
var
  TextRect: TRect;
  Fmt: Cardinal;
begin
  Result := '';
  if (DC <> 0) and (Path <> '') and (Width > 0) then
  begin
    { Here's a note from the Platform SDK to explain the + 5 in the call below:
    "If dwDTFormat includes DT_MODIFYSTRING, the function could add up to four additional characters
    to this string. The buffer containing the string should be large enough to accommodate these
    extra characters." }
    SetString(Result, PChar(Path), Length(Path) + 4);
    TextRect := Rect(0, 0, Width, 255);
    Fmt := DT_MODIFYSTRING or DT_CALCRECT or Compacts[CmpFmt];
    if DrawTextEx(DC, PChar(Result), -1, TextRect, Fmt, nil) <> 0 then
      StrResetLength(Result)
    else
      Result := '';  // in case of error
  end;
end;
{$ENDIF MSWINDOWS}

procedure PathExtractElements(const Source: string; var Drive, Path, FileName, Ext: string);
begin
  Drive := ExtractFileDrive(Source);
  Path := ExtractFilePath(Source);
  // Path includes drive so remove that
  if Drive <> '' then
    Delete(Path, 1, Length(Drive));
  // add/remove separators
  Drive := PathAddSeparator(Drive);
  Path := PathRemoveSeparator(Path);
  if (Path <> '') and (Path[1] = DirDelimiter) then
    Delete(Path, 1, 1);
  // and extract the remaining elements
  FileName := PathExtractFileNameNoExt(Source);
  Ext := ExtractFileExt(Source);
end;

function PathExtractFileDirFixed(const S: string): string;
begin
  Result := PathAddSeparator(ExtractFileDir(S));
end;

function PathExtractFileNameNoExt(const Path: string): string;
begin
  Result := PathRemoveExtension(ExtractFileName(Path));
end;

function PathExtractPathDepth(const Path: string; Depth: Integer): string;
var
  List: TStringList;
  LocalPath: string;
  I: Integer;
begin
  List := TStringList.Create;
  try
    if IsDirectory(Path) then
      LocalPath := Path
    else
      LocalPath := ExtractFilePath(Path);
    StrIToStrings(LocalPath, DirDelimiter, List, True);
    I := Depth + 1;
    if PathIsUNC(LocalPath) then
      I := I + 2;
    while I < List.Count do
      List.Delete(I);
    Result := PathAddSeparator(StringsToStr(List, DirDelimiter, True));
  finally
    List.Free;
  end;
end;

//  Notes: maybe this function should first apply PathCanonicalize() ?

function PathGetDepth(const Path: string): Integer;
var
  List: TStringList;
  LocalPath: string;
  I, Start: Integer;
begin
  Result := 0;
  List := TStringList.Create;
  try
    if IsDirectory(Path) then
      LocalPath := Path
    else
      LocalPath := ExtractFilePath(Path);
    StrIToStrings(LocalPath, DirDelimiter, List, False);
    if PathIsUNC(LocalPath) then
      Start := 1
    else
      Start := 0;
    for I := Start to List.Count - 1 do
    begin
      if Pos(':', List[I]) = 0 then
        Inc(Result);
    end;
  finally
    List.Free;
  end;
end;

{$IFDEF MSWINDOWS}

function ShellGetLongPathName(const Path: string): string;
{$IFDEF FPC}
// As of 2004-10-17, FPC's ShlObj unit is just a dummy
begin
  Result := Path;
end;
{$ElSE ~FPC}
var
  PIDL: PItemIDList;
  Desktop: IShellFolder;
  {$IFNDEF SUPPORTS_UNICODE}
  AnsiName: string;
  WideName: array [0..MAX_PATH] of WideChar;
  {$ENDIF ~SUPPORTS_UNICODE}
  Eaten, Attr: ULONG; // both unused but API requires them (incorrect translation)
begin
  Result := Path;
  if Path <> '' then
  begin
    if Succeeded(SHGetDesktopFolder(Desktop)) then
    begin
      {$IFDEF SUPPORTS_UNICODE}
      if Succeeded(Desktop.ParseDisplayName(0, nil, PChar(Path), Eaten, PIDL, Attr)) then
      try
        SetLength(Result, MAX_PATH);
        if SHGetPathFromIDList(PIDL, PChar(Result)) then
          StrResetLength(Result);
      finally
        CoTaskMemFree(PIDL);
      end;
      {$ELSE ~SUPPORTS_UNICODE}
      MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PAnsiChar(Path), -1, WideName, MAX_PATH);
      if Succeeded(Desktop.ParseDisplayName(0, nil, WideName, Eaten, PIDL, Attr)) then
      try
        SetLength(AnsiName, MAX_PATH);
        if SHGetPathFromIDList(PIDL, PChar(AnsiName)) then
          StrResetLength(AnsiName);
        Result := AnsiName;
      finally
        CoTaskMemFree(PIDL);
      end;
      {$ENDIF ~SUPPORTS_UNICODE}
    end;
  end;
end;
{$ENDIF ~FPC}

{ TODO : Move RTDL code over to JclWin32 when JclWin32 gets overhauled. }
var
  _Kernel32Handle: TModuleHandle = INVALID_MODULEHANDLE_VALUE;
  _GetLongPathName: function (lpszShortPath: PChar; lpszLongPath: PChar;
    cchBuffer: DWORD): DWORD; stdcall;

function Kernel32Handle: HMODULE;
begin
  JclSysUtils.LoadModule(_Kernel32Handle, kernel32);
  Result := _Kernel32Handle;
end;

function RtdlGetLongPathName(const Path: string): string;
begin
  Result := Path;
  if not Assigned(_GetLongPathName) then
    _GetLongPathName := GetModuleSymbol(Kernel32Handle, 'GetLongPathName' + AWSuffix);
  if not Assigned(_GetLongPathName) then
    Result := ShellGetLongPathName(Path)
  else
  begin
    SetLength(Result, MAX_PATH);
    SetLength(Result, _GetLongPathName(PChar(Path), PChar(Result), MAX_PATH));
  end;
end;

function PathGetLongName(const Path: string): string;
begin
  if Pos('::', Path) > 0 then // Path contains '::{<GUID>}'
    Result := ShellGetLongPathName(Path)
  else
    Result := RtdlGetLongPathName(Path);

  if Result = '' then
    Result := Path;
end;

function PathGetShortName(const Path: string): string;
var
  Required: Integer;
begin
  Result := Path;
  Required := GetShortPathName(PChar(Path), nil, 0);
  if Required <> 0 then
  begin
    SetLength(Result, Required);
    Required := GetShortPathName(PChar(Path), PChar(Result), Required);
    if (Required <> 0) and (Required = Length(Result) - 1) then
      SetLength(Result, Required)
    else
      Result := Path;
  end;
end;

{$ENDIF MSWINDOWS}

function PathGetRelativePath(Origin, Destination: string): string;
var
  {$IFDEF MSWINDOWS}
  OrigDrive: string;
  DestDrive: string;
  {$ENDIF MSWINDOWS}
  OrigList: TStringList;
  DestList: TStringList;
  DiffIndex: Integer;
  I: Integer;

  function StartsFromRoot(const Path: string): Boolean;
 {$IFDEF MSWINDOWS}
  var
    I: Integer;
  begin
    I := Length(ExtractFileDrive(Path));
    Result := (Length(Path) > I) and (Path[I + 1] = DirDelimiter);
  end;
  {$ELSE ~MSWINDOWS}
  begin
    Result := Pos(DirDelimiter, Path) = 1;
  end;
  {$ENDIF ~MSWINDOWS}

  function Equal(const Path1, Path2: string): Boolean;
  begin
    {$IFDEF MSWINDOWS}  // case insensitive
    Result := StrSame(Path1, Path2);
    {$ELSE ~MSWINDOWS}  // case sensitive
    Result := Path1 = Path2;
    {$ENDIF ~MSWINDOWS}
  end;

begin
  Origin := PathCanonicalize(Origin);
  Destination := PathCanonicalize(Destination);
  {$IFDEF MSWINDOWS}
  OrigDrive := ExtractFileDrive(Origin);
  DestDrive := ExtractFileDrive(Destination);
  {$ENDIF MSWINDOWS}
  if Equal(Origin, Destination) or (Destination = '') then
    Result := '.'
  else
  if Origin = '' then
    Result := Destination
  else
  {$IFDEF MSWINDOWS}
  if (DestDrive <> '') and ((OrigDrive = '') or ((OrigDrive <> '') and not Equal(OrigDrive, DestDrive))) then
    Result := Destination
  else
  if (OrigDrive <> '') and (Pos(DirDelimiter, Destination) = 1)
    and not Equal(PathUncPrefix,Copy(Destination,1,Length(PathUncPrefix))) then
    Result := OrigDrive + Destination  // prepend drive part from Origin
  else
  {$ENDIF MSWINDOWS}
  if StartsFromRoot(Origin) and not StartsFromRoot(Destination) then
    Result := StrEnsureSuffix(DirDelimiter, Origin) +
      StrEnsureNoPrefix(DirDelimiter, Destination)
  else
  begin
    // create a list of paths as separate strings
    OrigList := TStringList.Create;
    DestList := TStringList.Create;
    try
      // NOTE: DO NOT USE DELIMITER AND DELIMITEDTEXT FROM
      // TSTRINGS, THEY WILL SPLIT PATHS WITH SPACES !!!!
      StrToStrings(Origin, DirDelimiter, OrigList, False);
      StrToStrings(Destination, DirDelimiter, DestList, False);
      begin
        // find the first directory that is not the same
        DiffIndex := OrigList.Count;
        if DestList.Count < DiffIndex then
          DiffIndex := DestList.Count;
        for I := 0 to DiffIndex - 1 do
          if not Equal(OrigList[I], DestList[I]) then
          begin
            DiffIndex := I;
            Break;
          end;
        Result := StrRepeat('..' + DirDelimiter, OrigList.Count - DiffIndex);
        Result := PathRemoveSeparator(Result);
        for I := DiffIndex to DestList.Count - 1 do
        begin
          if Result <> '' then
            Result := Result + DirDelimiter;
          Result := Result + DestList[i];
        end;
      end;
    finally
      DestList.Free;
      OrigList.Free;
    end;
  end;
end;

function PathGetTempPath: string;
{$IFDEF MSWINDOWS}
var
  BufSize: Cardinal;
begin
  BufSize := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetTempPath(0, nil);
  SetLength(Result, BufSize);
  { TODO : Check length (-1 or not) }
  {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetTempPath(BufSize, PChar(Result));
  StrResetLength(Result);
end;
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
begin
  Result := GetEnvironmentVariable('TMPDIR');
end;
{$ENDIF UNIX}

function PathIsAbsolute(const Path: string): Boolean;
{$IFDEF MSWINDOWS}
var
  I: Integer;
{$ENDIF MSWINDOWS}
begin
  Result := False;
  if Path <> '' then
  begin
    {$IFDEF UNIX}
    Result := (Path[1] = DirDelimiter);
    {$ENDIF UNIX}
    {$IFDEF MSWINDOWS}
    if not PathIsUnc(Path) then
    begin
      I := 0;
      if PathIsDiskDevice(Path) then
        I := Length(PathDevicePrefix);
      Result := (Length(Path) > I + 2) and CharIsDriveLetter(Path[I + 1]) and
        (Path[I + 2] = ':') and (Path[I + 3] = DirDelimiter);
    end
    else
      Result := True;
    {$ENDIF MSWINDOWS}
  end;
end;

function PathIsChild(const Path, Base: string): Boolean;
var
  L: Integer;
  B, P: string;
begin
  Result := False;
  B := PathRemoveSeparator(Base);
  P := PathRemoveSeparator(Path);
  // an empty path or one that's not longer than base cannot be a subdirectory
  L := Length(B);
  if (P = '') or (L >= Length(P)) then
    Exit;
  {$IFDEF MSWINDOWS}
  Result := AnsiSameText(StrLeft(P, L), B) and (P[L+1] = DirDelimiter);
  {$ENDIF MSWINDOWS}
  {$IFDEF UNIX}
  Result := AnsiSameStr(StrLeft(P, L), B) and (P[L+1] = DirDelimiter);
  {$ENDIF UNIX}
end;

function PathIsEqualOrChild(const Path, Base: string): Boolean;
var
  L: Integer;
  B, P: string;
begin
  B := PathRemoveSeparator(Base);
  P := PathRemoveSeparator(Path);
  // an empty path or one that's not longer than base cannot be a subdirectory
  L := Length(B);
  {$IFDEF MSWINDOWS}
  Result := AnsiSameText(P, B);
  {$ENDIF MSWINDOWS}
  {$IFDEF UNIX}
  Result := AnsiSameStr(P, B);
  {$ENDIF UNIX}
  if Result or (P = '') or (L >= Length(P)) then
    Exit;
  {$IFDEF MSWINDOWS}
  Result := AnsiSameText(StrLeft(P, L), B) and (P[L+1] = DirDelimiter);
  {$ENDIF MSWINDOWS}
  {$IFDEF UNIX}
  Result := AnsiSameStr(StrLeft(P, L), B) and (P[L+1] = DirDelimiter);
  {$ENDIF UNIX}
end;

function PathIsDiskDevice(const Path: string): Boolean;
{$IFDEF UNIX}
var
  FullPath: string;
  F: PIOFile;
  Buffer: array [0..255] of AnsiChar;
  MountEntry: TMountEntry;
  FsTypes: TStringList;

  procedure GetAvailableFileSystems(const List: TStrings);
  var
    F: TextFile;
    S: string;
  begin
    AssignFile(F, '/proc/filesystems');
    Reset(F);
    repeat
      Readln(F, S);
      if Pos('nodev', S) = 0 then // how portable is this ?
        List.Add(Trim(S));
    until Eof(F);
    List.Add('supermount');
    CloseFile(F);
  end;

begin
  Result := False;

  SetLength(FullPath, _POSIX_PATH_MAX);
  if realpath(PChar(Path), PChar(FullPath)) = nil then
    RaiseLastOSError;
  StrResetLength(FullPath);

  FsTypes := TStringList.Create;
  try
    GetAvailableFileSystems(FsTypes);
    F := setmntent(_PATH_MOUNTED, 'r'); // PATH_MOUNTED is deprecated,
                                        // but PATH_MNTTAB is defective in Libc.pas
    try
      // get drives from mtab
      while not Result and (getmntent_r(F, MountEntry, Buffer, SizeOf(Buffer)) <> nil) do
        if FsTypes.IndexOf(MountEntry.mnt_type) <> -1 then
          Result := MountEntry.mnt_dir = FullPath;

    finally
      endmntent(F);
    end;
  finally
    FsTypes.Free;
  end;
end;
{$ENDIF UNIX}
{$IFDEF MSWINDOWS}
begin
  Result := Copy(Path, 1, Length(PathDevicePrefix)) = PathDevicePrefix;
end;
{$ENDIF MSWINDOWS}

function CharIsMachineName(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
begin
  case C of
    'a'..'z',
    'A'..'Z',
    '-', '_', '.':
      Result := True;
  else
    Result := False;
  end;
end;

function CharIsInvalidFileNameCharacter(const C: Char): Boolean;
begin
  case C of
    '<', '>', '?', '/', '\', ',', '*', '+', '=', '[', ']', '|', ':', ';', '"', '''':
      Result := True;
  else
    Result := False;
  end;
end;

function CharIsInvalidPathCharacter(const C: Char): Boolean;
begin
  case C of
    '<', '>', '?',
  {$IFDEF UNIX}
    '/',
  {$ELSE}
    '\',
  {$ENDIF}
    ',', '*', '+', '=', '[', ']', '|', ':', ';', '"', '''':
      Result := True;
  else
    Result := False;
  end;
end;

function PathIsUNC(const Path: string): Boolean;

{$IFDEF MSWINDOWS}

const
  cUNCSuffix = '?\UNC';

var
  P: PChar;

  function AbsorbSeparator: Boolean;
  begin
    Result := (P <> nil) and (P^ = DirDelimiter);
    if Result then
      Inc(P);
  end;

  function AbsorbMachineName: Boolean;
  var
    NonDigitFound: Boolean;
  begin
    // a valid machine name is a string composed of the set [a-z, A-Z, 0-9, -, _] but it may not
    // consist entirely out of numbers
    Result := True;
    NonDigitFound := False;
    while (P^ <> #0) and (P^ <> DirDelimiter) do
    begin
      if CharIsMachineName(P^) then
      begin
        NonDigitFound := True;
        Inc(P);
      end
      else
      if CharIsDigit(P^) then
        Inc(P)
      else
      begin
        Result := False;
        Break;
      end;
    end;
    Result := Result and NonDigitFound;
  end;

  function AbsorbShareName: Boolean;
  begin
    // a valid share name is a string composed of a set the set !InvalidCharacters note that a
    // leading '$' is valid (indicates a hidden share)
    Result := True;
    while (P^ <> #0) and (P^ <> DirDelimiter) do
    begin
      if CharIsInvalidPathCharacter(P^) then
      begin
        Result := False;
        Break;
      end;
      Inc(P);
    end;
  end;

begin
  Result := Copy(Path, 1, Length(PathUncPrefix)) = PathUncPrefix;
  if Result then
  begin
    if Copy(Path, 1, Length(PathUncPrefix + cUNCSuffix)) = PathUncPrefix + cUNCSuffix then
      P := @Path[Length(PathUncPrefix + cUNCSuffix)]
    else
    begin
      P := @Path[Length(PathUncPrefix)];
      Result := AbsorbSeparator and AbsorbMachineName;
    end;
    Result := Result and AbsorbSeparator;
    if Result then
    begin
      Result := AbsorbShareName;
      // remaining, if anything, is path and or filename (optional) check those?
    end;
  end;
end;

{$ENDIF MSWINDOWS}

{$IFDEF UNIX}

begin
  Result := False;
end;

{$ENDIF UNIX}

function PathRemoveSeparator(const Path: string): string;
var
  L: Integer;
begin
  L := Length(Path);
  if (L <> 0) and (Path[L] = DirDelimiter) then
    Result := Copy(Path, 1, L - 1)
  else
    Result := Path;
end;

function PathRemoveExtension(const Path: string): string;
var
  I: Integer;
begin
  I := LastDelimiter(':.' + DirDelimiter, Path);
  if (I > 0) and (Path[I] = '.') then
    Result := Copy(Path, 1, I - 1)
  else
    Result := Path;
end;

{$IFDEF MSWINDOWS}

function SHGetDisplayName(ShellFolder: IShellFolder; PIDL: PItemIDList; ForParsing: Boolean): string;
const
  Flags: array[Boolean] of DWORD = (SHGDN_NORMAL, SHGDN_FORPARSING);
var
  StrRet: TStrRet;
  P: PChar;
begin
  Result := '';
  StrRet.utype := 0;

  ShellFolder.GetDisplayNameOf(PIDL, Flags[ForParsing], StrRet);
  case StrRet.uType of
    STRRET_CSTR:
      SetString(Result, StrRet.cStr, lstrlenA(StrRet.cStr));
    STRRET_OFFSET:
      begin
        P := @PIDL.mkid.abID[StrRet.uOffset - SizeOf(PIDL.mkid.cb)];
        SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset);
      end;
    STRRET_WSTR:
      Result := StrRet.pOleStr;
  end;
  Result := Copy(Result, 1, lstrlen(PChar(Result)));
end;

function CutFirstDirectory(var Path: string): string;
var
  ps: Integer;
begin
  ps := AnsiPos(DirDelimiter, Path);
  if ps > 0 then
  begin
    Result := Copy(Path, 1, ps - 1);
    Path := Copy(Path, ps + 1, Length(Path));
  end
  else
  begin
    Result := Path;
    Path := '';
  end;
end;

function PathGetPhysicalPath(const LocalizedPath: string): string;
var
  Malloc: IMalloc;
  DesktopFolder: IShellFolder;
  RootFolder: IShellFolder;
  Eaten: Cardinal;
  Attributes: Cardinal;
  pidl: PItemIDList;
  EnumIDL: IEnumIDList;
  Drive: WideString;
  Featched: Cardinal;
  ParsePath: WideString;
  Path, Name: string;
  Found: Boolean;
begin
  if StrCompareRange('\\', LocalizedPath, 1, 2) = 0 then
  begin
    Result := LocalizedPath;
    Exit;
  end;

  Drive := ExtractFileDrive(LocalizedPath);
  if Drive = '' then
  begin
    Result := LocalizedPath;
    Exit;
  end;
  Path := Copy(LocalizedPath, Length(Drive) + 2, Length(LocalizedPath));
  ParsePath := Drive;
  OLECheck( SHGetMalloc(Malloc) );
  OleCheck( SHGetDesktopFolder(DesktopFolder) );
  while Path <> '' do
  begin
    Name := CutFirstDirectory(Path);
    Found := False;
    pidl := nil;
    Attributes := 0;
    if Succeeded( DesktopFolder.ParseDisplayName(0, nil, PWideChar(ParsePath), Eaten, pidl, Attributes) ) then
    begin
      OleCheck( DesktopFolder.BindToObject(pidl, nil, IShellFolder, RootFolder) );
      Malloc.Free(pidl);

      OleCheck( RootFolder.EnumObjects(0, SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN, EnumIDL) );
      Featched := 0;
      while EnumIDL.Next(1, pidl, Featched) = NOERROR do
      begin
        if AnsiCompareText(Name, SHGetDisplayName(RootFolder, pidl, False)) = 0 then
        begin
          ParsePath := SHGetDisplayName(RootFolder, pidl, True);
          Malloc.Free(pidl);
          Found := True;
          Break;
        end;
        Malloc.Free(pidl);
      end;
      EnumIDL := nil;
      RootFolder := nil;
    end;
    if not Found then
      ParsePath := ParsePath + DirDelimiter + Name;
  end;
  Result := ParsePath;
end;

function PathGetLocalizedPath(const PhysicalPath: string): string;
var
  Malloc: IMalloc;
  DesktopFolder: IShellFolder;
  RootFolder: IShellFolder;
  Eaten: Cardinal;
  Attributes: Cardinal;
  pidl: PItemIDList;
  EnumIDL: IEnumIDList;
  Drive: WideString;
  Featched: Cardinal;
  ParsePath: WideString;
  Path, Name, ParseName, DisplayName: string;
  Found: Boolean;
begin
  if StrCompareRange('\\', PhysicalPath, 1, 2) = 0 then
  begin
    Result := PhysicalPath;
    Exit;
  end;

  Drive := ExtractFileDrive(PhysicalPath);
  if Drive = '' then
  begin
    Result := PhysicalPath;
    Exit;
  end;
  Path := Copy(PhysicalPath, Length(Drive) + 2, Length(PhysicalPath));
  ParsePath := Drive;
  Result := Drive;
  OLECheck( SHGetMalloc(Malloc) );
  OleCheck( SHGetDesktopFolder(DesktopFolder) );
  while Path <> '' do
  begin
    Name := CutFirstDirectory(Path);
    Found := False;
    pidl := nil;
    Attributes := 0;
    if Succeeded( DesktopFolder.ParseDisplayName(0, nil, PWideChar(ParsePath), Eaten, pidl, Attributes) ) then
    begin
      OleCheck( DesktopFolder.BindToObject(pidl, nil, IShellFolder, RootFolder) );
      Malloc.Free(pidl);

      OleCheck( RootFolder.EnumObjects(0, SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN, EnumIDL) );
      Featched := 0;
      while EnumIDL.Next(1, pidl, Featched) = NOERROR do
      begin
        ParseName := SHGetDisplayName(RootFolder, pidl, True);
        DisplayName := SHGetDisplayName(RootFolder, pidl, False);
        Malloc.Free(pidl);
        if (AnsiCompareText(Name, ExtractFileName(ParseName)) = 0) or
           (AnsiCompareText(Name, DisplayName) = 0) then
        begin
          Name := DisplayName;
          ParsePath := ParseName;
          Found := True;
          Break;
        end;
      end;
      EnumIDL := nil;
      RootFolder := nil;
    end;
    Result := Result + DirDelimiter + Name;
    if not Found then
      ParsePath := ParsePath + DirDelimiter + Name;
  end;
end;

{$ELSE ~MSWINDOWS}
function PathGetPhysicalPath(const LocalizedPath: string): string;
begin
  Result := LocalizedPath;
end;

function PathGetLocalizedPath(const PhysicalPath: string): string;
begin
  Result := PhysicalPath;
end;
{$ENDIF ~MSWINDOWS}

//=== Files and Directories ==================================================


{* Extended version of JclFileUtils.BuildFileList:
   function parameter Path can include multiple FileMasks as:
   c:\aaa\*.pas; pro*.dpr; *.d??
   FileMask Seperator = ';'
 *}

function BuildFileList(const Path: string; const Attr: Integer; const List: TStrings; IncludeDirectoryName: Boolean =
    False): Boolean;
var
  SearchRec: TSearchRec;
  IndexMask: Integer;
  MaskList: TStringList;
  Masks, Directory: string;
begin
  Assert(List <> nil);
  MaskList := TStringList.Create;
  try
    {* extract the Directory *}
    Directory := ExtractFileDir(Path);

    {* files can be searched in the current directory *}
    if Directory <> '' then
    begin
      Directory := PathAddSeparator(Directory);
      {* extract the FileMasks portion out of Path *}
      Masks := StrAfter(Directory, Path);
    end
    else
      Masks := Path;

    {* put the Masks into TStringlist *}
    StrTokenToStrings(Masks, DirSeparator, MaskList);

    {* search all files in the directory *}
    Result := FindFirst(Directory + '*', faAnyFile, SearchRec) = 0;

    List.BeginUpdate;
    try
      while Result do
      begin
        {* if the filename matches any mask then it is added to the list *}
        for IndexMask := 0 to MaskList.Count - 1 do
          if (SearchRec.Name <> '.') and (SearchRec.Name <> '..')
            and ((SearchRec.Attr and Attr) = (SearchRec.Attr and faAnyFile))
            and IsFileNameMatch(SearchRec.Name, MaskList.Strings[IndexMask]) then
        begin
          if IncludeDirectoryName then
            List.Add(Directory+SearchRec.Name)
          else
            List.Add(SearchRec.Name);
          Break;
        end;

        case FindNext(SearchRec) of
          0:
            ;
          ERROR_NO_MORE_FILES:
            Break;
          else
            Result := False;
        end;
      end;
    finally
      {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindClose(SearchRec);
      List.EndUpdate;
    end;
  finally
    MaskList.Free;
  end;
end;

{$IFDEF MSWINDOWS}

procedure CreateEmptyFile(const FileName: string);
var
  Handle: THandle;
begin
  Handle := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE, 0, nil, CREATE_ALWAYS, 0, 0);
  if Handle <> INVALID_HANDLE_VALUE then
    CloseHandle(Handle)
  else
    RaiseLastOSError;
end;
{$ENDIF MSWINDOWS}

{$IFDEF MSWINDOWS}

function CloseVolume(var Volume: THandle): Boolean;
begin
  Result := False;
  if Volume <> INVALID_HANDLE_VALUE then
  begin
    Result := CloseHandle(Volume);
    if Result then
      Volume := INVALID_HANDLE_VALUE;
  end;
end;

{$IFNDEF FPC}  // needs JclShell

function DeleteDirectory(const DirectoryName: string; MoveToRecycleBin: Boolean): Boolean;
begin
  if MoveToRecycleBin then
    Result := SHDeleteFolder(0, DirectoryName, [doSilent, doAllowUndo])
  else
    Result := DelTree(DirectoryName);
end;

function CopyDirectory(ExistingDirectoryName, NewDirectoryName: string): Boolean;
var
  SH: SHFILEOPSTRUCT;
begin
  ResetMemory(SH, SizeOf(SH));
  SH.Wnd    := 0;
  SH.wFunc  := FO_COPY;
  SH.pFrom  := PChar(PathRemoveSeparator(ExistingDirectoryName) + #0);
  SH.pTo    := PChar(PathRemoveSeparator(NewDirectoryName) + #0);
  SH.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR or FOF_SILENT;
  Result := SHFileOperation(SH) = 0;
end;

function MoveDirectory(ExistingDirectoryName, NewDirectoryName: string): Boolean;
var
  SH: SHFILEOPSTRUCT;
begin
  ResetMemory(SH, SizeOf(SH));
  SH.Wnd    := 0;
  SH.wFunc  := FO_MOVE;
  SH.pFrom  := PChar(PathRemoveSeparator(ExistingDirectoryName) + #0);
  SH.pTo    := PChar(PathRemoveSeparator(NewDirectoryName) + #0);
  SH.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR or FOF_SILENT;
  Result := SHFileOperation(SH) = 0;
end;

{$ENDIF ~FPC}

function DelTree(const Path: string): Boolean;
begin
  Result := DelTreeEx(Path, False, nil);
end;

function DelTreeEx(const Path: string; AbortOnFailure: Boolean; Progress: TDelTreeProgress): Boolean;
var
  Files: TStringList;
  LPath: string; // writable copy of Path
  FileName: string;
  I: Integer;
  PartialResult: Boolean;
  Attr: DWORD;
begin
  Assert(Path <> '', LoadResString(@RsDelTreePathIsEmpty));
  {$IFNDEF ASSERTIONS_ON}
  if Path = '' then
  begin
    Result := False;
    Exit;
  end;
  {$ENDIF ~ASSERTIONS_ON}
  Result := True;
  Files := TStringList.Create;
  try
    LPath := PathRemoveSeparator(Path);
    BuildFileList(LPath + '\*.*', faAnyFile, Files);
    for I := 0 to Files.Count - 1 do
    begin
      FileName := LPath + DirDelimiter + Files[I];
      PartialResult := True;
      // If the current file is itself a directory then recursively delete it
      Attr := GetFileAttributes(PChar(FileName));
      if (Attr <> DWORD(-1)) and ((Attr and FILE_ATTRIBUTE_DIRECTORY) <> 0) then
        PartialResult := DelTreeEx(FileName, AbortOnFailure, Progress)
      else
      begin
        if Assigned(Progress) then
          PartialResult := Progress(FileName, Attr);
        if PartialResult then
        begin
          // Set attributes to normal in case it's a readonly file
          PartialResult := SetFileAttributes(PChar(FileName), FILE_ATTRIBUTE_NORMAL);
          if PartialResult then
            PartialResult := DeleteFile(FileName);
        end;
      end;
      if not PartialResult then
      begin
        Result := False;
        if AbortOnFailure then
          Break;
      end;
    end;
  finally
    FreeAndNil(Files);
  end;
  if Result then
  begin
    // Finally remove the directory itself
    Result := SetFileAttributes(PChar(LPath), FILE_ATTRIBUTE_NORMAL);
    if Result then
    begin
      {$IOCHECKS OFF}
      RmDir(LPath);
      {$IFDEF IOCHECKS_ON}
      {$IOCHECKS ON}
      {$ENDIF IOCHECKS_ON}
      Result := IOResult = 0;
    end;
  end;
end;

{$ENDIF MSWINDOWS}

{$IFDEF MSWINDOWS}
function DirectoryExists(const Name: string): Boolean;
var
  R: DWORD;
begin
  R := GetFileAttributes(PChar(Name));
  Result := (R <> DWORD(-1)) and ((R and FILE_ATTRIBUTE_DIRECTORY) <> 0);
end;
{$ENDIF MSWINDOWS}

{$IFDEF UNIX}
function DirectoryExists(const Name: string; ResolveSymLinks: Boolean): Boolean;
begin
  Result := IsDirectory(Name, ResolveSymLinks);
end;
{$ENDIF UNIX}

{$IFDEF MSWINDOWS}
function DiskInDrive(Drive: Char): Boolean;
var
  ErrorMode: Cardinal;
begin
  Result := False;
  Assert(CharIsDriveLetter(Drive));
  if CharIsDriveLetter(Drive) then
  begin
    Drive := CharUpper(Drive);
    { try to access the drive, it doesn't really matter how we access the drive and as such calling
      DiskSize is more or less a random choice. The call to SetErrorMode supresses the system provided
      error dialog if there is no disk in the drive and causes the to DiskSize to fail. }
    ErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
    try
      Result := DiskSize(Ord(Drive) - $40) <> -1;
    finally
      SetErrorMode(ErrorMode);
    end;
  end;
end;
{$ENDIF MSWINDOWS}

function FileCreateTemp(var Prefix: string): THandle;
{$IFDEF MSWINDOWS}
var
  TempName: string;
begin
  Result := INVALID_HANDLE_VALUE;
  TempName := FileGetTempName(Prefix);
  if TempName <> '' then
  begin
    Result := CreateFile(PChar(TempName), GENERIC_READ or GENERIC_WRITE, 0, nil,
      OPEN_EXISTING, FILE_ATTRIBUTE_TEMPORARY or FILE_FLAG_DELETE_ON_CLOSE, 0);
    // In certain situations it's possible that CreateFile fails yet the file is actually created,
    // therefore explicitly delete it upon failure.
    if Result = INVALID_HANDLE_VALUE then
      DeleteFile(TempName);
    Prefix := TempName;
  end;
end;
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
var
  Template: string;
begin
  // The mkstemp function generates a unique file name just as mktemp does, but
  // it also opens the file for you with open. If successful, it modifies
  // template in place and returns a file descriptor for that file open for
  // reading and writing. If mkstemp cannot create a uniquely-named file, it
  // returns -1. If template does not end with `XXXXXX', mkstemp returns -1 and
  // does not modify template.

  // The file is opened using mode 0600. If the file is meant to be used by
  // other users this mode must be changed explicitly.

  // Unlike mktemp, mkstemp is actually guaranteed to create a unique file that
  // cannot possibly clash with any other program trying to create a temporary
  // file. This is because it works by calling open with the O_EXCL flag, which
  // says you want to create a new file and get an error if the file already
  // exists.
  Template := Prefix + 'XXXXXX';
  Result := mkstemp(PChar(Template));
  Prefix := Template;
end;
{$ENDIF UNIX}

function FileBackup(const FileName: string; Move: Boolean = False): Boolean;
begin
  if Move then
    Result := FileMove(FileName, GetBackupFileName(FileName), True)
  else
    Result := FileCopy(FileName, GetBackupFileName(FileName), True);
end;

function FileCopy(const ExistingFileName, NewFileName: string; ReplaceExisting: Boolean = False): Boolean;
var
  {$IFDEF UNIX}
  SrcFile, DstFile: file;
  Buf: array[0..511] of Byte;
  BytesRead: Integer;
  {$ENDIF UNIX}
  DestFileName: string;
begin
  if IsDirectory(NewFileName) then
    DestFileName := PathAddSeparator(NewFileName) + ExtractFileName(ExistingFileName)
  else
    DestFileName := NewFileName;
  {$IFDEF MSWINDOWS}
  { TODO : Use CopyFileEx where available? }
  Result := CopyFile(PChar(ExistingFileName), PChar(DestFileName), not ReplaceExisting);
  {$ENDIF MSWINDOWS}
  {$IFDEF UNIX}
  Result := False;
  if not FileExists(DestFileName) or ReplaceExisting then
  begin
    AssignFile(SrcFile, ExistingFileName);
    Reset(SrcFile, 1);
    AssignFile(DstFile, DestFileName);
    Rewrite(DstFile, 1);
    while not Eof(SrcFile) do
    begin
      BlockRead(SrcFile, Buf, SizeOf(Buf), BytesRead);
      BlockWrite(DstFile, Buf, BytesRead);
    end;
    CloseFile(DstFile);
    CloseFile(SrcFile);
    Result := True;
  end;
  {$ENDIF UNIX}
end;

function FileDateTime(const FileName: string): TDateTime;
{$IFNDEF COMPILER10_UP}
var
  Age: Longint;
{$ENDIF !COMPILER10_UP}
begin
  {$IFDEF COMPILER10_UP}
  if not FileAge(Filename, Result) then
    Result := 0;
  {$ELSE}
  Age := FileAge(FileName);
  {$IFDEF MSWINDOWS}
  // [roko] -1 is valid FileAge value on Linux
  if Age = -1 then
    Result := 0
  else
  {$ENDIF MSWINDOWS}
    Result := FileDateToDateTime(Age);
  {$ENDIF COMPILER10_UP}
end;

function FileDelete(const FileName: string; MoveToRecycleBin: Boolean = False): Boolean;
{$IFDEF MSWINDOWS}
begin
  if MoveToRecycleBin then
    Result := SHDeleteFiles(0, FileName, [doSilent, doAllowUndo, doFilesOnly])
  else
    Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.DeleteFile(PChar(FileName));
end;
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
  { TODO : implement MoveToRecycleBin for appropriate Desktops (e.g. KDE) }
begin
  Result := remove(PChar(FileName)) <> -1;
end;
{$ENDIF UNIX}

function FileExists(const FileName: string): Boolean;
{$IFDEF MSWINDOWS}
var
  Attr: Cardinal;
{$ENDIF MSWINDOWS}
begin
  if FileName <> '' then
  begin
    {$IFDEF MSWINDOWS}
    // FileGetSize is very slow, GetFileAttributes is much faster
    Attr := GetFileAttributes(Pointer(Filename));
    Result := (Attr <> $FFFFFFFF) and (Attr and FILE_ATTRIBUTE_DIRECTORY = 0);
    {$ELSE ~MSWINDOWS}
    // Attempt to access the file, doesn't matter how, using FileGetSize is as good as anything else.
    Result := FileGetSize(FileName) <> -1;
    {$ENDIF ~MSWINDOWS}
  end
  else
    Result := False;
end;

procedure FileHistory(const FileName: string; HistoryPath: string = ''; MaxHistoryCount: Integer = 100; MinFileDate:
    TDateTime = 0; ReplaceExtention: Boolean = true);

  Function Extention (Number : Integer) : String;
  begin
    Result := inttostr(Number);
    while Length(Result) < 3 do
      Result := '0' + Result;
    Result := '.~'+Result+'~';
  end;

  procedure RenameToNumber(const RenameFileName: string; Number: Integer);
  var
    f1: string;
    f2: string;
  begin
    f1 := ChangeFileExt(RenameFileName,Extention(Number-1));
    f2 := ChangeFileExt(RenameFileName,Extention(Number));
    if FileExists(f2) then
      if Number >= MaxHistoryCount then
        if not FileDelete(f2) then
          Exception.Create('Unable to delete file "' + f2 + '".')
        else
      else
        RenameToNumber(RenameFileName, Number + 1);
    if FileExists(f1) then
      if not FileMove(f1, f2, true) then
        Exception.Create('Unable to rename file "' + f1 + '" to "' + f2 + '".')
  end;

Var FirstFile : string;
begin
  // TODO -cMM: FileHistory default body inserted
  if not FileExists(FileName) or (MaxHistoryCount <= 0) then
    Exit;
  if HistoryPath = '' then
    HistoryPath := ExtractFilePath(FileName);
  FirstFile := PathAppend(HistoryPath, ExtractFileName(FileName));
  if ReplaceExtention then
    FirstFile := ChangeFileExt(FirstFile, Extention(1))
  else
    FirstFile := FirstFile+Extention(1);
  if (FileDateTime(FirstFile) > MinFileDate) and (MinFileDate <> 0) then
    Exit;
  RenameToNumber(FirstFile, 2);
  FileCopy(FileName, FirstFile, True);
end;


function FileMove(const ExistingFileName, NewFileName: string; ReplaceExisting: Boolean = False): Boolean;
{$IFDEF MSWINDOWS}
const
  Flag: array[Boolean] of Cardinal = (0, MOVEFILE_REPLACE_EXISTING);
{$ENDIF MSWINDOWS}
begin
  {$IFDEF MSWINDOWS}
  Result := MoveFileEx(PChar(ExistingFileName), PChar(NewFileName), Flag[ReplaceExisting]);
  {$ENDIF MSWINDOWS}
  {$IFDEF UNIX}
  Result := __rename(PChar(ExistingFileName), PChar(NewFileName)) = 0;
  {$ENDIF UNIX}
  if not Result then
  begin
    Result := FileCopy(ExistingFileName, NewFileName, ReplaceExisting);
    if Result then
      FileDelete(ExistingFileName);
  end;
end;

function FileRestore(const FileName: string): Boolean;
var
  TempFileName: string;
begin
  Result := False;
  TempFileName := FileGetTempName('');

  if FileMove(GetBackupFileName(FileName), TempFileName, True) then
    if FileBackup(FileName, False) then
      Result := FileMove(TempFileName, FileName, True);
end;

function GetBackupFileName(const FileName: string): string;
var
  NewExt: string;
begin
  NewExt := ExtractFileExt(FileName);
  if Length(NewExt) > 0 then
  begin
    NewExt[1] := '~';
    NewExt := '.' + NewExt
  end
  else
    NewExt := '.~';
  Result := ChangeFileExt(FileName, NewExt);
end;

function IsBackupFileName(const FileName: string): Boolean;
begin
  Result := (pos('.~', ExtractFileExt(FileName)) = 1);
end;

function FileGetDisplayName(const FileName: string): string;
{$IFDEF MSWINDOWS}
var
  FileInfo: TSHFileInfo;
begin
  ResetMemory(FileInfo, SizeOf(FileInfo));
  if SHGetFileInfo(PChar(FileName), 0, FileInfo, SizeOf(FileInfo), SHGFI_DISPLAYNAME) <> 0 then
    Result := FileInfo.szDisplayName
  else
    Result := FileName;
end;
{$ELSE ~MSWINDOWS}
begin
  { TODO -cHelp : mention this reduced solution }
  Result := FileName;
end;
{$ENDIF ~MSWINDOWS}

function FileGetGroupName(const FileName: string {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF}): string;
{$IFDEF MSWINDOWS}
var
  DomainName: WideString;
  TmpResult: WideString;
  pSD: PSecurityDescriptor;
  BufSize: DWORD;
begin
  if IsWinNT then
  begin
    BufSize := 0;
    GetFileSecurity(PChar(FileName), GROUP_SECURITY_INFORMATION, nil, 0, BufSize);
    if BufSize > 0 then
    begin
      GetMem(pSD, BufSize);
      GetFileSecurity(PChar(FileName), GROUP_SECURITY_INFORMATION,
        pSD, BufSize, BufSize);
      LookupAccountBySid(Pointer(TJclAddr(pSD) + TJclAddr(pSD^.Group)), TmpResult, DomainName, True);
      FreeMem(pSD);
      Result := Trim(TmpResult);
    end;
  end;
end;
{$ENDIF ~MSWINDOWS}
{$IFDEF UNIX}
var
  Buf: TStatBuf64;
  ResultBuf: TGroup;
  ResultBufPtr: PGroup;
  Buffer: array of Char;
begin
  if GetFileStatus(FileName, Buf, ResolveSymLinks) = 0 then
  begin
    SetLength(Buffer, 128);
    while getgrgid_r(Buf.st_gid, ResultBuf, @Buffer[0], Length(Buffer), ResultBufPtr) = ERANGE do
      SetLength(Buffer, Length(Buffer) * 2);
    Result := ResultBuf.gr_name;
  end;
end;
{$ENDIF ~UNIX}

function FileGetOwnerName(const FileName: string {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF}): string;
{$IFDEF MSWINDOWS}
var
  DomainName: WideString;
  TmpResult: WideString;
  pSD: PSecurityDescriptor;
  BufSize: DWORD;
begin
  if IsWinNT then
  begin
    BufSize := 0;
    GetFileSecurity(PChar(FileName), OWNER_SECURITY_INFORMATION, nil, 0, BufSize);
    if BufSize > 0 then
    begin
      GetMem(pSD, BufSize);
      try
        GetFileSecurity(PChar(FileName), OWNER_SECURITY_INFORMATION,
          pSD, BufSize, BufSize);
        LookupAccountBySid(Pointer(TJclAddr(pSD) + TJclAddr(pSD^.Owner)), TmpResult, DomainName, True);
      finally
        FreeMem(pSD);
      end;
      Result := Trim(TmpResult);
    end;
  end;
end;
{$ENDIF ~MSWINDOWS}
{$IFDEF UNIX}
var
  Buf: TStatBuf64;
  ResultBuf: TPasswordRecord;
  ResultBufPtr: PPasswordRecord;
  Buffer: array of Char;
begin
  if GetFileStatus(FileName, Buf, ResolveSymLinks) = 0 then
  begin
    SetLength(Buffer, 128);
    while getpwuid_r(Buf.st_uid, ResultBuf, @Buffer[0], Length(Buffer), ResultBufPtr) = ERANGE do
      SetLength(Buffer, Length(Buffer) * 2);
    Result := ResultBuf.pw_name;
  end;
end;
{$ENDIF ~UNIX}

function FileGetSize(const FileName: string): Int64;
{$IFDEF MSWINDOWS}
var
  FileAttributesEx: WIN32_FILE_ATTRIBUTE_DATA;
  OldMode: Cardinal;
  Size: TJclULargeInteger;
begin
  Result := -1;
  OldMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
    if GetFileAttributesEx(PChar(FileName), GetFileExInfoStandard, @FileAttributesEx) then
    begin
      Size.LowPart := FileAttributesEx.nFileSizeLow;
      Size.HighPart := FileAttributesEx.nFileSizeHigh;
      Result := Size.QuadPart;
    end;
  finally
    SetErrorMode(OldMode);
  end;
end;
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
var
  Buf: TStatBuf64;
begin
  Result := -1;
  if GetFileStatus(FileName, Buf, False) = 0 then
    Result := Buf.st_size;
end;
{$ENDIF UNIX}

{$IFDEF MSWINDOWS}
{$IFDEF FPC}
{ TODO : Move this over to JclWin32 when JclWin32 gets overhauled. }
function GetTempFileName(lpPathName, lpPrefixString: PChar;
  uUnique: UINT; lpTempFileName: PChar): UINT; stdcall;
external kernel32 name 'GetTempFileNameA';
{$ENDIF FPC}
{$ENDIF MSWINDOWS}

function FileGetTempName(const Prefix: string): string;
{$IFDEF MSWINDOWS}
var
  TempPath, TempFile: string;
  R: Cardinal;
begin
  Result := '';
  TempPath := PathGetTempPath;
  if TempPath <> '' then
  begin
    SetLength(TempFile, MAX_PATH);
    R := GetTempFileName(PChar(TempPath), PChar(Prefix), 0, PChar(TempFile));
    if R <> 0 then
    begin
      StrResetLength(TempFile);
      Result := TempFile;
    end;
  end;
end;
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
// Warning: Between the time the pathname is constructed and the file is created
// another process might have created a file with the same name using tmpnam,
// leading to a possible security hole. The implementation generates names which
// can hardly be predicted, but when opening the file you should use the O_EXCL
// flag. Using tmpfile or mkstemp is a safe way to avoid this problem.
var
  P: PChar;
begin
  P := tempnam(PChar(PathGetTempPath), PChar(Prefix));
  Result := P;
  Libc.free(P);
end;
{$ENDIF UNIX}

{$IFDEF MSWINDOWS}
function FileGetTypeName(const FileName: string): string;
var
  FileInfo: TSHFileInfo;
  RetVal: DWORD;
begin
  ResetMemory(FileInfo, SizeOf(FileInfo));
  RetVal := SHGetFileInfo(PChar(FileName), 0, FileInfo, SizeOf(FileInfo),
    SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES);
  if RetVal <> 0 then
    Result := FileInfo.szTypeName;
  if (RetVal = 0) or (Trim(Result) = '') then
  begin
    // Lookup failed so mimic explorer behaviour by returning "XYZ File"
    Result := ExtractFileExt(FileName);
    Delete(Result, 1, 1);
    Result := TrimLeft(UpperCase(Result) + LoadResString(@RsDefaultFileTypeName));
  end;
end;
{$ENDIF MSWINDOWS}

function FindUnusedFileName(FileName: string; const FileExt: string; NumberPrefix: string = ''): string;
var
  I: Integer;
begin
  Result := PathAddExtension(FileName, FileExt);
  if not FileExists(Result) then
    Exit;
  if SameText(Result, FileName) then
    Delete(FileName, Length(FileName) - Length(FileExt) + 1, Length(FileExt));
  I := 0;
  repeat
    Inc(I);
    Result := PathAddExtension(FileName + NumberPrefix + IntToStr(I), FileExt);
  until not FileExists(Result);
end;

// This routine is copied from FileCtrl.pas to avoid dependency on that unit.
// See the remark at the top of this section

function ForceDirectories(Name: string): Boolean;
var
  ExtractPath: string;
begin
  Result := True;
  if Length(Name) = 0 then
    raise EJclFileUtilsError.CreateRes(@RsCannotCreateDir);
  Name := PathRemoveSeparator(Name);
  {$IFDEF MSWINDOWS}
  ExtractPath := ExtractFilePath(Name);
  if ((Length(Name) = 2) and (Copy(Name, 2,1) = ':')) or DirectoryExists(Name) or (ExtractPath = Name) then
    Exit;
  {$ENDIF MSWINDOWS}
  {$IFDEF UNIX}
  if (Length(Name) = 0) or DirectoryExists(Name) then
    Exit;
  ExtractPath := ExtractFilePath(Name);
  {$ENDIF UNIX}
  Result := (ExtractPath = '') or ForceDirectories(ExtractPath);
  if Result then
  begin
    {$IFDEF MSWINDOWS}
    SetLastError(ERROR_SUCCESS);
    {$ENDIF MSWINDOWS}
    Result := Result and CreateDir(Name);
    {$IFDEF MSWINDOWS}
    Result := Result or (GetLastError = ERROR_ALREADY_EXISTS);
    {$ENDIF MSWINDOWS}
  end;
end;

function GetDirectorySize(const Path: string): Int64;

  function RecurseFolder(const Path: string): Int64;
  var
    F: TSearchRec;
    R: Integer;
    {$IFDEF MSWINDOWS}
    TempSize: TJclULargeInteger;
    {$ENDIF MSWINDOWS}
  begin
    Result := 0;
    R := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindFirst(Path + '*.*', faAnyFile, F);
    if R = 0 then
    try
      while R = 0 do
      begin
        if (F.Name <> '.') and (F.Name <> '..') then
        begin
          if (F.Attr and faDirectory) = faDirectory then
            Inc(Result, RecurseFolder(Path + F.Name + DirDelimiter))
          else
          {$IFDEF MSWINDOWS}
          begin
            TempSize.LowPart := F.FindData.nFileSizeLow;
            TempSize.HighPart := F.FindData.nFileSizeHigh;
            Inc(Result, TempSize.QuadPart);
          end;
          {$ENDIF MSWINDOWS}
          {$IFDEF UNIX}
            // SysUtils.Find* don't perceive files >= 2 GB anyway
            Inc(Result, Int64(F.Size));
          {$ENDIF UNIX}
        end;
        R := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindNext(F);
      end;
      if R <> ERROR_NO_MORE_FILES then
        Abort;
    finally
      {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindClose(F);
    end;
  end;

begin
  if not DirectoryExists(PathRemoveSeparator(Path)) then
    Result := -1
  else
  try
    Result := RecurseFolder(PathAddSeparator(Path))
  except
    Result := -1;
  end;
end;

{$IFDEF MSWINDOWS}

function GetDriveTypeStr(const Drive: Char): string;
var
  DriveType: Integer;
  DriveStr: string;
begin
  if not CharIsDriveLetter(Drive) then
    raise EJclPathError.CreateResFmt(@RsPathInvalidDrive, [Drive]);
  DriveStr := Drive + ':\';
  DriveType := GetDriveType(PChar(DriveStr));
  case DriveType of
    DRIVE_REMOVABLE:
      Result := LoadResString(@RsRemovableDrive);
    DRIVE_FIXED:
      Result := LoadResString(@RsHardDisk);
    DRIVE_REMOTE:
      Result := LoadResString(@RsRemoteDrive);
    DRIVE_CDROM:
      Result := LoadResString(@RsCDRomDrive);
    DRIVE_RAMDISK:
      Result := LoadResString(@RsRamDisk);
    else
      Result := LoadResString(@RsUnknownDrive);
  end;
end;

function GetFileAgeCoherence(const FileName: string): Boolean;
var
  FileAttributesEx: WIN32_FILE_ATTRIBUTE_DATA;
begin
  Result := False;
  if GetFileAttributesEx(PChar(FileName), GetFileExInfoStandard, @FileAttributesEx) then
    {$IFDEF FPC}
    Result := CompareFileTime(@FileAttributesEx.ftCreationTime, @FileAttributesEx.ftLastWriteTime) <= 0;
    {$ELSE ~FPC}
    Result := CompareFileTime(FileAttributesEx.ftCreationTime, FileAttributesEx.ftLastWriteTime) <= 0;
    {$ENDIF ~FPC}
end;

{$ENDIF MSWINDOWS}

procedure GetFileAttributeList(const Items: TStrings; const Attr: Integer);
begin
  { TODO : clear list? }
  Assert(Assigned(Items));
  if not Assigned(Items) then
    Exit;
  Items.BeginUpdate;
  try
    { TODO : differentiate Windows/UNIX idents }
    if Attr and faDirectory = faDirectory then
      Items.Add(LoadResString(@RsAttrDirectory));
    if Attr and faReadOnly = faReadOnly then
      Items.Add(LoadResString(@RsAttrReadOnly));
    if Attr and faSysFile = faSysFile then
      Items.Add(LoadResString(@RsAttrSystemFile));
    if Attr and faArchive = faArchive then
      Items.Add(LoadResString(@RsAttrArchive));
    if Attr and faAnyFile = faAnyFile then
      Items.Add(LoadResString(@RsAttrAnyFile));
    if Attr and faHidden = faHidden then
      Items.Add(LoadResString(@RsAttrHidden));
  finally
    Items.EndUpdate;
  end;
end;

{$IFDEF MSWINDOWS}

{ TODO : GetFileAttributeListEx - Unix version }
procedure GetFileAttributeListEx(const Items: TStrings; const Attr: Integer);
begin
  { TODO : clear list? }
  Assert(Assigned(Items));
  if not Assigned(Items) then
    Exit;
  Items.BeginUpdate;
  try
    if Attr and FILE_ATTRIBUTE_READONLY = FILE_ATTRIBUTE_READONLY then
      Items.Add(LoadResString(@RsAttrReadOnly));
    if Attr and FILE_ATTRIBUTE_HIDDEN = FILE_ATTRIBUTE_HIDDEN then
      Items.Add(LoadResString(@RsAttrHidden));
    if Attr and FILE_ATTRIBUTE_SYSTEM = FILE_ATTRIBUTE_SYSTEM then
      Items.Add(LoadResString(@RsAttrSystemFile));
    if Attr and FILE_ATTRIBUTE_DIRECTORY = FILE_ATTRIBUTE_DIRECTORY then
      Items.Add(LoadResString(@RsAttrDirectory));
    if Attr and FILE_ATTRIBUTE_ARCHIVE = FILE_ATTRIBUTE_ARCHIVE then
      Items.Add(LoadResString(@RsAttrArchive));
    if Attr and FILE_ATTRIBUTE_NORMAL = FILE_ATTRIBUTE_NORMAL then
      Items.Add(LoadResString(@RsAttrNormal));
    if Attr and FILE_ATTRIBUTE_TEMPORARY = FILE_ATTRIBUTE_TEMPORARY then
      Items.Add(LoadResString(@RsAttrTemporary));
    if Attr and FILE_ATTRIBUTE_COMPRESSED = FILE_ATTRIBUTE_COMPRESSED then
      Items.Add(LoadResString(@RsAttrCompressed));
    if Attr and FILE_ATTRIBUTE_OFFLINE = FILE_ATTRIBUTE_OFFLINE then
      Items.Add(LoadResString(@RsAttrOffline));
    if Attr and FILE_ATTRIBUTE_ENCRYPTED = FILE_ATTRIBUTE_ENCRYPTED then
      Items.Add(LoadResString(@RsAttrEncrypted));
    if Attr and FILE_ATTRIBUTE_REPARSE_POINT = FILE_ATTRIBUTE_REPARSE_POINT then
      Items.Add(LoadResString(@RsAttrReparsePoint));
    if Attr and FILE_ATTRIBUTE_SPARSE_FILE = FILE_ATTRIBUTE_SPARSE_FILE then
      Items.Add(LoadResString(@RsAttrSparseFile));
  finally
    Items.EndUpdate;
  end;
end;

{$ENDIF MSWINDOWS}

function GetFileInformation(const FileName: string; out FileInfo: TSearchRec): Boolean;
begin
  Result := FindFirst(FileName, faAnyFile, FileInfo) = 0;
  if Result then
    {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindClose(FileInfo);
end;

function GetFileInformation(const FileName: string): TSearchRec;
begin
  if not GetFileInformation(FileName, Result) then
    RaiseLastOSError;
end;

{$IFDEF UNIX}

{ TODO -cHelp : Author: Robert Rossmair }

function GetFileStatus(const FileName: string; out StatBuf: TStatBuf64;
  const ResolveSymLinks: Boolean): Integer;
begin
  if ResolveSymLinks then
    Result := stat64(PChar(FileName), StatBuf)
  else
    Result := lstat64(PChar(FileName), StatBuf);
end;

{$ENDIF UNIX}

{$IFDEF MSWINDOWS}

function GetFileLastWrite(const FileName: string): TFileTime;
begin
  Result := GetFileInformation(FileName).FindData.ftLastWriteTime;
end;

function GetFileLastWrite(const FileName: string; out LocalTime: TDateTime): Boolean;
var
  FileInfo: TSearchRec;
begin
  Result := GetFileInformation(FileName, FileInfo);
  if Result then
    LocalTime := FileTimeToLocalDateTime(FileInfo.FindData.ftLastWriteTime);
end;

{$ENDIF MSWINDOWS}

{$IFDEF UNIX}

function GetFileLastWrite(const FileName: string; out TimeStamp: Integer; ResolveSymLinks: Boolean): Boolean;
var
  Buf: TStatBuf64;
begin
  Result := GetFileStatus(FileName, Buf, ResolveSymLinks) = 0;
  if Result then
    TimeStamp := Buf.st_mtime
end;

function GetFileLastWrite(const FileName: string; out LocalTime: TDateTime; ResolveSymLinks: Boolean): Boolean;
var
  Buf: TStatBuf64;
begin
  Result := GetFileStatus(FileName, Buf, ResolveSymLinks) = 0;
  if Result then
    LocalTime := FileDateToDateTime(Buf.st_mtime);
end;

function GetFileLastWrite(const FileName: string; ResolveSymLinks: Boolean): Integer;
var
  Buf: TStatBuf64;
begin
  if GetFileStatus(FileName, Buf, ResolveSymLinks) = 0 then
    Result := Buf.st_mtime
  else
    Result := -1;
end;

{$ENDIF UNIX}

{$IFDEF MSWINDOWS}

function GetFileLastAccess(const FileName: string): TFileTime;
begin
  Result := GetFileInformation(FileName).FindData.ftLastAccessTime;
end;

function GetFileLastAccess(const FileName: string; out LocalTime: TDateTime): Boolean;
var
  FileInfo: TSearchRec;
begin
  Result := GetFileInformation(FileName, FileInfo);
  if Result then
    LocalTime := FileTimeToLocalDateTime(GetFileInformation(FileName).FindData.ftLastAccessTime);
end;

{$ENDIF MSWINDOWS}

{$IFDEF UNIX}

function GetFileLastAccess(const FileName: string; out TimeStamp: Integer; ResolveSymLinks: Boolean): Boolean;
var
  Buf: TStatBuf64;
begin
  Result := GetFileStatus(FileName, Buf, ResolveSymLinks) = 0;
  if Result then
    TimeStamp := Buf.st_atime
end;

function GetFileLastAccess(const FileName: string; out LocalTime: TDateTime; ResolveSymLinks: Boolean): Boolean;
var
  Buf: TStatBuf64;
begin
  Result := GetFileStatus(FileName, Buf, ResolveSymLinks) = 0;
  if Result then
    LocalTime := FileDateToDateTime(Buf.st_atime);
end;

function GetFileLastAccess(const FileName: string; ResolveSymLinks: Boolean): Integer;
var
  Buf: TStatBuf64;
begin
  if GetFileStatus(FileName, Buf, ResolveSymLinks) = 0 then
    Result := Buf.st_atime
  else
    Result := -1;
end;

{$ENDIF UNIX}

{$IFDEF MSWINDOWS}

function GetFileCreation(const FileName: string): TFileTime;
begin
  Result := GetFileInformation(FileName).FindData.ftCreationTime;
end;

function GetFileCreation(const FileName: string; out LocalTime: TDateTime): Boolean;
var
  FileInfo: TSearchRec;
begin
  Result := GetFileInformation(FileName, FileInfo);
  if Result then
    LocalTime := FileTimeToLocalDateTime(GetFileInformation(FileName).FindData.ftCreationTime);
end;

{$ENDIF MSWINDOWS}

{$IFDEF UNIX}

function GetFileLastAttrChange(const FileName: string; out TimeStamp: Integer; ResolveSymLinks: Boolean): Boolean;
var
  Buf: TStatBuf64;
begin
  Result := GetFileStatus(FileName, Buf, ResolveSymLinks) = 0;
  if Result then
    TimeStamp := Buf.st_ctime
end;

function GetFileLastAttrChange(const FileName: string; out LocalTime: TDateTime; ResolveSymLinks: Boolean): Boolean;
var
  Buf: TStatBuf64;
begin
  Result := GetFileStatus(FileName, Buf, ResolveSymLinks) = 0;
  if Result then
    LocalTime := FileDateToDateTime(Buf.st_ctime);
end;

function GetFileLastAttrChange(const FileName: string; ResolveSymLinks: Boolean): Integer;
var
  Buf: TStatBuf64;
begin
  if GetFileStatus(FileName, Buf, ResolveSymLinks) = 0 then
    Result := Buf.st_ctime
  else
    Result := -1;
end;

{$ENDIF UNIX}

function GetModulePath(const Module: HMODULE): string;
var
  L: Integer;
begin
  L := MAX_PATH + 1;
  SetLength(Result, L);
  {$IFDEF MSWINDOWS}
  L := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetModuleFileName(Module, Pointer(Result), L);
  {$ENDIF MSWINDOWS}
  {$IFDEF UNIX}
  {$IFDEF FPC}
  L := 0; // FIXME
  {$ELSE ~FPC}
  L := GetModuleFileName(Module, Pointer(Result), L);
  {$ENDIF ~FPC}
  {$ENDIF UNIX}
  SetLength(Result, L);
end;

function GetSizeOfFile(const FileName: string): Int64;
{$IFDEF MSWINDOWS}
var
  FileAttributesEx: WIN32_FILE_ATTRIBUTE_DATA;
  Size: TJclULargeInteger;
begin
  {$IFNDEF COMPILER37_UP}
  Result := 0;
  {$ENDIF ~COMPILER37_UP}
  if GetFileAttributesEx(PChar(FileName), GetFileExInfoStandard, @FileAttributesEx) then
  begin
    Size.LowPart := FileAttributesEx.nFileSizeLow;
    Size.HighPart := FileAttributesEx.nFileSizeHigh;
    Result := Size.QuadPart;
  end
  else
    RaiseLastOSError;
end;
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
var
  Buf: TStatBuf64;
begin
  if GetFileStatus(FileName, Buf, False) <> 0 then
    RaiseLastOSError;
  Result := Buf.st_size;
end;
{$ENDIF UNIX}

{$IFDEF MSWINDOWS}
function GetSizeOfFile(Handle: THandle): Int64; overload;
var
  Size: TJclULargeInteger;
begin
  Size.LowPart := GetFileSize(Handle, @Size.HighPart);
  Result := Size.QuadPart;
end;
{$ENDIF MSWINDOWS}

function GetSizeOfFile(const FileInfo: TSearchRec): Int64;
{$IFDEF MSWINDOWS}
begin
  Int64Rec(Result).Lo := FileInfo.FindData.nFileSizeLow;
  Int64Rec(Result).Hi := FileInfo.FindData.nFileSizeHigh;
end;
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
var
  Buf: TStatBuf64;
begin
  // rr: Note that SysUtils.FindFirst/Next ignore files >= 2 GB under Linux,
  //     thus the following code is rather pointless at the moment of this writing.
  //     We apparently need to write our own set of Findxxx functions to overcome this limitation.
  if GetFileStatus(FileInfo.PathOnly + FileInfo.Name, Buf, True) <> 0 then
    Result := -1
  else
    Result := Buf.st_size
end;
{$ENDIF UNIX}

{$IFDEF MSWINDOWS}

{$IFDEF FPC}
{ TODO : Move this over to JclWin32 when JclWin32 gets overhauled. }
function GetFileAttributesEx(lpFileName: PChar;
  fInfoLevelId: TGetFileExInfoLevels; lpFileInformation: Pointer): BOOL; stdcall;
external kernel32 name 'GetFileAttributesExA';
{$ENDIF FPC}

function GetStandardFileInfo(const FileName: string): TWin32FileAttributeData;
var
  Handle: THandle;
  FileInfo: TByHandleFileInformation;
begin
  Assert(FileName <> '');
  { TODO : Use RTDL-Version of GetFileAttributesEx }
  if IsWin95 or IsWin95OSR2 or IsWinNT3 then
  begin
    Handle := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
    if Handle <> INVALID_HANDLE_VALUE then
    try
      FileInfo.dwFileAttributes := 0;
      if not GetFileInformationByHandle(Handle, FileInfo) then
        raise EJclFileUtilsError.CreateResFmt(@RsFileUtilsAttrUnavailable, [FileName]);
      Result.dwFileAttributes := FileInfo.dwFileAttributes;
      Result.ftCreationTime := FileInfo.ftCreationTime;
      Result.ftLastAccessTime := FileInfo.ftLastAccessTime;
      Result.ftLastWriteTime := FileInfo.ftLastWriteTime;
      Result.nFileSizeHigh := FileInfo.nFileSizeHigh;
      Result.nFileSizeLow := FileInfo.nFileSizeLow;
    finally
      CloseHandle(Handle);
    end
    else
      raise EJclFileUtilsError.CreateResFmt(@RsFileUtilsAttrUnavailable, [FileName]);
  end
  else
  begin
    if not GetFileAttributesEx(PChar(FileName), GetFileExInfoStandard, @Result) then
      raise EJclFileUtilsError.CreateResFmt(@RsFileUtilsAttrUnavailable, [FileName]);
  end;
end;

{$ENDIF MSWINDOWS}

{$IFDEF MSWINDOWS}
function IsDirectory(const FileName: string): Boolean;
var
  R: DWORD;
begin
  R := GetFileAttributes(PChar(FileName));
  Result := (R <> DWORD(-1)) and ((R and FILE_ATTRIBUTE_DIRECTORY) <> 0);
end;
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
function IsDirectory(const FileName: string; ResolveSymLinks: Boolean): Boolean;
var
  Buf: TStatBuf64;
begin
  Result := False;
  if GetFileStatus(FileName, Buf, ResolveSymLinks) = 0 then
    Result := S_ISDIR(Buf.st_mode);
end;
{$ENDIF UNIX}

function IsRootDirectory(const CanonicFileName: string): Boolean;
{$IFDEF MSWINDOWS}
var
  I: Integer;
begin
  I := Pos(':\', CanonicFileName);
  Result := (I > 0) and (I + 1 = Length(CanonicFileName));
end;
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
begin
  Result := CanonicFileName = DirDelimiter;
end;
{$ENDIF UNIX}

{$IFDEF MSWINDOWS}

function LockVolume(const Volume: string; var Handle: THandle): Boolean;
var
  BytesReturned: DWORD;
begin
  Result := False;
  Handle := CreateFile(PChar('\\.\' + Volume), GENERIC_READ or GENERIC_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING,
    FILE_FLAG_NO_BUFFERING, 0);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    BytesReturned := 0;
    Result := DeviceIoControl(Handle, FSCTL_LOCK_VOLUME, nil, 0, nil, 0,
      BytesReturned, nil);
    if not Result then
    begin
      CloseHandle(Handle);
      Handle := INVALID_HANDLE_VALUE;
    end;
  end;
end;

function OpenVolume(const Drive: Char): THandle;
var
  VolumeName: array [0..6] of Char;
begin
  VolumeName := '\\.\A:';
  VolumeName[4] := Drive;
  Result := CreateFile(VolumeName, GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE,
    nil, OPEN_EXISTING, 0, 0);
end;

{$ENDIF MSWINDOWS}

type
  // indicates the file time to set, used by SetFileTimesHelper and SetDirTimesHelper
  TFileTimes = (ftLastAccess, ftLastWrite {$IFDEF MSWINDOWS}, ftCreation {$ENDIF});

{$IFDEF MSWINDOWS}
function SetFileTimesHelper(const FileName: string; const DateTime: TDateTime; Times: TFileTimes): Boolean;
var
  Handle: THandle;
  FileTime: TFileTime;
  SystemTime: TSystemTime;
begin
  Result := False;
  Handle := CreateFile(PChar(FileName), GENERIC_WRITE, FILE_SHARE_READ, nil,
    OPEN_EXISTING, 0, 0);
  if Handle <> INVALID_HANDLE_VALUE then
  try
    //SysUtils.DateTimeToSystemTime(DateTimeToLocalDateTime(DateTime), SystemTime);
    {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.DateTimeToSystemTime(DateTime, SystemTime);
    FileTime.dwLowDateTime := 0;
    FileTime.dwHighDateTime := 0;
    if {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.SystemTimeToFileTime(SystemTime, FileTime) then
    begin
      case Times of
        ftLastAccess:
          Result := SetFileTime(Handle, nil, @FileTime, nil);
        ftLastWrite:
          Result := SetFileTime(Handle, nil, nil, @FileTime);
        ftCreation:
          Result := SetFileTime(Handle, @FileTime, nil, nil);
      end;
    end;
  finally
    CloseHandle(Handle);
  end;
end;
{$ENDIF MSWINDOWS}

{$IFDEF UNIX}
function SetFileTimesHelper(const FileName: string; const DateTime: TDateTime; Times: TFileTimes): Boolean;
var
  FileTime: Integer;
  StatBuf: TStatBuf64;
  TimeBuf: utimbuf;
begin
  Result := False;
  FileTime := DateTimeToFileDate(DateTime);
  if GetFileStatus(FileName, StatBuf, False) = 0 then
  begin
    TimeBuf.actime := StatBuf.st_atime;
    TimeBuf.modtime := StatBuf.st_mtime;
    case Times of
      ftLastAccess:
        TimeBuf.actime := FileTime;
      ftLastWrite:
        TimeBuf.modtime := FileTime;
    end;
    Result := utime(PChar(FileName), @TimeBuf) = 0;
  end;
end;
{$ENDIF UNIX}

function SetFileLastAccess(const FileName: string; const DateTime: TDateTime): Boolean;
begin
  Result := SetFileTimesHelper(FileName, DateTime, ftLastAccess);
end;

function SetFileLastWrite(const FileName: string; const DateTime: TDateTime): Boolean;
begin
  Result := SetFileTimesHelper(FileName, DateTime, ftLastWrite);
end;

{$IFDEF MSWINDOWS}

function SetFileCreation(const FileName: string; const DateTime: TDateTime): Boolean;
begin
  Result := SetFileTimesHelper(FileName, DateTime, ftCreation);
end;

// utility function for SetDirTimesHelper

function BackupPrivilegesEnabled: Boolean;
begin
  Result := IsPrivilegeEnabled(SE_BACKUP_NAME) and IsPrivilegeEnabled(SE_RESTORE_NAME);
end;

function SetDirTimesHelper(const DirName: string; const DateTime: TDateTime;
  Times: TFileTimes; RequireBackupRestorePrivileges: Boolean): Boolean;
var
  Handle: THandle;
  FileTime: TFileTime;
  SystemTime: TSystemTime;
begin
  Result := False;
  if IsDirectory(DirName) and (not RequireBackupRestorePrivileges or BackupPrivilegesEnabled) then
  begin
    Handle := CreateFile(PChar(DirName), GENERIC_WRITE, FILE_SHARE_READ, nil,
      OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
    if Handle <> INVALID_HANDLE_VALUE then
    try
      {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.DateTimeToSystemTime(DateTime, SystemTime);
      FileTime.dwLowDateTime := 0;
      FileTime.dwHighDateTime := 0;
      {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.SystemTimeToFileTime(SystemTime, FileTime);
      case Times of
        ftLastAccess:
          Result := SetFileTime(Handle, nil, @FileTime, nil);
        ftLastWrite:
          Result := SetFileTime(Handle, nil, nil, @FileTime);
        ftCreation:
          Result := SetFileTime(Handle, @FileTime, nil, nil);
      end;
    finally
      CloseHandle(Handle);
    end;
  end;
end;

function SetDirLastWrite(const DirName: string; const DateTime: TDateTime; RequireBackupRestorePrivileges: Boolean = True): Boolean;
begin
  Result := SetDirTimesHelper(DirName, DateTime, ftLastWrite, RequireBackupRestorePrivileges);
end;

function SetDirLastAccess(const DirName: string; const DateTime: TDateTime; RequireBackupRestorePrivileges: Boolean = True): Boolean;
begin
  Result := SetDirTimesHelper(DirName, DateTime, ftLastAccess, RequireBackupRestorePrivileges);
end;

function SetDirCreation(const DirName: string; const DateTime: TDateTime; RequireBackupRestorePrivileges: Boolean = True): Boolean;
begin
  Result := SetDirTimesHelper(DirName, DateTime, ftCreation, RequireBackupRestorePrivileges);
end;

procedure FillByteArray(var Bytes: array of Byte; Count: Cardinal; B: Byte);
begin
  FillMemory(@Bytes[0], Count, B);
end;

procedure ShredFile(const FileName: string; Times: Integer);
const
  BUFSIZE   = 4096;
  ODD_FILL  = $C1;
  EVEN_FILL = $3E;
var
  Fs: TFileStream;
  Size: Integer;
  N: Integer;
  ContentPtr: array of Byte;
begin
  Size := FileGetSize(FileName);
  if Size > 0 then
  begin
    if Times < 0 then
      Times := 2
    else
      Times := Times * 2;
    ContentPtr := nil;
    Fs := TFileStream.Create(FileName, fmOpenReadWrite);
    try
      SetLength(ContentPtr, BUFSIZE);
      while Times > 0 do
      begin
        if Times mod 2 = 0 then
          FillByteArray(ContentPtr, BUFSIZE, EVEN_FILL)
        else
          FillByteArray(ContentPtr, BUFSIZE, ODD_FILL);
        Fs.Seek(0, soBeginning);
        N := Size div BUFSIZE;
        while N > 0 do
        begin
          Fs.Write(ContentPtr[0], BUFSIZE);
          Dec(N);
        end;
        N := Size mod BUFSIZE;
        if N > 0 then
          Fs.Write(ContentPtr[0], N);
        FlushFileBuffers(Fs.Handle);
        Dec(Times);
      end;
    finally
      ContentPtr := nil;
      Fs.Free;
      DeleteFile(FileName);
    end;
  end
  else
    DeleteFile(FileName);
end;

function UnlockVolume(var Handle: THandle): Boolean;
var
  BytesReturned: DWORD;
begin
  Result := False;
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    BytesReturned := 0;
    Result := DeviceIoControl(Handle, FSCTL_UNLOCK_VOLUME, nil, 0, nil, 0,
      BytesReturned, nil);
    if Result then
    begin
      CloseHandle(Handle);
      Handle := INVALID_HANDLE_VALUE;
    end;
  end;
end;

{$ENDIF MSWINDOWS}

{$IFDEF UNIX}

function CreateSymbolicLink(const Name, Target: string): Boolean;
begin
  Result := symlink(PChar(Target), PChar(Name)) = 0;
end;

function SymbolicLinkTarget(const Name: string): string;
var
  N, BufLen: Integer;
begin
  BufLen := 128;
  repeat
    Inc(BufLen, BufLen);
    SetLength(Result, BufLen);
    N := readlink(PChar(Name), PChar(Result), BufLen);
    if N < 0 then // Error
    begin
      Result := '';
      Exit;
    end;
  until N < BufLen;
  SetLength(Result, N);
end;

{$ENDIF UNIX}

//=== File Version info routines =============================================

{$IFDEF MSWINDOWS}

const
  VerKeyNames: array [1..12] of string =
   ('Comments',
    'CompanyName',
    'FileDescription',
    'FileVersion',
    'InternalName',
    'LegalCopyright',
    'LegalTradeMarks',
    'OriginalFilename',
    'ProductName',
    'ProductVersion',
    'SpecialBuild',
    'PrivateBuild');

function OSIdentToString(const OSIdent: DWORD): string;
begin
  case OSIdent of
    VOS_UNKNOWN:
      Result := LoadResString(@RsVosUnknown);
    VOS_DOS:
      Result := LoadResString(@RsVosDos);
    VOS_OS216:
      Result := LoadResString(@RsVosOS216);
    VOS_OS232:
      Result := LoadResString(@RsVosOS232);
    VOS_NT:
      Result := LoadResString(@RsVosNT);
    VOS__WINDOWS16:
      Result := LoadResString(@RsVosWindows16);
    VOS__PM16:
      Result := LoadResString(@RsVosPM16);
    VOS__PM32:
      Result := LoadResString(@RsVosPM32);
    VOS__WINDOWS32:
      Result := LoadResString(@RsVosWindows32);
    VOS_DOS_WINDOWS16:
      Result := LoadResString(@RsVosDosWindows16);
    VOS_DOS_WINDOWS32:
      Result := LoadResString(@RsVosDosWindows32);
    VOS_OS216_PM16:
      Result := LoadResString(@RsVosOS216PM16);
    VOS_OS232_PM32:
      Result := LoadResString(@RsVosOS232PM32);
    VOS_NT_WINDOWS32:
      Result := LoadResString(@RsVosNTWindows32);
  else
    Result := '';
  end;
  if Result = '' then
    Result := LoadResString(@RsVosUnknown)
  else
    Result := Format(LoadResString(@RsVosDesignedFor), [Result]);
end;

function OSFileTypeToString(const OSFileType: DWORD; const OSFileSubType: DWORD): string;
begin
  case OSFileType of
    VFT_UNKNOWN:
      Result := LoadResString(@RsVftUnknown);
    VFT_APP:
      Result := LoadResString(@RsVftApp);
    VFT_DLL:
      Result := LoadResString(@RsVftDll);
    VFT_DRV:
      begin
        case OSFileSubType of
          VFT2_DRV_PRINTER:
            Result := LoadResString(@RsVft2DrvPRINTER);
          VFT2_DRV_KEYBOARD:
            Result := LoadResString(@RsVft2DrvKEYBOARD);
          VFT2_DRV_LANGUAGE:
            Result := LoadResString(@RsVft2DrvLANGUAGE);
          VFT2_DRV_DISPLAY:
            Result := LoadResString(@RsVft2DrvDISPLAY);
          VFT2_DRV_MOUSE:
            Result := LoadResString(@RsVft2DrvMOUSE);
          VFT2_DRV_NETWORK:
            Result := LoadResString(@RsVft2DrvNETWORK);
          VFT2_DRV_SYSTEM:
            Result := LoadResString(@RsVft2DrvSYSTEM);
          VFT2_DRV_INSTALLABLE:
            Result := LoadResString(@RsVft2DrvINSTALLABLE);
          VFT2_DRV_SOUND:
            Result := LoadResString(@RsVft2DrvSOUND);
          VFT2_DRV_COMM:
            Result := LoadResString(@RsVft2DrvCOMM);
        else
          Result := '';
        end;
        Result := Result + ' ' + LoadResString(@RsVftDrv);
      end;
    VFT_FONT:
      begin
        case OSFileSubType of
          VFT2_FONT_RASTER:
            Result := LoadResString(@RsVft2FontRASTER);
          VFT2_FONT_VECTOR:
            Result := LoadResString(@RsVft2FontVECTOR);
          VFT2_FONT_TRUETYPE:
            Result := LoadResString(@RsVft2FontTRUETYPE);
        else
          Result := '';
        end;
        Result := Result + ' ' + LoadResString(@RsVftFont);
      end;
    VFT_VXD:
      Result := LoadResString(@RsVftVxd);
    VFT_STATIC_LIB:
      Result := LoadResString(@RsVftStaticLib);
  else
    Result := '';
  end;
  Result := TrimLeft(Result);
end;

function VersionResourceAvailable(const FileName: string): Boolean;
var
  Size: DWORD;
  Handle: DWORD;
  Buffer: string;
begin
  Result := False;
  Handle := 0;
  Size := GetFileVersionInfoSize(PChar(FileName), Handle);
  if Size > 0 then
  begin
    SetLength(Buffer, Size);
    Result := GetFileVersionInfo(PChar(FileName), Handle, Size, PChar(Buffer));
  end;
end;

function VersionResourceAvailable(const Window: HWND): Boolean;
begin
  Result := VersionResourceAvailable(WindowToModuleFileName(Window));
end;

function VersionResourceAvailable(const Module: HMODULE): Boolean;
begin
  if Module <> 0 then
    Result :=VersionResourceAvailable(GetModulePath(Module))
  else
    raise EJclError.CreateResFmt(@RsEModuleNotValid, [Module]);
end;

function WindowToModuleFileName(const Window: HWND): string;
type
  {$IFDEF SUPPORTS_UNICODE}
  TGetModuleFileNameEx = function(hProcess: THandle; hModule: HMODULE; FileName: PWideChar; nSize: DWORD): DWORD; stdcall;
  TQueryFullProcessImageName = function(HProcess: THandle; dwFlags: DWORD; lpExeName: PWideChar; lpdwSize: PDWORD): BOOL; stdcall;
  {$ELSE ~SUPPORTS_UNICODE}
  TGetModuleFileNameEx = function(hProcess: THandle; hModule: HMODULE; FileName: PAnsiChar; nSize: DWORD): DWORD; stdcall;
  TQueryFullProcessImageName = function(HProcess: THandle; dwFlags: DWORD; lpExeName: PAnsiChar; lpdwSize: PDWORD): BOOL; stdcall;
  {$ENDIF ~SUPPORTS_UNICODE}
var
  FileName: array[0..300] of Char;
  DllHinst: HMODULE;
  ProcessID: DWORD;
  HProcess: THandle;
  GetModuleFileNameExAddress: TGetModuleFileNameEx;
  QueryFullProcessImageNameAddress: TQueryFullProcessImageName;
  Len: DWORD;
begin
  Result := '';
  if Window <> 0 then
  begin
    if not JclCheckWinVersion(5, 0) then // Win2k or newer required
      raise EJclWin32Error.CreateRes(@RsEWindowsVersionNotSupported);

    {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetWindowThreadProcessId(Window, @ProcessID);
    hProcess := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, false, ProcessID);
    if hProcess <> 0 then
    begin
      try
        if JclCheckWinVersion(6, 0) then // WinVista or newer
        begin
          DllHinst := LoadLibrary('Kernel32.dll');
          if DllHinst <> 0 then
          begin
            try
              {$IFDEF SUPPORTS_UNICODE}
              QueryFullProcessImageNameAddress := GetProcAddress(DllHinst, 'QueryFullProcessImageNameW');
              {$ELSE ~SUPPORTS_UNICODE}
              QueryFullProcessImageNameAddress := GetProcAddress(DllHinst, 'QueryFullProcessImageNameA');
              {$ENDIF ~SUPPORTS_UNICODE}
              if Assigned(QueryFullProcessImageNameAddress) then
              begin
                Len := Length(FileName);
                if QueryFullProcessImageNameAddress(hProcess, 0, FileName, PDWORD(@Len)) then
                  Result := FileName;
                //else
                //  RaiseLastOSError   would be nice, but it didn't raise an exception before the return value was checked
              end
              else
                raise EJclError.CreateResFmt(@RsEFunctionNotFound, ['Kernel32.dll', 'QueryFullProcessImageName']);
            finally
              FreeLibrary(DllHinst);
            end;
          end
          else
            raise EJclError.CreateResFmt(@RsELibraryNotFound, ['Kernel32.dll']);
        end
        else
        begin
          DllHinst := LoadLibrary('Psapi.dll');
          if DllHinst <> 0 then
          begin
            try
              {$IFDEF SUPPORTS_UNICODE}
              GetModuleFileNameExAddress := GetProcAddress(DllHinst, 'GetModuleFileNameExW');
              {$ELSE ~SUPPORTS_UNICODE}
              GetModuleFileNameExAddress := GetProcAddress(DllHinst, 'GetModuleFileNameExA');
              {$ENDIF ~SUPPORTS_UNICODE}
              if Assigned(GetModuleFileNameExAddress) then
              begin
                Len := GetModuleFileNameExAddress(hProcess, 0, FileName, Length(FileName));
                if Len > 0 then
                  Result := FileName;
                //else
                //  RaiseLastOSError;   would be nice, but it didn't raise an exception before the return value was checked
              end
              else
                raise EJclError.CreateResFmt(@RsEFunctionNotFound, ['Psapi.dll', 'GetModuleFileNameEx']);
            finally
              FreeLibrary(DllHinst);
            end;
          end
          else
            raise EJclError.CreateResFmt(@RsELibraryNotFound, ['Psapi.dll']);
        end;
      finally
        CloseHandle(hProcess);
      end;
    end
    else
      raise EJclError.CreateResFmt(@RsEProcessNotValid, [ProcessID]);
  end
  else
    raise EJclError.CreateResFmt(@RsEWindowNotValid, [Window]);
end;

{$ENDIF MSWINDOWS}

// Version Info formatting
function FormatVersionString(const HiV, LoV: Word): string;
begin
  Result := Format('%u.%.2u', [HiV, LoV]);
end;

function FormatVersionString(const Major, Minor, Build, Revision: Word): string;
begin
  Result := Format('%u.%u.%u.%u', [Major, Minor, Build, Revision]);
end;

{$IFDEF MSWINDOWS}

function FormatVersionString(const FixedInfo: TVSFixedFileInfo; VersionFormat: TFileVersionFormat): string;
begin
  case VersionFormat of
    vfMajorMinor:
      Result := Format('%u.%u', [HiWord(FixedInfo.dwFileVersionMS), LoWord(FixedInfo.dwFileVersionMS)]);
    vfFull:
      Result := Format('%u.%u.%u.%u', [HiWord(FixedInfo.dwFileVersionMS), LoWord(FixedInfo.dwFileVersionMS),
        HiWord(FixedInfo.dwFileVersionLS), LoWord(FixedInfo.dwFileVersionLS)]);
  end;
end;

// Version Info extracting
procedure VersionExtractFileInfo(const FixedInfo: TVSFixedFileInfo; var Major, Minor, Build, Revision: Word);
begin
  Major := HiWord(FixedInfo.dwFileVersionMS);
  Minor := LoWord(FixedInfo.dwFileVersionMS);
  Build := HiWord(FixedInfo.dwFileVersionLS);
  Revision := LoWord(FixedInfo.dwFileVersionLS);
end;

procedure VersionExtractProductInfo(const FixedInfo: TVSFixedFileInfo; var Major, Minor, Build, Revision: Word);
begin
  Major := HiWord(FixedInfo.dwProductVersionMS);
  Minor := LoWord(FixedInfo.dwProductVersionMS);
  Build := HiWord(FixedInfo.dwProductVersionLS);
  Revision := LoWord(FixedInfo.dwProductVersionLS);
end;

// Fixed Version Info routines
function VersionFixedFileInfo(const FileName: string; var FixedInfo: TVSFixedFileInfo): Boolean;
var
  Size, FixInfoLen: DWORD;
  Handle: DWORD;
  Buffer: string;
  FixInfoBuf: PVSFixedFileInfo;
begin
  Result := False;
  Handle := 0;
  Size := GetFileVersionInfoSize(PChar(FileName), Handle);
  if Size > 0 then
  begin
    SetLength(Buffer, Size);
    FixInfoLen := 0;
    FixInfoBuf := nil;
    if GetFileVersionInfo(PChar(FileName), Handle, Size, Pointer(Buffer)) and
      VerQueryValue(Pointer(Buffer), DirDelimiter, Pointer(FixInfoBuf), FixInfoLen) and
      (FixInfoLen = SizeOf(TVSFixedFileInfo)) then
    begin
      Result := True;
      FixedInfo := FixInfoBuf^;
    end;
  end;
end;

function VersionFixedFileInfoString(const FileName: string; VersionFormat: TFileVersionFormat;
  const NotAvailableText: string): string;
var
  FixedInfo: TVSFixedFileInfo;
begin
  FixedInfo.dwSignature := 0;
  if VersionFixedFileInfo(FileName, FixedInfo) then
    Result := FormatVersionString(FixedInfo, VersionFormat)
  else
    Result := NotAvailableText;
end;

//=== { TJclFileVersionInfo } ================================================

constructor TJclFileVersionInfo.Attach(VersionInfoData: Pointer; Size: Integer);
begin
  SetLength(FBuffer, Size);
  CopyMemory(PAnsiChar(FBuffer), VersionInfoData, Size);
  ExtractData;
end;

constructor TJclFileVersionInfo.Create(const FileName: string);
var
  Handle: DWORD;
  Size: DWORD;
begin
  if not FileExists(FileName) then
    raise EJclFileVersionInfoError.CreateResFmt(@RsFileUtilsFileDoesNotExist, [FileName]);
  Handle := 0;
  Size := GetFileVersionInfoSize(PChar(FileName), Handle);
  if Size = 0 then
    raise EJclFileVersionInfoError.CreateRes(@RsFileUtilsNoVersionInfo);
  SetLength(FBuffer, Size);
  Win32Check(GetFileVersionInfo(PChar(FileName), Handle, Size, PAnsiChar(FBuffer)));
  ExtractData;
end;

{$IFDEF MSWINDOWS}
{$IFDEF FPC}
constructor TJclFileVersionInfo.Create(const Window: HWND; Dummy: Pointer = nil);
{$ELSE}
constructor TJclFileVersionInfo.Create(const Window: HWND);
{$ENDIF}
begin
  Create(WindowToModuleFileName(Window));
end;

constructor TJclFileVersionInfo.Create(const Module: HMODULE);
begin
  if Module <> 0 then
    Create(GetModulePath(Module))
  else
    raise EJclError.CreateResFmt(@RsEModuleNotValid, [Module]);
end;
{$ENDIF MSWINDOWS}

destructor TJclFileVersionInfo.Destroy;
begin
  FreeAndNil(FItemList);
  FreeAndNil(FItems);
  inherited Destroy;
end;

class function TJclFileVersionInfo.FileHasVersionInfo(const FileName: string): boolean;
var
  Dummy: DWord;
begin
  Result := GetFileVersionInfoSize(PChar(FileName), Dummy) <> 0;
end;

procedure TJclFileVersionInfo.CheckLanguageIndex(Value: Integer);
begin
  if (Value < 0) or (Value >= LanguageCount) then
    raise EJclFileVersionInfoError.CreateRes(@RsFileUtilsLanguageIndex);
end;

procedure TJclFileVersionInfo.CreateItemsForLanguage;
var
  I: Integer;
begin
  Items.Clear;
  for I := 0 to FItemList.Count - 1 do
    if Integer(FItemList.Objects[I]) = FLanguageIndex then
      Items.AddObject(FItemList[I], Pointer(FLanguages[FLanguageIndex].Pair));
end;

procedure TJclFileVersionInfo.ExtractData;
var
  Data, EndOfData: PAnsiChar;
  Len, ValueLen, DataType: Word;
  HeaderSize: Integer;
  Key: string;
  Error, IsUnicode: Boolean;

  procedure Padding(var DataPtr: PAnsiChar);
  begin
    while TJclAddr(DataPtr) and 3 <> 0 do
      Inc(DataPtr);
  end;

  procedure GetHeader;
  var
    P: PAnsiChar;
    TempKey: PWideChar;
  begin
    Key := '';
    P := Data;
    Len := PWord(P)^;
    if Len = 0 then
    begin
      // do not raise error in the case of resources padded with 0
      while P < EndOfData do
      begin
        Error := P^ <> #0;
        if Error then
          Break;
        Inc(P);
      end;
      Exit;
    end;
    Inc(P, SizeOf(Word));
    ValueLen := PWord(P)^;
    Inc(P, SizeOf(Word));
    if IsUnicode then
    begin
      DataType := PWord(P)^;
      Inc(P, SizeOf(Word));
      TempKey := PWideChar(P);
      Inc(P, (lstrlenW(TempKey) + 1) * SizeOf(WideChar)); // length + #0#0
      Key := TempKey;
    end
    else
    begin
      DataType := 1;
      Key := string(PAnsiChar(P));
      Inc(P, lstrlenA(PAnsiChar(P)) + 1);
    end;
    Padding(P);
    HeaderSize := P - Data;
    Data := P;
  end;

  procedure FixKeyValue;
  const
    HexNumberCPrefix = '0x';
  var
    I: Integer;
  begin // GAPI32.DLL version 5.5.2803.1 contanins '04050x04E2' value
    repeat
      I := Pos(HexNumberCPrefix, Key);
      if I > 0 then
        Delete(Key, I, Length(HexNumberCPrefix));
    until I = 0;
    I := 1;
    while I <= Length(Key) do
      if CharIsHexDigit(Key[I]) then
        Inc(I)
      else
        Delete(Key, I, 1);

    // Office16\1031\GrooveIntlResource.dll contains a '4094B0' key. Both parts (lang and codepage)
    // are missing their leading zero. It should have been '040904B0'.
    // The Windows file property dialog falls back to "English (United States) 1252", so do we.
    if Length(Key) < 8 then
      Key := '040904E4';
  end;

  procedure ProcessStringInfo(Size: Integer);
  var
    EndPtr, EndStringPtr: PAnsiChar;
    LangIndex: Integer;
    LangIdRec: TLangIdRec;
    Value: string;
  begin
    EndPtr := Data + Size;
    LangIndex := 0;
    while not Error and (Data < EndPtr) do
    begin
      GetHeader; // StringTable
      FixKeyValue;
      if (ValueLen <> 0) or (Length(Key) <> 8) then
      begin
        Error := True;
        Break;
      end;
      Padding(Data);
      LangIdRec.LangId := StrToIntDef('$' + Copy(Key, 1, 4), 0);
      LangIdRec.CodePage := StrToIntDef('$' + Copy(Key, 5, 4), 0);
      SetLength(FLanguages, LangIndex + 1);
      FLanguages[LangIndex] := LangIdRec;
      EndStringPtr := Data + Len - HeaderSize;
      while not Error and (Data < EndStringPtr) do
      begin
        GetHeader; // string
        case DataType of
          0:
            if ValueLen in [1..4] then
              Value := Format('$%.*x', [ValueLen * 2, PInteger(Data)^])
            else
            begin
              if (ValueLen > 0) and IsUnicode then
                Value:=PWideChar(Data)
              else
                Value := '';
            end;
          1:
            if ValueLen = 0 then
              Value := ''
            else
            if IsUnicode then
            begin
              Value := WideCharLenToString(PWideChar(Data), ValueLen);
              StrResetLength(Value);
            end
            else
              Value := string(PAnsiChar(Data));
        else
          Error := True;
          Break;
        end;
        Inc(Data, Len - HeaderSize);
        Padding(Data); // String.Padding
        FItemList.AddObject(Format('%s=%s', [Key, Value]), Pointer(LangIndex));
      end;
      Inc(LangIndex);
    end;
  end;

  procedure ProcessVarInfo;
  var
    TranslationIndex: Integer;
  begin
    GetHeader; // Var
    if SameText(Key, 'Translation') then
    begin
      SetLength(FTranslations, ValueLen div SizeOf(TLangIdRec));
      for TranslationIndex := 0 to Length(FTranslations) - 1 do
      begin
        FTranslations[TranslationIndex] := PLangIdRec(Data)^;
        Inc(Data, SizeOf(TLangIdRec));
      end;
    end;
  end;

begin
  FItemList := TStringList.Create;
  FItems := TStringList.Create;
  Data := Pointer(FBuffer);
  Assert(TJclAddr(Data) mod 4 = 0);
  IsUnicode := (PWord(Data + 4)^ in [0, 1]);
  Error := True;
  GetHeader;
  EndOfData := Data + Len - HeaderSize;
  if SameText(Key, 'VS_VERSION_INFO') and (ValueLen = SizeOf(TVSFixedFileInfo)) then
  begin
    FFixedInfo := PVSFixedFileInfo(Data);
    Error := FFixedInfo.dwSignature <> $FEEF04BD;
    Inc(Data, ValueLen); // VS_FIXEDFILEINFO
    Padding(Data);       // VS_VERSIONINFO.Padding2
    while not Error and (Data < EndOfData) do
    begin
      GetHeader;
      Inc(Data, ValueLen); // some files (VREDIR.VXD 4.00.1111) has non zero value of ValueLen
      Dec(Len, HeaderSize + ValueLen);
      if SameText(Key, 'StringFileInfo') then
        ProcessStringInfo(Len)
      else
      if SameText(Key, 'VarFileInfo') then
        ProcessVarInfo
      else
        Break;
    end;
    ExtractFlags;
    CreateItemsForLanguage;
  end;
  if Error then
    raise EJclFileVersionInfoError.CreateRes(@RsFileUtilsNoVersionInfo);
end;

procedure TJclFileVersionInfo.ExtractFlags;
var
  Masked: DWORD;
begin
  FFileFlags := [];
  Masked := FFixedInfo^.dwFileFlags and FFixedInfo^.dwFileFlagsMask;
  if (Masked and VS_FF_DEBUG) <> 0 then
    Include(FFileFlags, ffDebug);
  if (Masked and VS_FF_INFOINFERRED) <> 0 then
    Include(FFileFlags, ffInfoInferred);
  if (Masked and VS_FF_PATCHED) <> 0 then
    Include(FFileFlags, ffPatched);
  if (Masked and VS_FF_PRERELEASE) <> 0 then
    Include(FFileFlags, ffPreRelease);
  if (Masked and VS_FF_PRIVATEBUILD) <> 0 then
    Include(FFileFlags, ffPrivateBuild);
  if (Masked and VS_FF_SPECIALBUILD) <> 0 then
    Include(FFileFlags, ffSpecialBuild);
end;

function TJclFileVersionInfo.GetBinFileVersion: string;
begin
  Result := Format('%u.%u.%u.%u', [HiWord(FFixedInfo^.dwFileVersionMS),
    LoWord(FFixedInfo^.dwFileVersionMS), HiWord(FFixedInfo^.dwFileVersionLS),
    LoWord(FFixedInfo^.dwFileVersionLS)]);
end;

function TJclFileVersionInfo.GetBinProductVersion: string;
begin
  Result := Format('%u.%u.%u.%u', [HiWord(FFixedInfo^.dwProductVersionMS),
    LoWord(FFixedInfo^.dwProductVersionMS), HiWord(FFixedInfo^.dwProductVersionLS),
    LoWord(FFixedInfo^.dwProductVersionLS)]);
end;

function TJclFileVersionInfo.GetCustomFieldValue(const FieldName: string): string;
var
  ItemIndex: Integer;
begin
  if FieldName <> '' then
  begin
    ItemIndex := FItems.IndexOfName(FieldName);
    if ItemIndex <> -1 then
      //Return the required value, the value the user passed in was found.
      Result := FItems.Values[FieldName]
    else
      raise EJclFileVersionInfoError.CreateResFmt(@RsFileUtilsValueNotFound, [FieldName]);
  end
  else
    raise EJclFileVersionInfoError.CreateRes(@RsFileUtilsEmptyValue);
end;

function TJclFileVersionInfo.GetFileOS: DWORD;
begin
  Result := FFixedInfo^.dwFileOS;
end;

function TJclFileVersionInfo.GetFileSubType: DWORD;
begin
  Result := FFixedInfo^.dwFileSubtype;
end;

function TJclFileVersionInfo.GetFileType: DWORD;
begin
  Result := FFixedInfo^.dwFileType;
end;

function TJclFileVersionInfo.GetFileVersionBuild: string;
var
  Left: Integer;
begin
  Result := FileVersion;
  StrReplaceChar(Result, ',', '.');
  Left := CharLastPos(Result, '.') + 1;
  Result := StrMid(Result, Left, Length(Result) - Left + 1);
  Result := Trim(Result);
end;

function TJclFileVersionInfo.GetFileVersionMajor: string;
begin
  Result := FileVersion;
  StrReplaceChar(Result, ',', '.');
  Result := StrBefore('.', Result);
  Result := Trim(Result);
end;

function TJclFileVersionInfo.GetFileVersionMinor: string;
var
  Left, Right: integer;
begin
  Result := FileVersion;
  StrReplaceChar(Result, ',', '.');
  Left := CharPos(Result, '.') + 1;           // skip major
  Right := CharPos(Result, '.', Left) {-1};
  Result := StrMid(Result, Left, Right - Left {+1});
  Result := Trim(Result);
end;

function TJclFileVersionInfo.GetFileVersionRelease: string;
var
  Left, Right: Integer;
begin
  Result := FileVersion;
  StrReplaceChar(Result, ',', '.');
  Left := CharPos(Result, '.') + 1;           // skip major
  Left := CharPos(Result, '.', Left) + 1;     // skip minor
  Right := CharPos(Result, '.', Left) {-1};
  Result := StrMid(Result, Left, Right - Left {+1});
  Result := Trim(Result);
end;

function TJclFileVersionInfo.GetFixedInfo: TVSFixedFileInfo;
begin
  Result := FFixedInfo^;
end;

function TJclFileVersionInfo.GetItems: TStrings;
begin
  Result := FItems;
end;

function TJclFileVersionInfo.GetLanguageCount: Integer;
begin
  Result := Length(FLanguages);
end;

function TJclFileVersionInfo.GetLanguageIds(Index: Integer): string;
begin
  CheckLanguageIndex(Index);
  Result := VersionLanguageId(FLanguages[Index]);
end;

function TJclFileVersionInfo.GetLanguages(Index: Integer): TLangIdRec;
begin
  CheckLanguageIndex(Index);
  Result := FLanguages[Index];
end;

function TJclFileVersionInfo.GetLanguageNames(Index: Integer): string;
begin
  CheckLanguageIndex(Index);
  Result := VersionLanguageName(FLanguages[Index].LangId);
end;

function TJclFileVersionInfo.GetTranslationCount: Integer;
begin
  Result := Length(FTranslations);
end;

function TJclFileVersionInfo.GetTranslations(Index: Integer): TLangIdRec;
begin
  Result := FTranslations[Index];
end;

function TJclFileVersionInfo.GetProductVersionBuild: string;
var
  Left: Integer;
begin
  Result := ProductVersion;
  StrReplaceChar(Result, ',', '.');
  Left := CharLastPos(Result, '.') + 1;
  Result := StrMid(Result, Left, Length(Result) - Left + 1);
  Result := Trim(Result);
end;

function TJclFileVersionInfo.GetProductVersionMajor: string;
begin
  Result := ProductVersion;
  StrReplaceChar(Result, ',', '.');
  Result := StrBefore('.', Result);
  Result := Trim(Result);
end;

function TJclFileVersionInfo.GetProductVersionMinor: string;
var
  Left, Right: integer;
begin
  Result := ProductVersion;
  StrReplaceChar(Result, ',', '.');
  Left := CharPos(Result, '.') + 1;           // skip major
  Right := CharPos(Result, '.', Left) {-1};
  Result := StrMid(Result, Left, Right - Left {+1});
  Result := Trim(Result);
end;

function TJclFileVersionInfo.GetProductVersionRelease: string;
var
  Left, Right: Integer;
begin
  Result := ProductVersion;
  StrReplaceChar(Result, ',', '.');
  Left := CharPos(Result, '.') + 1;           // skip major
  Left := CharPos(Result, '.', Left) + 1;     // skip minor
  Right := CharPos(Result, '.', Left) {-1};
  Result := StrMid(Result, Left, Right - Left {+1});
  Result := Trim(Result);
end;

function TJclFileVersionInfo.GetVersionKeyValue(Index: Integer): string;
begin
  Result := Items.Values[VerKeyNames[Index]];
end;

procedure TJclFileVersionInfo.SetLanguageIndex(const Value: Integer);
begin
  CheckLanguageIndex(Value);
  if FLanguageIndex <> Value then
  begin
    FLanguageIndex := Value;
    CreateItemsForLanguage;
  end;
end;

function TJclFileVersionInfo.TranslationMatchesLanguages(Exact: Boolean): Boolean;
var
  TransIndex, LangIndex: Integer;
  TranslationPair: DWORD;
begin
  Result := (LanguageCount = TranslationCount) or (not Exact and (TranslationCount > 0));
  if Result then
    for TransIndex := 0 to TranslationCount - 1 do
    begin
      TranslationPair := FTranslations[TransIndex].Pair;
      LangIndex := LanguageCount - 1;
      while (LangIndex >= 0) and (TranslationPair <> FLanguages[LangIndex].Pair) do
        Dec(LangIndex);
      if LangIndex < 0 then
      begin
        Result := False;
        Break;
      end;
    end;
end;

class function TJclFileVersionInfo.VersionLanguageId(const LangIdRec: TLangIdRec): string;
begin
  with LangIdRec do
    Result := Format('%.4x%.4x', [LangId, CodePage]);
end;

class function TJclFileVersionInfo.VersionLanguageName(const LangId: Word): string;
var
  R: DWORD;
begin
  SetLength(Result, MAX_PATH);
  R := VerLanguageName(LangId, PChar(Result), MAX_PATH);
  SetLength(Result, R);
end;

{$ENDIF MSWINDOWS}

//=== { TJclFileMaskComparator } =============================================

constructor TJclFileMaskComparator.Create;
begin
  inherited Create;
  FSeparator := DirSeparator;
end;

function TJclFileMaskComparator.Compare(const NameExt: string): Boolean;
var
  I: Integer;
  NamePart, ExtPart: string;
  NameWild, ExtWild: Boolean;
begin
  Result := False;
  I := StrLastPos('.', NameExt);
  if I = 0 then
  begin
    NamePart := NameExt;
    ExtPart := '';
  end
  else
  begin
    NamePart := Copy(NameExt, 1, I - 1);
    ExtPart := Copy(NameExt, I + 1, Length(NameExt));
  end;
  for I := 0 to Length(FNames) - 1 do
  begin
    NameWild := FWildChars[I] and 1 = 1;
    ExtWild := FWildChars[I] and 2 = 2;
    if ((not NameWild and StrSame(FNames[I], NamePart)) or
      (NameWild and (StrMatches(FNames[I], NamePart, 1)))) and
      ((not ExtWild and StrSame(FExts[I], ExtPart)) or
      (ExtWild and (StrMatches(FExts[I], ExtPart, 1)))) then
    begin
      Result := True;
      Break;
    end;
  end;
end;

procedure TJclFileMaskComparator.CreateMultiMasks;
var
  List: TStringList;
  I, N: Integer;
  NS, ES: string;
begin
  FExts := nil;
  FNames := nil;
  FWildChars := nil;
  List := TStringList.Create;
  try
    StrToStrings(FFileMask, FSeparator, List);
    SetLength(FExts, List.Count);
    SetLength(FNames, List.Count);
    SetLength(FWildChars, List.Count);
    for I := 0 to List.Count - 1 do
    begin
      N := StrLastPos('.', List[I]);
      if N = 0 then
      begin
        NS := List[I];
        ES := '';
      end
      else
      begin
        NS := Copy(List[I], 1, N - 1);
        ES := Copy(List[I], N + 1, 255);
      end;
      FNames[I] := NS;
      FExts[I] := ES;
      N := 0;
      if StrContainsChars(NS, CharIsWildcard, False) then
        N := N or 1;
      if StrContainsChars(ES, CharIsWildcard, False) then
        N := N or 2;
      FWildChars[I] := N;
    end;
  finally
    List.Free;
  end;
end;

function TJclFileMaskComparator.GetCount: Integer;
begin
  Result := Length(FWildChars);
end;

function TJclFileMaskComparator.GetExts(Index: Integer): string;
begin
  Result := FExts[Index];
end;

function TJclFileMaskComparator.GetMasks(Index: Integer): string;
begin
  Result := FNames[Index] + '.' + FExts[Index];
end;

function TJclFileMaskComparator.GetNames(Index: Integer): string;
begin
  Result := FNames[Index];
end;

procedure TJclFileMaskComparator.SetFileMask(const Value: string);
begin
  FFileMask := Value;
  CreateMultiMasks;
end;

procedure TJclFileMaskComparator.SetSeparator(const Value: Char);
begin
  if FSeparator <> Value then
  begin
    FSeparator := Value;
    CreateMultiMasks;
  end;
end;

function AdvBuildFileList(const Path: string; const Attr: Integer; const Files: TStrings;
  const AttributeMatch: TJclAttributeMatch; const Options: TFileListOptions;
  const SubfoldersMask: string; const FileMatchFunc: TFileMatchFunc): Boolean;
var
  FileMask: string;
  RootDir: string;
  Folders: TStringList;
  CurrentItem: Integer;
  Counter: Integer;
  FindAttr: Integer;

  procedure BuildFolderList;
  var
    FindInfo: TSearchRec;
    Rslt: Integer;
  begin
    Counter := Folders.Count - 1;
    CurrentItem := 0;

    while CurrentItem <= Counter do
    begin
      // searching for subfolders (including hidden ones)
      Rslt := FindFirst(Folders[CurrentItem] + '*.*', faAnyFile, FindInfo);
      try
        while Rslt = 0 do
        begin
          if (FindInfo.Name <> '.') and (FindInfo.Name <> '..') and
            (FindInfo.Attr and faDirectory = faDirectory) then
            Folders.Add(Folders[CurrentItem] + FindInfo.Name + DirDelimiter);

          Rslt := FindNext(FindInfo);
        end;
      finally
        FindClose(FindInfo);
      end;
      Counter := Folders.Count - 1;
      Inc(CurrentItem);
    end;
  end;

  procedure FillFileList(CurrentCounter: Integer);
  var
    FindInfo: TSearchRec;
    Rslt: Integer;
    CurrentFolder: string;
    Matches: Boolean;
  begin
    CurrentFolder := Folders[CurrentCounter];

    Rslt := FindFirst(CurrentFolder + FileMask, FindAttr, FindInfo);

    try
      while Rslt = 0 do
      begin
         Matches := False;

         case AttributeMatch of
           amAny:
             Matches := True;
           amExact:
             Matches := Attr = FindInfo.Attr;
           amSubSetOf:
             Matches := (Attr and FindInfo.Attr) = Attr;
           amSuperSetOf:
             Matches := (Attr and FindInfo.Attr) = FindInfo.Attr;
           amCustom:
             if Assigned(FileMatchFunc) then
               Matches := FileMatchFunc(Attr,  FindInfo);
         end;

         if Matches then
           if flFullNames in Options then
             Files.Add(CurrentFolder + FindInfo.Name)
           else
             Files.Add(FindInfo.Name);

        Rslt := FindNext(FindInfo);
      end;
    finally
      FindClose(FindInfo);
    end;
  end;

begin
  Assert(Assigned(Files));
  FileMask := ExtractFileName(Path);
  RootDir := ExtractFilePath(Path);

  Folders := TStringList.Create;
  Files.BeginUpdate;
  try
    Folders.Add(RootDir);

    case AttributeMatch of
      amExact, amSuperSetOf:
        FindAttr := Attr;
    else
      FindAttr := faAnyFile;
    end;

    // here's the recursive search for nested folders

    if flRecursive in Options then
      BuildFolderList;

    for Counter := 0 to Folders.Count - 1 do
    begin
      if (((flMaskedSubfolders in Options) and (StrMatches(SubfoldersMask,
        Folders[Counter], 1))) or (not (flMaskedSubfolders in Options))) then
          FillFileList(Counter);
    end;
  finally
    Folders.Free;
    Files.EndUpdate;
  end;
  Result := True;
end;

function VerifyFileAttributeMask(var RejectedAttributes, RequiredAttributes: Integer): Boolean;
begin
  if RequiredAttributes and faNormalFile <> 0 then
    RejectedAttributes := not faNormalFile or RejectedAttributes;
  Result := RequiredAttributes and RejectedAttributes = 0;
end;

function AttributeMatch(FileAttributes, RejectedAttr, RequiredAttr: Integer): Boolean;
begin
  if FileAttributes = 0 then
    FileAttributes := faNormalFile;
  {$IFDEF MSWINDOWS}
  RequiredAttr := RequiredAttr and not faUnixSpecific;
  {$ENDIF MSWINDOWS}
  {$IFDEF UNIX}
  RequiredAttr := RequiredAttr and not faWindowsSpecific;
  {$ENDIF UNIX}
  Result := (FileAttributes and RejectedAttr = 0)
    and (FileAttributes and RequiredAttr = RequiredAttr);
end;

function IsFileAttributeMatch(FileAttributes, RejectedAttributes,
  RequiredAttributes: Integer): Boolean;
begin
  VerifyFileAttributeMask(RejectedAttributes, RequiredAttributes);
  Result := AttributeMatch(FileAttributes, RejectedAttributes, RequiredAttributes);
end;

function FileAttributesStr(const FileInfo: TSearchRec): string;
{$IFDEF MSWINDOWS}
const
  SAllAttrSet = 'rahs'; // readonly, archive, hidden, system
  Attributes: array [1..4] of Integer =
    (faReadOnly, faArchive, faHidden, faSysFile);
var
  I: Integer;
begin
  Result := SAllAttrSet;
  for I := Low(Attributes) to High(Attributes) do
    if (FileInfo.Attr and Attributes[I]) = 0 then
      Result[I] := '-';
end;
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
const
  SAllAttrSet = 'drwxrwxrwx';
var
  I: Integer;
  Flag: Cardinal;
begin
  Result := SAllAttrSet;
  if FileInfo.Attr and faDirectory = 0 then
    Result[1] := '-'; // no directory
  Flag := 1 shl 8;
  for I := 2 to 10 do
  begin
    if FileInfo.Mode and Flag = 0 then
      Result[I] := '-';
    Flag := Flag shr 1;
  end;
end;
{$ENDIF UNIX}

function IsFileNameMatch(FileName: string; const Mask: string;
  const CaseSensitive: Boolean): Boolean;
begin
  Result := True;
  {$IFDEF MSWINDOWS}
  if (Mask = '') or (Mask = '*') or (Mask = '*.*') then
    Exit;
  if Pos('.', FileName) = 0 then
    FileName := FileName + '.';  // file names w/o extension match '*.'
  {$ENDIF MSWINDOWS}
  {$IFDEF UNIX}
  if (Mask = '') or (Mask = '*') then
    Exit;
  {$ENDIF UNIX}
  if CaseSensitive then
    Result := StrMatches(Mask, FileName)
  else
    Result := StrMatches(AnsiUpperCase(Mask), AnsiUpperCase(FileName));
end;

// author: Robert Rossmair

function CanonicalizedSearchPath(const Directory: string): string;
begin
  Result := PathCanonicalize(Directory);
  {$IFDEF MSWINDOWS}
  // avoid changing "X:" (current directory on drive X:) into "X:\" (root dir.)
  if Result[Length(Result)] <> ':' then
  {$ENDIF MSWINDOWS}
    Result := PathAddSeparator(Result);
  // strip leading "./" resp. ".\"
  if Pos('.' + DirDelimiter, Result) = 1 then
    Result := Copy(Result, 3, Length(Result) - 2);
end;

procedure EnumFiles(const Path: string; HandleFile: TFileHandlerEx;
  RejectedAttributes: Integer; RequiredAttributes: Integer; Abort: PBoolean);
var
  Directory: string;
  FileInfo: TSearchRec;
  Attr: Integer;
  Found: Boolean;
begin
  Assert(Assigned(HandleFile));
  Assert(VerifyFileAttributeMask(RejectedAttributes, RequiredAttributes),
    LoadResString(@RsFileSearchAttrInconsistency));

  Directory := ExtractFilePath(Path);

  Attr := faAnyFile and not RejectedAttributes;

  Found := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindFirst(Path, Attr, FileInfo) = 0;
  try
    while Found do
    begin
      if (Abort <> nil) and LongBool(Abort^) then
        Exit;
      if AttributeMatch(FileInfo.Attr, RejectedAttributes, RequiredAttributes) then
        if ((FileInfo.Attr and faDirectory = 0)
        or ((FileInfo.Name <> '.') and (FileInfo.Name <> '..'))) then
          HandleFile(Directory, FileInfo);
      Found := FindNext(FileInfo) = 0;
    end;
  finally
    FindClose(FileInfo);
  end;
end;

procedure EnumFiles(const Path: string; HandleFile: TFileInfoHandlerEx;
  RejectedAttributes: Integer; RequiredAttributes: Integer; Abort: PBoolean);
var
  FileInfo: TSearchRec;
  Attr: Integer;
  Found: Boolean;
begin
  Assert(Assigned(HandleFile));
  Assert(VerifyFileAttributeMask(RejectedAttributes, RequiredAttributes),
    LoadResString(@RsFileSearchAttrInconsistency));

  Attr := faAnyFile and not RejectedAttributes;

  Found := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindFirst(Path, Attr, FileInfo) = 0;
  try
    while Found do
    begin
      if (Abort <> nil) and LongBool(Abort^) then
        Exit;
      if AttributeMatch(FileInfo.Attr, RejectedAttributes, RequiredAttributes) then
        if ((FileInfo.Attr and faDirectory = 0)
        or ((FileInfo.Name <> '.') and (FileInfo.Name <> '..'))) then
          HandleFile(FileInfo);
      Found := FindNext(FileInfo) = 0;
    end;
  finally
    FindClose(FileInfo);
  end;
end;

procedure EnumDirectories(const Root: string; const HandleDirectory: TFileHandler;
  const IncludeHiddenDirectories: Boolean; const SubDirectoriesMask: string;
  Abort: PBoolean {$IFDEF UNIX}; ResolveSymLinks: Boolean {$ENDIF});
var
  RootDir: string;
  Attr: Integer;

  procedure Process(const Directory: string);
  var
    DirInfo: TSearchRec;
    SubDir: string;
    Found: Boolean;
  begin
    HandleDirectory(Directory);

    Found := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindFirst(Directory + '*', Attr, DirInfo) = 0;
    try
      while Found do
      begin
        if (Abort <> nil) and LongBool(Abort^) then
          Exit;
        if (DirInfo.Name <> '.') and (DirInfo.Name <> '..') and
          {$IFDEF UNIX}
          (IncludeHiddenDirectories or (Pos('.', DirInfo.Name) <> 1)) and
          ((DirInfo.Attr and faSymLink = 0) or ResolveSymLinks) and
          {$ENDIF UNIX}
          (DirInfo.Attr and faDirectory <> 0) then
        begin
          SubDir := Directory + DirInfo.Name + DirDelimiter;
          if (SubDirectoriesMask = '') or StrMatches(SubDirectoriesMask, SubDir, Length(RootDir)) then
            Process(SubDir);
        end;
        Found := FindNext(DirInfo) = 0;
      end;
    finally
      FindClose(DirInfo);
    end;
  end;

begin
  Assert(Assigned(HandleDirectory));
  RootDir := CanonicalizedSearchPath(Root);

  if IncludeHiddenDirectories then
    Attr := faDirectory + faHidden  // no effect on Linux
  else
    Attr := faDirectory;

  Process(RootDir);
end;

//=== { TJclCustomFileAttributeMask } ==============================================

constructor TJclCustomFileAttrMask.Create;
begin
  inherited Create;
  FRejectedAttr := faRejectedByDefault;
end;

procedure TJclCustomFileAttrMask.Assign(Source: TPersistent);
begin
  if Source is TJclCustomFileAttrMask then
  begin
    Required := TJclCustomFileAttrMask(Source).Required;
    Rejected := TJclCustomFileAttrMask(Source).Rejected;
  end
  else
    inherited Assign(Source);
end;

procedure TJclCustomFileAttrMask.Clear;
begin
  Rejected := 0;
  Required := 0;
end;

procedure TJclCustomFileAttrMask.DefineProperties(Filer: TFiler);
var
  Ancestor: TJclCustomFileAttrMask;
  Attr: Integer;
begin
  Attr := 0;
  Ancestor := TJclCustomFileAttrMask(Filer.Ancestor);
  if Assigned(Ancestor) then
    Attr := Ancestor.FRequiredAttr;
  Filer.DefineProperty('Required', ReadRequiredAttributes, WriteRequiredAttributes,
    Attr <> FRequiredAttr);
  if Assigned(Ancestor) then
    Attr := Ancestor.FRejectedAttr;
  Filer.DefineProperty('Rejected', ReadRejectedAttributes, WriteRejectedAttributes,
    Attr <> FRejectedAttr);
end;

function TJclCustomFileAttrMask.Match(FileAttributes: Integer): Boolean;
begin
  Result := AttributeMatch(FileAttributes, Rejected, Required);
end;

function TJclCustomFileAttrMask.Match(const FileInfo: TSearchRec): Boolean;
begin
  Result := Match(FileInfo.Attr);
end;

function TJclCustomFileAttrMask.GetAttr(Index: Integer): TAttributeInterest;
begin
  if ((FRequiredAttr and Index) <> 0) or (Index = faNormalFile) and
    (FRejectedAttr = not faNormalFile) then
    Result := aiRequired
  else
  if (FRejectedAttr and Index) <> 0 then
    Result := aiRejected
  else
    Result := aiIgnored;
end;

procedure TJclCustomFileAttrMask.ReadRejectedAttributes(Reader: TReader);
begin
  FRejectedAttr := Reader.ReadInteger;
end;

procedure TJclCustomFileAttrMask.ReadRequiredAttributes(Reader: TReader);
begin
  FRequiredAttr := Reader.ReadInteger;
end;

procedure TJclCustomFileAttrMask.SetAttr(Index: Integer; const Value: TAttributeInterest);
begin
  case Value of
    aiIgnored:
      begin
        FRequiredAttr := FRequiredAttr and not Index;
        FRejectedAttr := FRejectedAttr and not Index;
      end;
    aiRejected:
      begin
        FRequiredAttr := FRequiredAttr and not Index;
        FRejectedAttr := FRejectedAttr or Index;
      end;
    aiRequired:
      begin
        if Index = faNormalFile then
        begin
          FRequiredAttr := faNormalFile;
          FRejectedAttr := not faNormalFile;
        end
        else
        begin
          FRequiredAttr := FRequiredAttr or Index;
          FRejectedAttr := FRejectedAttr and not Index;
        end;
      end;
  end;
end;

procedure TJclCustomFileAttrMask.WriteRejectedAttributes(Writer: TWriter);
begin
  Writer.WriteInteger(FRejectedAttr);
end;

procedure TJclCustomFileAttrMask.WriteRequiredAttributes(Writer: TWriter);
begin
  Writer.WriteInteger(FRequiredAttr);
end;

//=== { TJclFileAttributeMask } ==============================================

procedure TJclFileAttributeMask.ReadVolumeID(Reader: TReader);
begin
  // Nothing, we are not interested in the value of the VolumeID property,
  // this procedure and the associated DefineProperty call are here only
  // to allow reading legacy DFMs that have this property defined.
end;

procedure TJclFileAttributeMask.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);

  Filer.DefineProperty('VolumeID', ReadVolumeID, nil, False);
end;

//=== { TJclFileSearchOptions } ==============================================

constructor TJclFileSearchOptions.Create;
begin
  inherited Create;

  FAttributeMask := TJclFileAttributeMask.Create;
  FRootDirectories := TStringList.Create;
  FRootDirectories.Add('.');
  FFileMasks := TStringList.Create;
  FFileMasks.Add('*');
  FSubDirectoryMask := '*';
  FOptions := [fsIncludeSubDirectories];
  FLastChangeAfter := MinDateTime;
  FLastChangeBefore := MaxDateTime;
  {$IFDEF UNIX}
  FCaseSensitiveSearch := True;
  {$ENDIF UNIX}
end;

destructor TJclFileSearchOptions.Destroy;
begin
  FAttributeMask.Free;
  FFileMasks.Free;
  FRootDirectories.Free;

  inherited Destroy;
end;

procedure TJclFileSearchOptions.Assign(Source: TPersistent);
var
  Src: TJclFileSearchOptions;
begin
  if Source is TJclFileSearchOptions then
  begin
    Src := TJclFileSearchOptions(Source);
    FCaseSensitiveSearch := Src.FCaseSensitiveSearch;
    FileMasks.Assign(Src.FileMasks);
    RootDirectory := Src.RootDirectory;
    SubDirectoryMask := Src.SubDirectoryMask;
    AttributeMask := Src.AttributeMask;
    Options := Src.Options;
    FileSizeMin := Src.FileSizeMin;
    FileSizeMax := Src.FileSizeMax;
    LastChangeAfter := Src.LastChangeAfter;
    LastChangeBefore := Src.LastChangeBefore;
  end
  else
    inherited Assign(Source);
end;

function TJclFileSearchOptions.GetAttributeMask: TJclFileAttributeMask;
begin
  Result := FAttributeMask;
end;

function TJclFileSearchOptions.GetCaseSensitiveSearch: Boolean;
begin
  Result := FCaseSensitiveSearch;
end;

function TJclFileSearchOptions.GetFileMask: string;
begin
  Result := StringsToStr(FileMasks, DirSeparator, False);
end;

function TJclFileSearchOptions.GetFileMasks: TStrings;
begin
  Result := FFileMasks;
end;

function TJclFileSearchOptions.GetFileSizeMax: Int64;
begin
  Result := FFileSizeMax;
end;

function TJclFileSearchOptions.GetFileSizeMin: Int64;
begin
  Result := FFileSizeMin;
end;

function TJclFileSearchOptions.GetIncludeHiddenSubDirectories: Boolean;
begin
  Result := fsIncludeHiddenSubDirectories in Options;
end;

function TJclFileSearchOptions.GetIncludeSubDirectories: Boolean;
begin
  Result := fsIncludeSubDirectories in Options;
end;

function TJclFileSearchOptions.GetLastChangeAfter: TDateTime;
begin
  Result := FLastChangeAfter;
end;

function TJclFileSearchOptions.GetLastChangeAfterStr: string;
begin
  Result := DateTimeToStr(LastChangeAfter);
end;

function TJclFileSearchOptions.GetLastChangeBefore: TDateTime;
begin
  Result := FLastChangeBefore;
end;

function TJclFileSearchOptions.GetLastChangeBeforeStr: string;
begin
  Result := DateTimeToStr(LastChangeBefore);
end;

function TJclFileSearchOptions.GetOption(
  const Option: TFileSearchOption): Boolean;
begin
  Result := Option in FOptions;
end;

function TJclFileSearchOptions.GetOptions: TFileSearchoptions;
begin
  Result := FOptions;
end;

function TJclFileSearchOptions.GetRootDirectories: TStrings;
begin
  Result := FRootDirectories;
end;

function TJclFileSearchOptions.GetRootDirectory: string;
begin
  if FRootDirectories.Count = 1 then
    Result := FRootDirectories.Strings[0]
  else
    Result := '';
end;

function TJclFileSearchOptions.GetSubDirectoryMask: string;
begin
  Result := FSubDirectoryMask;
end;

function TJclFileSearchOptions.IsLastChangeAfterStored: Boolean;
begin
  Result := FLastChangeAfter <> MinDateTime;
end;

function TJclFileSearchOptions.IsLastChangeBeforeStored: Boolean;
begin
  Result := FLastChangeBefore <> MaxDateTime;
end;

procedure TJclFileSearchOptions.SetAttributeMask(
  const Value: TJclFileAttributeMask);
begin
  FAttributeMask.Assign(Value);
end;

procedure TJclFileSearchOptions.SetCaseSensitiveSearch(const Value: Boolean);
begin
  FCaseSensitiveSearch := Value;
end;

procedure TJclFileSearchOptions.SetFileMask(const Value: string);
begin
  { TODO : UNIX : ? }
  StrToStrings(Value, DirSeparator, FFileMasks, False);
end;

procedure TJclFileSearchOptions.SetFileMasks(const Value: TStrings);
begin
  FileMasks.Assign(Value);
end;

procedure TJclFileSearchOptions.SetFileSizeMax(const Value: Int64);
begin
  FFileSizeMax := Value;
end;

procedure TJclFileSearchOptions.SetFileSizeMin(const Value: Int64);
begin
  FFileSizeMin := Value;
end;

procedure TJclFileSearchOptions.SetIncludeHiddenSubDirectories(
  const Value: Boolean);
begin
  SetOption(fsIncludeHiddenSubDirectories, Value);
end;

procedure TJclFileSearchOptions.SetIncludeSubDirectories(const Value: Boolean);
begin
  SetOption(fsIncludeSubDirectories, Value);
end;

procedure TJclFileSearchOptions.SetLastChangeAfter(const Value: TDateTime);
begin
  FLastChangeAfter := Value;
end;

procedure TJclFileSearchOptions.SetLastChangeAfterStr(const Value: string);
begin
  if Value = '' then
    LastChangeAfter := MinDateTime
  else
    LastChangeAfter := StrToDateTime(Value);
end;

procedure TJclFileSearchOptions.SetLastChangeBefore(const Value: TDateTime);
begin
  FLastChangeBefore := Value;
end;

procedure TJclFileSearchOptions.SetLastChangeBeforeStr(const Value: string);
begin
  if Value = '' then
    LastChangeBefore := MaxDateTime
  else
    LastChangeBefore := StrToDateTime(Value);
end;

procedure TJclFileSearchOptions.SetOption(const Option: TFileSearchOption;
  const Value: Boolean);
begin
  if Value then
    Include(FOptions, Option)
  else
    Exclude(FOptions, Option);
end;

procedure TJclFileSearchOptions.SetOptions(const Value: TFileSearchOptions);
begin
  FOptions := Value;
end;

procedure TJclFileSearchOptions.SetRootDirectories(const Value: TStrings);
begin
  FRootDirectories.Assign(Value);
end;

procedure TJclFileSearchOptions.SetRootDirectory(const Value: string);
begin
  FRootDirectories.Clear;
  FRootDirectories.Add(Value);
end;

procedure TJclFileSearchOptions.SetSubDirectoryMask(const Value: string);
begin
  FSubDirectoryMask := Value;
end;

//=== { TEnumFileThread } ====================================================

type
  TEnumFileThread = class(TThread)
  private
    FID: TFileSearchTaskID;
    FFileMasks: TStringList;
    FDirectories: TStrings;
    FCurrentDirectory: string;
    FSubDirectoryMask: string;
    FOnEnterDirectory: TFileHandler;
    FFileHandlerEx: TFileHandlerEx;
    FFileHandler: TFileHandler;
    FInternalDirHandler: TFileHandler;
    FInternalFileInfoHandler: TFileInfoHandlerEx;
    FFileInfo: TSearchRec;
    FRejectedAttr: Integer;
    FRequiredAttr: Integer;
    FFileSizeMin: Int64;
    FFileSizeMax: Int64;
    {$IFDEF RTL220_UP}
    FFileTimeMin: TDateTime;
    FFileTimeMax: TDateTime;
    {$ELSE ~RTL220_UP}
    FFileTimeMin: Integer;
    FFileTimeMax: Integer;
    {$ENDIF ~RTL220_UP}
    FSynchronizationMode: TFileEnumeratorSyncMode;
    FIncludeSubDirectories: Boolean;
    FIncludeHiddenSubDirectories: Boolean;
    FNotifyOnTermination: Boolean;
    FCaseSensitiveSearch: Boolean;
    FAllNamesMatch: Boolean;
    procedure EnterDirectory;
    procedure AsyncProcessDirectory(const Directory: string);
    procedure SyncProcessDirectory(const Directory: string);
    procedure AsyncProcessFile(const FileInfo: TSearchRec);
    procedure SyncProcessFile(const FileInfo: TSearchRec);
    function GetDirectories: TStrings;
    function GetFileMasks: TStrings;
    procedure SetDirectories(const Value: TStrings);
    procedure SetFileMasks(const Value: TStrings);
  protected
    procedure DoTerminate; override;
    procedure Execute; override;
    function FileMatch: Boolean;
    function FileNameMatchesMask: Boolean;
    procedure ProcessDirectory;
    procedure ProcessDirFiles;
    procedure ProcessFile;
    property AllNamesMatch: Boolean read FAllNamesMatch;
    property CaseSensitiveSearch: Boolean read FCaseSensitiveSearch write FCaseSensitiveSearch;
    property FileMasks: TStrings read GetFileMasks write SetFileMasks;
    property FileSizeMin: Int64 read FFileSizeMin write FFileSizeMin;
    property FileSizeMax: Int64 read FFileSizeMax write FFileSizeMax;
    {$IFDEF RTL220_UP}
    property FileTimeMin: TDateTime read FFileTimeMin write FFileTimeMin;
    property FileTimeMax: TDateTime read FFileTimeMax write FFileTimeMax;
    {$ELSE ~RTL220_UP}
    property FileTimeMin: Integer read FFileTimeMin write FFileTimeMin;
    property FileTimeMax: Integer read FFileTimeMax write FFileTimeMax;
    {$ENDIF ~RTL220_UP}
    property Directories: TStrings read GetDirectories write SetDirectories;
    property IncludeSubDirectories: Boolean
      read FIncludeSubDirectories write FIncludeSubDirectories;
    property IncludeHiddenSubDirectories: Boolean
      read FIncludeHiddenSubDirectories write FIncludeHiddenSubDirectories;
    property RejectedAttr: Integer read FRejectedAttr write FRejectedAttr;
    property RequiredAttr: Integer read FRequiredAttr write FRequiredAttr;
    property SynchronizationMode: TFileEnumeratorSyncMode
      read FSynchronizationMode write FSynchronizationMode;
  public
    constructor Create;
    destructor Destroy; override;
    property ID: TFileSearchTaskID read FID;
    {$IFDEF FPC} // protected property
    property Terminated;
    {$ENDIF FPC}
  end;

constructor TEnumFileThread.Create;
begin
  inherited Create(True);
  FDirectories := TStringList.Create;
  FFileMasks := TStringList.Create;
  {$IFDEF RTL220_UP}
  FFileTimeMin := -MaxDouble;
  FFileTimeMax := MaxDouble;
  {$ELSE ~RTL220_UP}
  FFileTimeMin := Low(FFileInfo.Time);
  FFileTimeMax := High(FFileInfo.Time);
  {$ENDIF ~RTL220_UP}
  FFileSizeMax := High(FFileSizeMax);
  {$IFDEF MSWINDOWS}
  Priority := tpIdle;
  {$ENDIF MSWINDOWS}
  {$IFDEF UNIX}
  {$IFDEF FPC}
  Priority := tpIdle;
  {$ELSE ~FPC}
  Priority := 0;
  {$ENDIF ~FPC}
  {$ENDIF UNIX}
  FreeOnTerminate := True;
  FNotifyOnTermination := True;
end;

destructor TEnumFileThread.Destroy;
begin
  FFileMasks.Free;
  FDirectories.Free;
  inherited Destroy;
end;

procedure TEnumFileThread.Execute;
var
  Index: Integer;
begin
  if SynchronizationMode = smPerDirectory then
  begin
    FInternalDirHandler := SyncProcessDirectory;
    FInternalFileInfoHandler := AsyncProcessFile;
  end
  else // SynchronizationMode = smPerFile
  begin
    FInternalDirHandler := AsyncProcessDirectory;
    FInternalFileInfoHandler := SyncProcessFile;
  end;

  if FIncludeSubDirectories then
  begin
    for Index := 0 to FDirectories.Count - 1 do
      EnumDirectories(FDirectories.Strings[Index], FInternalDirHandler, FIncludeHiddenSubDirectories,
        FSubDirectoryMask, @Terminated)
  end
  else
  begin
    for Index := 0 to FDirectories.Count - 1 do
      FInternalDirHandler(CanonicalizedSearchPath(FDirectories.Strings[Index]));
  end;
end;

procedure TEnumFileThread.DoTerminate;
begin
  if FNotifyOnTermination then
    inherited DoTerminate;
end;

procedure TEnumFileThread.EnterDirectory;
begin
  FOnEnterDirectory(FCurrentDirectory);
end;

procedure TEnumFileThread.ProcessDirectory;
begin
  if Assigned(FOnEnterDirectory) then
    EnterDirectory;
  ProcessDirFiles;
end;

procedure TEnumFileThread.AsyncProcessDirectory(const Directory: string);
begin
  FCurrentDirectory := Directory;
  if Assigned(FOnEnterDirectory) then
    Synchronize(EnterDirectory);
  ProcessDirFiles;
end;

procedure TEnumFileThread.SyncProcessDirectory(const Directory: string);
begin
  FCurrentDirectory := Directory;
  Synchronize(ProcessDirectory);
end;

procedure TEnumFileThread.ProcessDirFiles;
begin
  EnumFiles(FCurrentDirectory + '*', FInternalFileInfoHandler, FRejectedAttr, FRequiredAttr, @Terminated);
end;

function TEnumFileThread.FileMatch: Boolean;
var
  FileSize: Int64;
begin
  {$IFDEF RTL220_UP}
  Result := FileNameMatchesMask and (FFileInfo.TimeStamp >= FFileTimeMin) and (FFileInfo.TimeStamp <= FFileTimeMax);
  {$ELSE ~RTL220_UP}
  Result := FileNameMatchesMask and (FFileInfo.Time >= FFileTimeMin) and (FFileInfo.Time <= FFileTimeMax);
  {$ENDIF ~RTL220_UP}
  if Result then
  begin
    FileSize := GetSizeOfFile(FFileInfo);
    Result := (FileSize >= FFileSizeMin) and (FileSize <= FFileSizeMax);
  end;
end;

function TEnumFileThread.FileNameMatchesMask: Boolean;
var
  I: Integer;
begin
  Result := AllNamesMatch;
  if not Result then
    for I := 0 to FileMasks.Count - 1 do
      if IsFileNameMatch(FFileInfo.Name, FileMasks[I], CaseSensitiveSearch) then
      begin
        Result := True;
        Break;
      end;
end;

procedure TEnumFileThread.ProcessFile;
begin
  if Assigned(FFileHandlerEx) then
    FFileHandlerEx(FCurrentDirectory, FFileInfo)
  else
    FFileHandler(FCurrentDirectory + FFileInfo.Name);
end;

procedure TEnumFileThread.AsyncProcessFile(const FileInfo: TSearchRec);
begin
  FFileInfo := FileInfo;
  if FileMatch then
    ProcessFile;
end;

procedure TEnumFileThread.SyncProcessFile(const FileInfo: TSearchRec);
begin
  FFileInfo := FileInfo;
  if FileMatch then
    Synchronize(ProcessFile);
end;

function TEnumFileThread.GetDirectories: TStrings;
begin
  Result := FDirectories;
end;

function TEnumFileThread.GetFileMasks: TStrings;
begin
  Result := FFileMasks;
end;

procedure TEnumFileThread.SetDirectories(const Value: TStrings);
begin
  FDirectories.Assign(Value);
end;

procedure TEnumFileThread.SetFileMasks(const Value: TStrings);
var
  I: Integer;
begin
  FAllNamesMatch := Value.Count = 0;
  for I := 0 to Value.Count - 1 do
    if (Value[I] = '*') {$IFDEF MSWINDOWS} or (Value[I] = '*.*') {$ENDIF} then
    begin
      FAllNamesMatch := True;
      Break;
    end;
  if FAllNamesMatch then
    FileMasks.Clear
  else
    FileMasks.Assign(Value);
end;

//=== { TJclFileEnumerator } =================================================

constructor TJclFileEnumerator.Create;
begin
  inherited Create;
  FTasks := TList.Create;
end;

destructor TJclFileEnumerator.Destroy;
begin
  StopAllTasks(True);
  FTasks.Free;
  inherited Destroy;
end;

procedure TJclFileEnumerator.Assign(Source: TPersistent);
var
  Src: TJclFileEnumerator;
begin
  if Source is TJclFileEnumerator then
  begin
    Src := TJclFileEnumerator(Source);
    SynchronizationMode := Src.SynchronizationMode;
    OnEnterDirectory := Src.OnEnterDirectory;
    OnTerminateTask := Src.OnTerminateTask;
  end;
  inherited Assign(Source);
end;

function TJclFileEnumerator.CreateTask: TThread;
var
  Task: TEnumFileThread;
begin
  Task := TEnumFileThread.Create;
  Task.FID := NextTaskID;
  Task.CaseSensitiveSearch := FCaseSensitiveSearch;
  Task.FileMasks := FileMasks;
  Task.Directories := RootDirectories;
  Task.RejectedAttr := AttributeMask.Rejected;
  Task.RequiredAttr := AttributeMask.Required;
  Task.IncludeSubDirectories := IncludeSubDirectories;
  Task.IncludeHiddenSubDirectories := IncludeHiddenSubDirectories;
  if fsMinSize in Options then
    Task.FileSizeMin := FileSizeMin;
  if fsMaxSize in Options then
    Task.FileSizeMax := FileSizeMax;
  if fsLastChangeAfter in Options then
    Task.FFileTimeMin := {$IFDEF RTL220_UP}LastChangeAfter{$ELSE}DateTimeToFileDate(LastChangeAfter){$ENDIF};
  if fsLastChangeBefore in Options then
    Task.FFileTimeMax := {$IFDEF RTL220_UP}LastChangeBefore{$ELSE}DateTimeToFileDate(LastChangeBefore){$ENDIF};
  Task.SynchronizationMode := SynchronizationMode;
  Task.FOnEnterDirectory := OnEnterDirectory;
  Task.OnTerminate := TaskTerminated;
  FTasks.Add(Task);
  if FRefCount > 0 then
    _AddRef;
  Result := Task;
end;

function TJclFileEnumerator.FillList(List: TStrings): TFileSearchTaskID;
begin
  List.BeginUpdate;
  try
    Result := ForEach(List.Append);
  finally
    List.EndUpdate;
  end;
end;

function TJclFileEnumerator.ForEach(Handler: TFileHandlerEx): TFileSearchTaskID;
var
  Task: TEnumFileThread;
begin
  Task := TEnumFileThread(CreateTask);
  Task.FFileHandlerEx := Handler;
  Result := Task.ID;
  {$IFDEF RTL210_UP}
  Task.Suspended := False;
  {$ELSE ~RTL210_UP}
  Task.Resume;
  {$ENDIF ~RTL210_UP}
end;

function TJclFileEnumerator.ForEach(Handler: TFileHandler): TFileSearchTaskID;
var
  Task: TEnumFileThread;
begin
  Task := TEnumFileThread(CreateTask);
  Task.FFileHandler := Handler;
  Result := Task.ID;
  {$IFDEF RTL210_UP}
  Task.Suspended := False;
  {$ELSE ~RTL210_UP}
  Task.Resume;
  {$ENDIF ~RTL210_UP}
end;

function TJclFileEnumerator.GetRunningTasks: Integer;
begin
  Result := FTasks.Count;
end;

procedure TJclFileEnumerator.StopTask(ID: TFileSearchTaskID);
var
  Task: TEnumFileThread;
  I: Integer;
begin
  for I := 0 to FTasks.Count - 1 do
  begin
    Task := TEnumFileThread(FTasks[I]);
    if Task.ID = ID then
    begin
      Task.Terminate;
      Break;
    end;
  end;
end;

procedure TJclFileEnumerator.StopAllTasks(Silently: Boolean = False);
var
  I: Integer;
begin
  for I := 0 to FTasks.Count - 1 do
  begin
    TEnumFileThread(FTasks[I]).FNotifyOnTermination := not Silently;
    TEnumFileThread(FTasks[I]).Terminate;
  end;
end;

procedure TJclFileEnumerator.TaskTerminated(Sender: TObject);
begin
  FTasks.Remove(Sender);
  try
    if Assigned(FOnTerminateTask) then
      FOnTerminateTask(TEnumFileThread(Sender).ID, TEnumFileThread(Sender).Terminated);
  finally
    if FRefCount > 0 then
      _Release;
  end;
end;

function TJclFileEnumerator.GetNextTaskID: TFileSearchTaskID;
begin
  Result := FNextTaskID;
  Inc(FNextTaskID);
end;

function TJclFileEnumerator.GetOnEnterDirectory: TFileHandler;
begin
  Result := FOnEnterDirectory;
end;

function TJclFileEnumerator.GetOnTerminateTask: TFileSearchTerminationEvent;
begin
  Result := FOnTerminateTask;
end;

function TJclFileEnumerator.GetSynchronizationMode: TFileEnumeratorSyncMode;
begin
  Result := FSynchronizationMode;
end;

procedure TJclFileEnumerator.SetOnEnterDirectory(
  const Value: TFileHandler);
begin
  FOnEnterDirectory := Value;
end;

procedure TJclFileEnumerator.SetOnTerminateTask(
  const Value: TFileSearchTerminationEvent);
begin
  FOnTerminateTask := Value;
end;

procedure TJclFileEnumerator.SetSynchronizationMode(
  const Value: TFileEnumeratorSyncMode);
begin
  FSynchronizationMode := Value;
end;

function FileSearch: IJclFileEnumerator;
begin
  Result := TJclFileEnumerator.Create;
end;

function SamePath(const Path1, Path2: string): Boolean;
begin
  {$IFDEF MSWINDOWS}
  Result := AnsiSameText(PathGetLongName(Path1), PathGetLongName(Path2));
  {$ELSE ~MSWINDOWS}
  Result := Path1 = Path2;
  {$ENDIF ~MSWINDOWS}
end;

// add items at the end
procedure PathListAddItems(var List: string; const Items: string);
begin
  ListAddItems(List, DirSeparator, Items);
end;

// add items at the end if they are not present
procedure PathListIncludeItems(var List: string; const Items: string);
var
  StrList, NewItems: TStringList;
  IndexNew, IndexList: Integer;
  Item: string;
  Duplicate: Boolean;
begin
  StrList := TStringList.Create;
  try
    StrToStrings(List, DirSeparator, StrList);

    NewItems := TStringList.Create;
    try
      StrToStrings(Items, DirSeparator, NewItems);

      for IndexNew := 0 to NewItems.Count - 1 do
      begin
        Item := NewItems.Strings[IndexNew];

        Duplicate := False;
        for IndexList := 0 to StrList.Count - 1 do
          if SamePath(Item, StrList.Strings[IndexList]) then
        begin
          Duplicate := True;
          Break;
        end;

        if not Duplicate then
          StrList.Add(Item);
      end;

      List := StringsToStr(StrList, DirSeparator);
    finally
      NewItems.Free;
    end;
  finally
    StrList.Free;
  end;
end;

// delete multiple items
procedure PathListDelItems(var List: string; const Items: string);
var
  StrList, RemItems: TStringList;
  IndexRem, IndexList: Integer;
  Item: string;
begin
  StrList := TStringList.Create;
  try
    StrToStrings(List, DirSeparator, StrList);

    RemItems := TStringList.Create;
    try
      StrToStrings(Items, DirSeparator, RemItems);

      for IndexRem := 0 to RemItems.Count - 1 do
      begin
        Item := RemItems.Strings[IndexRem];

        for IndexList := StrList.Count - 1 downto 0 do
          if SamePath(Item, StrList.Strings[IndexList]) then
            StrList.Delete(IndexList);
      end;

      List := StringsToStr(StrList, DirSeparator);
    finally
      RemItems.Free;
    end;
  finally
    StrList.Free;
  end;
end;

// delete one item
procedure PathListDelItem(var List: string; const Index: Integer);
begin
  ListDelItem(List, DirSeparator, Index);
end;

// return the number of item
function PathListItemCount(const List: string): Integer;
begin
  Result := ListItemCount(List, DirSeparator);
end;

// return the Nth item
function PathListGetItem(const List: string; const Index: Integer): string;
begin
  Result := ListGetItem(List, DirSeparator, Index);
end;

// set the Nth item
procedure PathListSetItem(var List: string; const Index: Integer; const Value: string);
begin
  ListSetItem(List, DirSeparator, Index, Value);
end;

// return the index of an item
function PathListItemIndex(const List, Item: string): Integer;
var
  StrList: TStringList;
  IndexList: Integer;
begin
  StrList := TStringList.Create;
  try
    StrToStrings(List, DirSeparator, StrList);

    Result := -1;

    for IndexList := 0 to StrList.Count - 1 do
      if SamePath(StrList.Strings[IndexList], Item) then
    begin
      Result := IndexList;
      Break;
    end;
  finally
    StrList.Free;
  end;
end;


// additional functions to access the commandline parameters of an application

// returns the name of the command line parameter at position index, which is
// separated by the given separator, if the first character of the name part
// is one of the AllowedPrefixCharacters, this character will be deleted.
function ParamName(Index: Integer; const Separator: string;
  const AllowedPrefixCharacters: string; TrimName: Boolean): string;
var
  S: string;
  P: Integer;
begin
  if (Index > 0) and (Index <= ParamCount) then
  begin
    S := ParamStr(Index);
    if Pos(Copy(S, 1, 1), AllowedPrefixCharacters) > 0 then
      S := Copy(S, 2, Length(S) - 1);
    P := Pos(Separator, S);
    if P > 0 then
      S := Copy(S, 1, P - 1);
    if TrimName then
      S := Trim(S);
    Result := S;
  end
  else
    Result := '';
end;

// returns the value of the command line parameter at position index, which is
// separated by the given separator
function ParamValue(Index: Integer; const Separator: string; TrimValue: Boolean): string;
var
  S: string;
  P: Integer;
begin
  if (Index > 0) and (Index <= ParamCount) then
  begin
    S := ParamStr(Index);
    P := Pos(Separator, S);
    if P > 0 then
      S := Copy(S, P + 1, Length(S) - P);
    if TrimValue then
      S := Trim(S);
    Result := S;
  end
  else
    Result := '';
end;

// seaches a command line parameter where the namepart is the searchname
// and returns the value which is which by the given separator.
// CaseSensitive defines the search type. if the first character of the name part
// is one of the AllowedPrefixCharacters, this character will be deleted.
function ParamValue(const SearchName: string; const Separator: string;
  CaseSensitive: Boolean; const AllowedPrefixCharacters: string;
  TrimValue: Boolean): string;
var
  Name: string;
  SearchS: String;
  I: Integer;
begin
  Result := '';
  SearchS := Trim(SearchName);

  for I := 1 to ParamCount do
  begin
    Name := ParamName(I, Separator, AllowedPrefixCharacters, True);
    if (CaseSensitive and (Name = SearchS)) or
       ((not CaseSensitive) and (CompareText(Name, SearchS) = 0)) then
    begin
      Result := ParamValue(I, Separator, TrimValue);
      Exit;
    end;
  end;
end;

// seaches a command line parameter where the namepart is the searchname
// and returns the position index. if no separator is defined, the full paramstr is compared.
// CaseSensitive defines the search type. if the first character of the name part
// is one of the AllowedPrefixCharacters, this character will be deleted.
function ParamPos(const SearchName: string; const Separator: string;
  CaseSensitive: Boolean; const AllowedPrefixCharacters: string): Integer;
var
  Name: string;
  SearchS: string;
  I: Integer;
begin
  Result := -1;
  SearchS := Trim(SearchName);

  for I := 1 to ParamCount do
  begin
    Name := ParamName(I, Separator, AllowedPrefixCharacters, True);
    if (CaseSensitive and (Name = SearchS)) or
       ((not CaseSensitive) and (CompareText(Name, SearchS) = 0)) then
    begin
      Result := I;
      Exit;
    end;
  end;
end;


{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.