{**************************************************************************************************}
{                                                                                                  }
{ 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 documented in the accompanying                     }
{ help file JCL.chm. Portions created by these individuals are Copyright (C) of these individuals. }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ 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.                                     }
{                                                                                                  }
{ Unit owner: Marcel van Brakel                                                                    }
{ Last modified: September 2, 2002                                                                 }
{                                                                                                  }
{**************************************************************************************************}

unit JclFileUtils;

{$I jcl.inc}

{$WEAKPACKAGEUNIT ON}

interface

uses
  {$IFDEF MSWINDOWS}
  Windows,
  {$ENDIF MSWINDOWS}
  Classes, Graphics, SysUtils,
  JclBase, JclSysInfo;

//--------------------------------------------------------------------------------------------------
// 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 LINUX}
  PathSeparator    = '/';
  {$ENDIF LINUX}
  {$IFDEF MSWINDOWS}
  DriveLetters     = ['a'..'z', 'A'..'Z'];
  PathDevicePrefix = '\\.\';
  PathSeparator    = '\';
  PathUncPrefix    = '\\';
  {$ENDIF MSWINDOWS}

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

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;
function PathCompactPath(const DC: HDC; const Path: string; const Width: Integer;
  CmpFmt: TCompactPath): string; overload;
function PathCompactPath(const Canvas: TCanvas; const Path: string; const Width: Integer;
  CmpFmt: TCompactPath): string; overload;
procedure PathExtractElements(const Source: string; var Drive, Path, FileName, Ext: string);
function PathExtractFileDirFixed(const S: AnsiString): AnsiString;
function PathExtractFileNameNoExt(const Path: string): string;
function PathExtractPathDepth(const Path: string; Depth: Integer): string;
function PathGetDepth(const Path: string): Integer;
function PathGetLongName(const Path: string): string;
function PathGetLongName2(Path: string): string;
function PathGetShortName(const Path: string): string;
function PathIsAbsolute(const Path: string): Boolean;
function PathIsChild(const Path, Base: AnsiString): 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;

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

function BuildFileList(const Path: string; const Attr: Integer; const List: TStrings): Boolean;
function AdvBuildFileList(const Path: string; const Attr: Integer; const Files: TStrings;
  const AttributeMatch: TJclAttributeMatch = amSubsetOf; const Options: TFileListOptions = [];
  const SubfoldersMask: string = ''; const FileMatchFunc: TFileMatchFunc = nil): Boolean;
function CloseVolume(var Volume: THandle): Boolean;
procedure CreateEmptyFile(const FileName: string);
function DeleteDirectory(const DirectoryName: string; MoveToRecycleBin: Boolean): Boolean;
function DelTree(const Path: string): Boolean;
function DelTreeEx(const Path: string; AbortOnFailure: Boolean; Progress: TDelTreeProgress): Boolean;
function DirectoryExists(const Name: string): Boolean;
{$IFDEF MSWINDOWS}
function DiskInDrive(Drive: Char): Boolean;
{$ENDIF MSWINDOWS}
function FileCreateTemp(var Prefix: string): THandle;
//function FileExists(const FileName: string): Boolean;
function GetBackupFileName(const FileName: string): string;
function FileGetDisplayName(const FileName: string): string;
function FileGetSize(const FileName: string): Integer;
function FileGetTempName(const Prefix: string): string;
function FileGetTypeName(const FileName: string): string;
function FindUnusedFileName(const FileName, FileExt, Suffix: AnsiString): AnsiString;
function ForceDirectories(Name: string): Boolean;
function GetDirectorySize(const Path: string): Int64;
function GetDriveTypeStr(const Drive: Char): string;
function GetFileAgeCoherence(const FileName: string): Boolean;
procedure GetFileAttributeList(const Items: TStrings; const Attr: Integer);
procedure GetFileAttributeListEx(const Items: TStrings; const Attr: Integer);
function GetFileInformation(const FileName: string): TSearchRec;
function GetFileLastWrite(const FileName: string): TFileTime;
function GetFileLastAccess(const FileName: string): TFileTime;
function GetFileCreation(const FileName: string): TFileTime;
function GetModulePath(const Module: HMODULE): string;
function GetSizeOfFile(const FileName: string): Int64; overload;
function GetSizeOfFile(Handle: THandle): Int64; overload;
function GetStandardFileInfo(const FileName: string): TWin32FileAttributeData;
function IsDirectory(const FileName: string): Boolean;
function LockVolume(const Volume: string; var Handle: THandle): Boolean;
function OpenVolume(const Drive: Char): THandle;
function SetDirLastWrite(const DirName: string; const DateTime: TDateTime): Boolean;
function SetDirLastAccess(const DirName: string; const DateTime: TDateTime): Boolean;
function SetDirCreation(const DirName: string; const DateTime: TDateTime): Boolean;
function SetFileLastWrite(const FileName: string; const DateTime: TDateTime): Boolean;
function SetFileLastAccess(const FileName: string; const DateTime: TDateTime): Boolean;
function SetFileCreation(const FileName: string; const DateTime: TDateTime): Boolean;
procedure ShredFile(const FileName: string; Times: Integer = 1);
function UnlockVolume(var Handle: THandle): Boolean;
function Win32DeleteFile(const FileName: string; MoveToRecycleBin: Boolean): Boolean;
function Win32BackupFile(const FileName: string; Move: Boolean): Boolean;
function Win32RestoreFile(const FileName: string): Boolean;

//--------------------------------------------------------------------------------------------------
// 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: string;
    FFixedInfo: PVSFixedFileInfo;
    FFileFlags: TFileFlags;
    FItemList: TStrings;
    FItems: TStrings;
    FLanguages: array of TLangIdRec;
    FLanguageIndex: Integer;
    FTranslations: array of TLangIdRec;
    function GetFixedInfo: TVSFixedFileInfo;
    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 GetVersionKeyValue(Index: Integer): string;
  public
    constructor Attach(VersionInfoData: Pointer; Size: Integer);
    constructor Create(const FileName: string);
    destructor Destroy; override;
    class function VersionLanguageId(const LangIdRec: TLangIdRec): string;
    class function VersionLanguageName(const LangId: Word): string;
    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 Items: TStrings read FItems;
    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 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;
function VersionFixedFileInfo(const FileName: string; var FixedInfo: TVSFixedFileInfo): Boolean;

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

//--------------------------------------------------------------------------------------------------
// Streams
//
// TStream descendent classes for dealing with temporary files and for using file mapping objects.
//--------------------------------------------------------------------------------------------------

{ TTempFileStream }

type
  TJclTempFileStream = class (THandleStream)
  private
    FFileName: string;
  public
    constructor Create(const Prefix: string);
    destructor Destroy; override;
    property FileName: string read FFileName;
  end;

  TJclCustomFileMapping = class;

{ TJclFileMappingView }

  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;

{ TJclCustomFileMapping }

  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; const SecAttr: PSecurityAttributes);
    procedure InternalOpen(const Name: string; const InheritHandle: Boolean;
      const DesiredAccess: Cardinal);
    constructor Create;
  public
    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 }

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

{ TJclSwapFileMapping }

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

//--------------------------------------------------------------------------------------------------
// TJclFileMappingStream
//--------------------------------------------------------------------------------------------------

  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;

//--------------------------------------------------------------------------------------------------
// TJclMappedTextReader
//--------------------------------------------------------------------------------------------------

  TJclMappedTextReaderIndex = (tiNoIndex, tiFull);

  PPCharArray = ^TPCharArray;
  TPCharArray = array [0..0] of PChar;

  TJclMappedTextReader = class (TPersistent)
  private
    FContent: PChar;
    FEnd: PChar;
    FIndex: PPCharArray;
    FIndexOption: TJclMappedTextReaderIndex;
    FFreeStream: Boolean;
    FLastLineNumber: Integer;
    FLastPosition: PChar;
    FLineCount: Integer;
    FMemoryStream: TCustomMemoryStream;
    FPosition: PChar;
    FSize: Integer;
    function GetAsString: string;
    function GetEof: Boolean;
    function GetChars(Index: Integer): Char;
    function GetLineCount: Integer;
    function GetLines(LineNumber: Integer): string;
    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): PChar;
    function StringFromPosition(var StartPos: PChar): string;
  public
    constructor Create(MemoryStream: TCustomMemoryStream; FreeStream: Boolean = True;
      const AIndexOption: TJclMappedTextReaderIndex = tiNoIndex); overload;
    constructor Create(const FileName: string;
      const AIndexOption: TJclMappedTextReaderIndex = tiNoIndex); overload;
    destructor Destroy; override;
    procedure GoBegin;
    function Read: Char;
    function ReadLn: string;
    property AsString: string read GetAsString;
    property Chars[Index: Integer]: Char read GetChars;
    property Content: PChar read FContent;
    property Eof: Boolean read GetEof;
    property IndexOption: TJclMappedTextReaderIndex read FIndexOption;
    property Lines[LineNumber: Integer]: string 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;

//--------------------------------------------------------------------------------------------------
// TJclFileMaskComparator
//--------------------------------------------------------------------------------------------------

// TODO UNTESTET/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;

//--------------------------------------------------------------------------------------------------
// Exceptions
//--------------------------------------------------------------------------------------------------

  EJclPathError = class (EJclError);
  EJclFileUtilsError = class (EJclError);
  EJclTempFileStreamError = class (EJclWin32Error);
  EJclFileMappingError = class (EJclWin32Error);
  EJclFileMappingViewError = class (EJclWin32Error);

implementation

uses
  {$IFDEF MSWINDOWS}
  ActiveX, ShellApi, ShlObj,
  {$ENDIF MSWINDOWS}
  JclDateTime, JclResources, JclSecurity, JclShell, JclStrings, JclSysUtils, JclWin32;

{ Some general notes:

  This unit redeclares some functions from FileCtrl.pas to avoid a dependeny 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
  eventhough 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. }

//==================================================================================================
// TJclTempFileStream
//==================================================================================================

constructor TJclTempFileStream.Create(const Prefix: string);
var
  FileHandle: THandle;
begin
  FFileName := Prefix;
  FileHandle := FileCreateTemp(FFileName);
  if FileHandle = INVALID_HANDLE_VALUE then
    raise EJclTempFileStreamError.CreateResRec(@RsFileStreamCreate);
  inherited Create(FileHandle);
end;

//--------------------------------------------------------------------------------------------------

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

//==================================================================================================
// TJclFileMappingView
//==================================================================================================

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.CreateResRec(@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.CreateResRec(@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.CreateResRec(@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.CreateResRec(@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.CreateResRec(@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.CreateResRec(@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.CreateResRec(@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(Longint(Memory) + Position)^, Count);
    Position := Position + Count;
    Result := Count;
  end;
end;

//==================================================================================================
// TJclCustomFileMapping
//==================================================================================================

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;

//--------------------------------------------------------------------------------------------------

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;

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

destructor TJclCustomFileMapping.Destroy;
begin
  ClearViews;
  if FHandle <> 0 then
    CloseHandle(FHandle);
  FreeAndNil(FViews);
  inherited Destroy;
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;
  const 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.CreateResRec(@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.CreateResRec(@RsCreateFileMapping);
end;

//==================================================================================================
// TJclFileMapping
//==================================================================================================

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

//--------------------------------------------------------------------------------------------------

constructor TJclFileMapping.Create(const FileHandle: THandle; const Name: string;
  Protect: Cardinal; const MaximumSize: Int64; const SecAttr: PSecurityAttributes);
begin
  FFileHandle := INVALID_HANDLE_VALUE;
  inherited Create;
  if FileHandle = INVALID_HANDLE_VALUE then
    raise EJclFileMappingError.CreateResRec(@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; const SecAttr: PSecurityAttributes);
begin
  inherited Create;
  InternalCreate(INVALID_HANDLE_VALUE, Name, Protect, MaximumSize, SecAttr);
end;

//==================================================================================================
// TJclFileMappingStream
//==================================================================================================

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;

//--------------------------------------------------------------------------------------------------

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.CreateResRec(@RsCreateFileMapping);
  end;
  BaseAddress := MapViewOfFile(FMapping, Access, 0, 0, 0);
  if BaseAddress = nil then
  begin
    Close;
    raise EJclFileMappingViewError.CreateResRec(@RsCreateFileMappingView);
  end;
  Size := GetFileSize(FFileHandle, nil);
  if Size = DWORD(-1) then
  begin
    UnMapViewOfFile(BaseAddress);
    Close;
    raise EJclFileMappingViewError.CreateResRec(@RsFailedToObtainSize);
  end;
  SetPointer(BaseAddress, Size);
end;

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

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

//==================================================================================================
// TJclMappedTextReader
//==================================================================================================

procedure TJclMappedTextReader.AssignTo(Dest: TPersistent);
begin
  if Dest is TStrings then
  begin
    GoBegin;
    while not Eof do
      TStrings(Dest).Add(ReadLn);
  end
  else
    inherited;
end;

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

constructor TJclMappedTextReader.Create(const FileName: string;
  const AIndexOption: TJclMappedTextReaderIndex);
begin
  FMemoryStream := TJclFileMappingStream.Create(FileName);
  FFreeStream := True;
  FIndexOption := AIndexOption;
  Init;
end;

//--------------------------------------------------------------------------------------------------

procedure TJclMappedTextReader.CreateIndex;
var
  P, LastLineStart: PChar;
  I: Integer;
begin
  {$RANGECHECKS OFF}
  P := FContent;
  I := 0;
  LastLineStart := P;
  while P < FEnd do
  begin
    if P^ = AnsiLineFeed then
    begin
      if I and $FFFF = 0 then
        ReallocMem(FIndex, (I + $10000) * SizeOf(Pointer));
      FIndex[I] := LastLineStart;
      Inc(I);
      LastLineStart := P + 1;
    end;
    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;

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

function TJclMappedTextReader.GetAsString: string;
begin
  SetString(Result, Content, Size);
end;

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

function TJclMappedTextReader.GetLineCount: Integer;

  function CountLines(StartPtr: PChar; Len: Integer): Integer; assembler;
  asm
       PUSH    EDI
       MOV     EDI, EAX
       MOV     ECX, EDX
       MOV     EAX, AnsiLineFeed
       XOR     EDX, EDX
  @@1: REPNZ   SCASB
       INC     EDX
       OR      ECX, ECX
       JNZ     @@1
       MOV     EAX, EDX
       POP     EDI
  end;

begin
  if FLineCount = -1 then
    FLineCount := CountLines(FContent, FSize);
  Result := FLineCount;
end;

//--------------------------------------------------------------------------------------------------

function TJclMappedTextReader.GetLines(LineNumber: Integer): string;
var
  P: PChar;
begin
  P := PtrFromLine(LineNumber);
  Result := StringFromPosition(P);
end;

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

procedure TJclMappedTextReader.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 TJclMappedTextReader.GetPositionFromLine(LineNumber: Integer): Integer;
var
  P: PChar;
begin
  P := PtrFromLine(LineNumber);
  if P = nil then
    Result := -1
  else
    Result := P - FContent;
end;

//--------------------------------------------------------------------------------------------------

function TJclMappedTextReader.PtrFromLine(LineNumber: Integer): PChar;
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
        if Result^ = AnsiLineFeed then
          Dec(LineOffset);
        Inc(Result);
      end;
    end
    else
    if LineOffset < 0 then
    begin
      Result := FLastPosition;
      while (Result >= FContent) and (LineOffset < 1) do
      begin
        if Result^ = AnsiLineFeed then
          Inc(LineOffset);
        Dec(Result);
      end;
      Inc(Result, 2);
    end;
    FLastLineNumber := LineNumber;
    FLastPosition := Result;
  end;
end;

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

function TJclMappedTextReader.ReadLn: string;
begin
  Result := StringFromPosition(FPosition);
end;

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

function TJclMappedTextReader.StringFromPosition(var StartPos: PChar): string;
var
  P, StringEnd: PChar;
begin
  if (StartPos = nil) or (StartPos >= FEnd) then
    Result := ''
  else
  begin
    P := StartPos;
    while (P < FEnd) and (P^ <> AnsiLineFeed) do
      Inc(P);
    if (P > FContent) and ((P - 1)^ = AnsiCarriageReturn) then
      StringEnd := P - 1
    else
      StringEnd := P;
    SetString(Result, StartPos, StringEnd - StartPos);
    StartPos := P + 1;
  end;
end;

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

function PathAddSeparator(const Path: string): string;
begin
  Result := Path;
  if (Length(Path) = 0) or (AnsiLastChar(Path) <> PathSeparator) then
    Result := Path + PathSeparator;
end;

//--------------------------------------------------------------------------------------------------

function PathAddExtension(const Path, Extension: string): string;
begin
  Result := Path;
  if (Path <> '') and (ExtractFileExt(Path) = '') and (Extension <> '') then
  begin
    // Note that if we get here Path is quarenteed not to end in a '.' otherwise ExtractFileExt
    // would have returned '.' therefore there's no need to check it explicitly in the code below
    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 al it does is add Append to Path ensuring
      // that there is one and only one path separator character between them
      B1 := Path[PathLength] = PathSeparator;
      B2 := Append[1] = PathSeparator;
      if B1 and B2 then
        Result := Copy(Path, 1, PathLength - 1) + Append
      else
      begin
        if not (B1 or B2) then
          Result := Path + PathSeparator + Append
        else
          Result := Path + Append;
      end;
    end;
  end;
end;

//--------------------------------------------------------------------------------------------------

function PathBuildRoot(const Drive: Byte): string;
begin
  {$IFDEF LINUX}
  Result := PathSeparator;
  {$ENDIF LINUX}
  {$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.CreateResRecFmt(@RsPathInvalidDrive, [IntToStr(Drive)]);
  {$ENDIF MSWINDOWS}
end;

//--------------------------------------------------------------------------------------------------

{ todoc

  Canonicalizes a path. Meaning, it parses the specified path for the character
  sequences '.' and '..' where '.' means skip over the next path part and '..'
  means remove the previous path part.

  For example:
    c:\users\.\delphi\data => c:\users\delphi\data
    c:\users\..\delphi\data => c:\brakelm\delphi\data
    c:\users\.\delphi\.. => c:\users
    c:\users\.\..\data => c:\data

  Thus, the '.' and '..' sequences have similar meaning to their counterparts in
  the filesystem.

  Path: the path to canonicalize
  Result: the canonicalized path
  Author: Jeff
  Notes: This function does not behave exactly like the one from shlwapi.dll!!
         Especially 'c:\..' => 'c:' whereas shlwapi returns 'c:\'
}

function PathCanonicalize(const Path: string): string;
var
  List: TStrings;
  I: Integer;
begin
  List := TStringList.Create;
  try
    StrIToStrings(Path, '\', List, False);
    I := 0;
    while I < List.Count do
    begin
      if List[I] = '.' then List.Delete(I)
      else if (List[I] = '..') then
      begin
        List.Delete(I);
        Dec(I);
        if I > 0 then List.Delete(I);
      end
      else Inc(I);
    end;
    Result := StringsToStr(List, '\', False);
  finally
    List.Free;
  end;
end;

//--------------------------------------------------------------------------------------------------

function PathCommonPrefix(const Path1, Path2: string): Integer;
var
  P1, P2: PChar;
  LastSeparator: Integer;
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
      P1 := @Path1[1];
      P2 := @Path2[1];
    end
    else
    begin
      P1 := @Path2[1];
      P2 := @Path1[1];
    end;
    LastSeparator := 0;
    while (P1^ = P2^) and (P1^ <> #0) do
    begin
      Inc(Result);
      if P1^ in [PathSeparator, ':'] then LastSeparator := Result;
      Inc(P1);
      Inc(P2);
    end;
    if (LastSeparator < Result) and (P1^ <> #0) then Result := LastSeparator;
  end;
end;

//--------------------------------------------------------------------------------------------------

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;
  P: PChar;
  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." }
    P := StrAlloc(Length(Path) + 5);
    try
      StrPCopy(P, Path);
      TextRect := Rect(0, 0, Width, 255);
      Fmt := DT_MODIFYSTRING + DT_CALCRECT + Compacts[CmpFmt];
      if DrawTextEx(DC, P, -1, TextRect, Fmt, nil) <> 0 then
        Result := P;
    finally
      StrDispose(P);
    end;
  end;
end;

//--------------------------------------------------------------------------------------------------

function PathCompactPath(const Canvas: TCanvas; const Path: string;
  const Width: Integer; CmpFmt: TCompactPath): string; overload;
begin
  Result := PathCompactPath(Canvas.Handle, Path, Width, CmpFmt);
end;

//--------------------------------------------------------------------------------------------------

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] = PathSeparator) then
    Delete(Path, 1, 1);
  // and extract the remaining elements
  FileName := PathExtractFileNameNoExt(Source);
  Ext := ExtractFileExt(Source);
end;

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

{ todoc

  Returns the first Depth path parts of the specified path exclusing drive.
  Example: PathExtractPathDepth('c:\users\brakelm\data', 2) => 'c:\users\brakelm'
  Path: the path to extract from
  Depth: the depth of the path to return (i.e. the number of directory parts).
  Author: Jeff
}

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

//--------------------------------------------------------------------------------------------------

{ todoc

  Returns the depth of a path. That is the number of subdirectories in the path.
  Path: the path for which to return the depth
  Result: depth of the path
  Author: Jeff
  Notes: maybe this function should first apply PathCanonicalize() ?
}

function PathGetDepth(const Path: string): Integer;
var
  List: TStrings;
  LocalPath: string;
  I, Start: Integer;
begin
  Result := 0;
  List := TStringList.Create;
  try
    if IsDirectory(Path) then
      LocalPath := Path
    else
      LocalPath := ExtractFilePath(Path);
    StrIToStrings(LocalPath, '\', 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;

//--------------------------------------------------------------------------------------------------

function PathGetLongName2(Path: string): string;
var
  I : Integer;
  SearchHandle : THandle;
  FindData : TWin32FindData;
  IsBackSlash : Boolean;
begin
  Path := ExpandFileName(Path);
  Result := ExtractFileDrive(Path);
  I := Length(Result);
  if Length(Path) <= I then
    Exit;   // only drive
  if Path[I + 1] = '\' then
  begin
    Result := Result + '\';
    Inc(I);
  end;
  Delete(Path, 1, I);
  repeat
    I := Pos('\', Path);
    IsBackSlash := I > 0;
    if Not IsBackSlash then
      I := Length(Path) + 1;
    SearchHandle := FindFirstFile(PChar(Result + Copy(Path, 1, 
      I - 1)), FindData);
    if SearchHandle <> INVALID_HANDLE_VALUE then
    begin
      try
        Result := Result + FindData.cFileName;
        if IsBackSlash then
          Result := Result + '\';
      finally
        Windows.FindClose(SearchHandle);
      end;
    end
    else
    begin
      Result := Result + Path;
      Break;
    end;
    Delete(Path, 1, I);
  until Length(Path) = 0;
end;

//--------------------------------------------------------------------------------------------------

function PathGetLongName(const Path: string): string;
var
  PIDL: PItemIDList;
  Desktop: IShellFolder;
  AnsiName: AnsiString;
  WideName: array [0..MAX_PATH] of WideChar;
  Eaten, Attr: ULONG; // both unused but API requires them (incorrect translation)
begin
  Result := Path;
  if Path <> '' then
  begin
    if Succeeded(SHGetDesktopFolder(Desktop)) then
    begin
      MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PChar(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
          Result := PChar(AnsiName);
      finally
        CoTaskMemFree(PIDL);
      end;
    end;
  end;
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;

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

function PathIsChild(const Path, Base: AnsiString): 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] = PathSeparator);
  {$ENDIF MSWINDOWS}
  {$IFDEF LINUX}
  Result := AnsiSameStr(StrLeft(P, L), B) and (P[L+1] = PathSeparator);
  {$ENDIF LINUX}
end;

//--------------------------------------------------------------------------------------------------

function PathIsDiskDevice(const Path: string): Boolean;
begin
  {$IFDEF LINUX}
  NotImplemented('PathIsDiskDevice');
  {$ENDIF LINUX}
  {$IFDEF MSWINDOWS}
  Result := Copy(Path, 1, Length(PathDevicePrefix)) = PathDevicePrefix;
  {$ENDIF MSWINDOWS}
end;

//--------------------------------------------------------------------------------------------------

function PathIsUNC(const Path: string): Boolean;
{$IFDEF MSWINDOWS}

const
  cUNCSuffix = '?\UNC';

var
  P: PChar;

  function AbsorbSeparator: Boolean;
  begin
    Result := (P <> nil) and (P^ = '\');
    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 <> nil) and (P^ <> #0) and (P^ <> '\') do
    begin
      if P^ in ['a'..'z', 'A'..'Z', '-', '_', '.'] then
      begin
        NonDigitFound := True;
        Inc(P);
      end
      else
      if P^ in ['0'..'9'] then
        Inc(P)
      else
      begin
        Result := False;
        Break;
      end;
    end;
    Result := Result and NonDigitFound;
  end;

  function AbsorbShareName: Boolean;
  const
    InvalidCharacters = ['<','>','?','/',',','*','+','=','[',']','|',':',';','"',''''];
  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 <> nil) and (P^ <> #0) and (P^ <> '\') do
    begin
      if P^ in InvalidCharacters 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 LINUX}

begin
  Result := False;
end;

{$ENDIF LINUX}

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

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

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

function BuildFileList(const Path: string; const Attr: Integer; const List: TStrings): Boolean;
var
  SearchRec: TSearchRec;
  R: Integer;
begin
  Assert(List <> nil);
  R := FindFirst(Path, Attr, SearchRec);
  Result := R = 0;
  try
    if Result then
    begin
      while R = 0 do
      begin
        if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
          List.Add(SearchRec.Name);
        R := FindNext(SearchRec);
      end;
      Result := R = ERROR_NO_MORE_FILES;
    end;
  finally
    SysUtils.FindClose(SearchRec);
  end;  
end;

//--------------------------------------------------------------------------------------------------

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;

//--------------------------------------------------------------------------------------------------

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;

//--------------------------------------------------------------------------------------------------

// todoc author Jeff

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

//--------------------------------------------------------------------------------------------------

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
  Result := True;
  Files := TStringList.Create;
  try
    LPath := PathRemoveSeparator(Path);
    BuildFileList(LPath + '\*.*', faAnyFile, Files);
    for I := 0 to Files.Count - 1 do
    begin
      FileName := LPath + '\' + 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;

//--------------------------------------------------------------------------------------------------

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;

//--------------------------------------------------------------------------------------------------

{$IFDEF MSWINDOWS}

function DiskInDrive(Drive: Char): Boolean;
var
  ErrorMode: Cardinal;
begin
  Result := False;
  if Drive in ['a'..'z'] then
    Dec(Drive, $20);
  Assert(Drive in ['A'..'Z']);
  if Drive in ['A'..'Z'] then
  begin
  { 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;
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;

//--------------------------------------------------------------------------------------------------
{
//XARKA: Disable this!!
function FileExists(const FileName: string): Boolean;
begin
  // Attempt to access the file, doesn't matter how, using FileGetSize is as good as anything else.
  Result := FileGetSize(FileName) <> -1;
end;
}
//--------------------------------------------------------------------------------------------------

{ todoc

  returns a filename that can be used for backup purposes. this is similar to
  how delphi uses backup's: it simply prepends a tilde (~) to the extension.
  filename: the filename for which to return a backup filename
  result: the filename used for backup purposes
  author: Jeff
}

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

//--------------------------------------------------------------------------------------------------

function FileGetDisplayName(const FileName: string): string;
var
  FileInfo: TSHFileInfo;
begin
  FillChar(FileInfo, SizeOf(FileInfo), #0);
  if SHGetFileInfo(PChar(FileName), 0, FileInfo, SizeOf(FileInfo), SHGFI_DISPLAYNAME) <> 0 then
    Result := FileInfo.szDisplayName
  else
    Result := FileName;
end;

//--------------------------------------------------------------------------------------------------

function FileGetSize(const FileName: string): Integer;
var
  SearchRec: TSearchRec;
  OldMode: Cardinal;
begin
  Result := -1;
  OldMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
    if FindFirst(FileName, faAnyFile, SearchRec) = 0 then
    begin
      Result := SearchRec.Size;
      SysUtils.FindClose(SearchRec);
    end;
  finally
    SetErrorMode(OldMode);
  end;
end;

//--------------------------------------------------------------------------------------------------

function FileGetTempName(const Prefix: string): string;
var
  TempPath, TempFile: string;
  R: Cardinal;
begin
  Result := '';
  R := GetTempPath(0, nil);
  SetLength(TempPath, R);
  R := GetTempPath(R, PChar(TempPath));
  if R <> 0 then
  begin
    SetLength(TempPath, StrLen(PChar(TempPath)));
    SetLength(TempFile, MAX_PATH);
    R := GetTempFileName(PChar(TempPath), PChar(Prefix), 0, PChar(TempFile));
    if R <> 0 then
    begin
      SetLength(TempFile, StrLen(PChar(TempFile)));
      Result := TempFile;
    end;
  end;
end;

//--------------------------------------------------------------------------------------------------

function FileGetTypeName(const FileName: string): string;
var
  FileInfo: TSHFileInfo;
  RetVal: DWORD;
begin
  FillChar(FileInfo, SizeOf(FileInfo), #0);
  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) + RsDefaultFileTypeName);
  end;
end;

//--------------------------------------------------------------------------------------------------

function FindUnusedFileName(const FileName, FileExt, Suffix: AnsiString): AnsiString;
var
  I: Integer;
begin
  Result := FileName + '.' + FileExt;
  I := 0;
  while FileExists(Result) do
  begin
    Inc(I);
    Result := FileName + Suffix + IntToStr(I) + '.' + FileExt;
  end;
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;
begin
  Result := True;
  if Length(Name) = 0 then
    raise EJclFileUtilsError.CreateResRec(@RsCannotCreateDir);
  Name := PathRemoveSeparator(Name);
  if (Length(Name) < 3) or DirectoryExists(Name)
    or (ExtractFilePath(Name) = Name) then
    Exit;
  Result := ForceDirectories(ExtractFilePath(Name)) and CreateDir(Name);
end;

//--------------------------------------------------------------------------------------------------

function GetDirectorySize(const Path: string): Int64;

  function RecurseFolder(const Path: string): Int64;
  var
    F: TSearchRec;
    R: Integer;
    TempSize: TULargeInteger;
  begin
    Result := 0;
    R := 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 + '\'))
          else
          begin
            TempSize.LowPart := F.FindData.nFileSizeLow;
            TempSize.HighPart := F.FindData.nFileSizeHigh;
            Inc(Result, TempSize.QuadPart);
          end;
        end;
        R := SysUtils.FindNext(F);
      end;
      if R <> ERROR_NO_MORE_FILES then
        Abort;
    finally
      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;

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

function GetFileAgeCoherence(const FileName: string): Boolean;
var
  Handle: THandle;
  FindData: TWin32FindData;
begin
  Result := False;
  Handle := FindFirstFile(PChar(FileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    Result := CompareFileTime(FindData.ftCreationTime, FindData.ftLastWriteTime) <= 0;
  end;
end;

//--------------------------------------------------------------------------------------------------

procedure GetFileAttributeList(const Items: TStrings; const Attr: Integer);
begin
  Assert(Items <> nil);
  if Attr and faDirectory = faDirectory then
    Items.Add(RsAttrDirectory);
  if Attr and faReadOnly = faReadOnly then
    Items.Add(RsAttrReadOnly);
  if Attr and faSysFile = faSysFile then
    Items.Add(RsAttrSystemFile);
  if Attr and faVolumeID = faVolumeID then
    Items.Add(RsAttrVolumeID);
  if Attr and faArchive = faArchive then
    Items.Add(RsAttrArchive);
  if Attr and faAnyFile = faAnyFile then
    Items.Add(RsAttrAnyFile);
  if Attr and faHidden = faHidden then
    Items.Add(RsAttrHidden);
end;

//--------------------------------------------------------------------------------------------------

procedure GetFileAttributeListEx(const Items: TStrings; const Attr: Integer);
begin
  Assert(Items <> nil);
  if Attr and FILE_ATTRIBUTE_READONLY = FILE_ATTRIBUTE_READONLY then
    Items.Add(RsAttrReadOnly);
  if Attr and FILE_ATTRIBUTE_HIDDEN = FILE_ATTRIBUTE_HIDDEN then
    Items.Add(RsAttrHidden);
  if Attr and FILE_ATTRIBUTE_SYSTEM = FILE_ATTRIBUTE_SYSTEM then
    Items.Add(RsAttrSystemFile);
  if Attr and FILE_ATTRIBUTE_DIRECTORY = FILE_ATTRIBUTE_DIRECTORY then
    Items.Add(RsAttrDirectory);
  if Attr and FILE_ATTRIBUTE_ARCHIVE = FILE_ATTRIBUTE_ARCHIVE then
    Items.Add(RsAttrArchive);
  if Attr and FILE_ATTRIBUTE_NORMAL = FILE_ATTRIBUTE_NORMAL then
    Items.Add(RsAttrNormal);
  if Attr and FILE_ATTRIBUTE_TEMPORARY = FILE_ATTRIBUTE_TEMPORARY then
    Items.Add(RsAttrTemporary);
  if Attr and FILE_ATTRIBUTE_COMPRESSED = FILE_ATTRIBUTE_COMPRESSED then
    Items.Add(RsAttrCompressed);
  if Attr and FILE_ATTRIBUTE_OFFLINE = FILE_ATTRIBUTE_OFFLINE then
    Items.Add(RsAttrOffline);
  if Attr and FILE_ATTRIBUTE_ENCRYPTED = FILE_ATTRIBUTE_ENCRYPTED then
    Items.Add(RsAttrEncrypted);
  if Attr and FILE_ATTRIBUTE_REPARSE_POINT = FILE_ATTRIBUTE_REPARSE_POINT then
    Items.Add(RsAttrReparsePoint);
  if Attr and FILE_ATTRIBUTE_SPARSE_FILE = FILE_ATTRIBUTE_SPARSE_FILE then
    Items.Add(RsAttrSparseFile);
end;

//--------------------------------------------------------------------------------------------------

function GetFileInformation(const FileName: string): TSearchRec;
begin
  if FindFirst(FileName, faAnyFile, Result) = 0 then
    SysUtils.FindClose(Result)
  else
    RaiseLastOSError;
end;

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

function GetModulePath(const Module: HMODULE): string;
var
  L: Integer;
begin
  L := MAX_PATH + 1;
  SetLength(Result, L);
  L := Windows.GetModuleFileName(Module, Pointer(Result), L);
  SetLength(Result, L);
end;

//--------------------------------------------------------------------------------------------------

function GetSizeOfFile(const FileName: string): Int64;
var
  Handle: THandle;
  FindData: TWin32FindData;
  Size: TULargeInteger;
begin
  Result := 0;
  Handle := FindFirstFile(PChar(FileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    Size.LowPart := FindData.nFileSizeLow;
    Size.HighPart := FindData.nFileSizeHigh;
    Result := Size.QuadPart;
  end
  else
    RaiseLastOSError;
end;

//--------------------------------------------------------------------------------------------------

function GetSizeOfFile(Handle: THandle): Int64;
var
  Size: TULargeInteger;
begin
  Size.LowPart := GetFileSize(Handle, @Size.HighPart);
  Result := Size.QuadPart;
end;

//--------------------------------------------------------------------------------------------------

function GetStandardFileInfo(const FileName: string): TWin32FileAttributeData;
var
  Handle: THandle;
  FileInfo: TByHandleFileInformation;
begin
  Assert(FileName <> '');
  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
      if not GetFileInformationByHandle(Handle, FileInfo) then
        raise EJclFileUtilsError.CreateResRecFmt(@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.CreateResRecFmt(@RsFileUtilsAttrUnavailable, [FileName]);
  end
  else
  begin
    if not GetFileAttributesEx(PChar(FileName), GetFileExInfoStandard, @Result) then
      raise EJclFileUtilsError.CreateResRecFmt(@RsFileUtilsAttrUnavailable, [FileName]);
  end;
end;

//--------------------------------------------------------------------------------------------------

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;

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

type
  // indicates the file time to set, used by SetFileTimesHelper and SetDirTimesHelper
  TFileTimes = (ftLastAccess, ftLastWrite, ftCreation);

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);
    SysUtils.DateTimeToSystemTime(DateTime, SystemTime);
    if 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;

//--------------------------------------------------------------------------------------------------

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;

//--------------------------------------------------------------------------------------------------

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): Boolean;
var
  Handle: THandle;
  FileTime: TFileTime;
  SystemTime: TSystemTime;
begin
  Result := False;
  if IsDirectory(DirName) and 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
      SysUtils.DateTimeToSystemTime(DateTime, SystemTime);
      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): Boolean;
begin
  Result := SetDirTimesHelper(DirName, DateTime, ftLastWrite);
end;

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

function SetDirCreation(const DirName: string; const DateTime: TDateTime): Boolean;
begin
  Result := SetDirTimesHelper(DirName, DateTime, ftCreation);
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: Pointer;
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
      GetMem(ContentPtr, BUFSIZE);
      while Times > 0 do
      begin
        if Times mod 2 = 0 then
          FillMemory(ContentPtr, BUFSIZE, EVEN_FILL)
        else
          FillMemory(ContentPtr, BUFSIZE, ODD_FILL);
        Fs.Seek(0, soFromBeginning);
        N := Size div BUFSIZE;
        while N > 0 do
        begin
          Fs.Write(ContentPtr^, BUFSIZE);
          Dec(N);
        end;
        N := Size mod BUFSIZE;
        if N > 0 then
          Fs.Write(ContentPtr^, N);
        FlushFileBuffers(Fs.Handle);
        Dec(Times);
      end;
    finally
      if ContentPtr <> nil then
        FreeMem(ContentPtr, Size);
      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
    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;

//--------------------------------------------------------------------------------------------------

// todoc Author: Jeff

function Win32DeleteFile(const FileName: string; MoveToRecycleBin: Boolean): Boolean;
begin
  if MoveToRecycleBin then
    Result := SHDeleteFiles(0, FileName, [doSilent, doAllowUndo, doFilesOnly])
  else
    Result := Windows.DeleteFile(PChar(FileName));
end;

//--------------------------------------------------------------------------------------------------

function Win32BackupFile(const FileName: string; Move: Boolean): Boolean;
begin
  if Move then
    Result := MoveFileEx(PChar(FileName), PChar(GetBackupFileName(FileName)), MOVEFILE_REPLACE_EXISTING)
  else
    Result := CopyFile(PChar(FileName), PChar(GetBackupFileName(FileName)), False)
end;

//--------------------------------------------------------------------------------------------------

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

   if MoveFileEx(PChar(GetBackupFileName(FileName)), PChar(TempFileName), MOVEFILE_REPLACE_EXISTING) then
     if Win32BackupFile(FileName, False) then
       Result := MoveFileEx(PChar(TempFileName), PChar(FileName), MOVEFILE_REPLACE_EXISTING); 
end;

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

const
  VerKeyNames: array [1..12] of string[17] =
   ('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 := RsVosUnknown;
    VOS_DOS:
      Result := RsVosDos;
    VOS_OS216:
      Result := RsVosOS216;
    VOS_OS232:
      Result := RsVosOS232;
    VOS_NT:
      Result := RsVosNT;
    VOS__WINDOWS16:
      Result := RsVosWindows16;
    VOS__PM16:
      Result := RsVosPM16;
    VOS__PM32:
      Result := RsVosPM32;
    VOS__WINDOWS32:
      Result := RsVosWindows32;
    VOS_DOS_WINDOWS16:
      Result := RsVosDosWindows16;
    VOS_DOS_WINDOWS32:
      Result := RsVosDosWindows32;
    VOS_OS216_PM16:
      Result := RsVosOS216PM16;
    VOS_OS232_PM32:
      Result := RsVosOS232PM32;
    VOS_NT_WINDOWS32:
      Result := RsVosNTWindows32;
  else
    Result := RsVosUnknown;
  end;
  if Result <> RsVosUnknown then
    Result := RsVosDesignedFor + Result;
end;

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

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;

//==================================================================================================
// TJclFileVersionInfo
//==================================================================================================

constructor TJclFileVersionInfo.Attach(VersionInfoData: Pointer; Size: Integer);
begin
  SetString(FBuffer, PChar(VersionInfoData), Size);
  ExtractData;
end;

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

constructor TJclFileVersionInfo.Create(const FileName: string);
var
  Handle: THandle;
  Size: DWORD;
begin
  Size := GetFileVersionInfoSize(PChar(FileName), Handle);
  if Size = 0 then
    raise EJclFileVersionInfoError.CreateResRec(@RsFileUtilsNoVersionInfo);
  SetLength(FBuffer, Size);
  Win32Check(GetFileVersionInfo(PChar(FileName), Handle, Size, PChar(FBuffer)));
  ExtractData;
end;

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

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

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

  procedure GetHeader;
  var
    P: PChar;
    TempKey: PWideChar;
  begin
    P := Data;
    Len := PWord(P)^;
    if Len = 0 then
    begin
      Error := True;
      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 := PAnsiChar(P);
      Inc(P, lstrlenA(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 Key[I] in AnsiHexDigits then
        Inc(I)
      else
        Delete(Key, I, 1);
  end;

  procedure ProcessStringInfo(Size: Integer);
  var
    EndPtr, EndStringPtr: PChar;
    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
              Value := '';
          1:
            if ValueLen = 0 then
              Value := ''
            else
            if IsUnicode then
            begin
              Value := WideCharLenToString(PWideChar(Data), ValueLen);
              StrResetLength(Value);
            end
            else
              Value := 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(Size: Integer);
  var
    TranslationIndex: Integer;
  begin
    GetHeader; // Var
    if 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(DWORD(Data) mod 4 = 0);
  IsUnicode := (PWord(Data + 4)^ in [0, 1]);
  Error := True;
  GetHeader;
  EndOfData := Data + Len - HeaderSize;
  if (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 Key = 'StringFileInfo' then
        ProcessStringInfo(Len)
      else
      if Key = 'VarFileInfo' then
        ProcessVarInfo(Len)
      else
        Break;
    end;
    ExtractFlags;
    CreateItemsForLanguage;
  end;
  if Error then
    raise EJclFileVersionInfoError.CreateResRec(@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
  with FFixedInfo^ do
    Result := Format('%u.%u.%u.%u', [HiWord(dwFileVersionMS),
      LoWord(dwFileVersionMS), HiWord(dwFileVersionLS), LoWord(dwFileVersionLS)]);
end;

//--------------------------------------------------------------------------------------------------

function TJclFileVersionInfo.GetBinProductVersion: string;
begin
  with FFixedInfo^ do
    Result := Format('%u.%u.%u.%u', [HiWord(dwProductVersionMS),
      LoWord(dwProductVersionMS), HiWord(dwProductVersionLS),
      LoWord(dwProductVersionLS)]);
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.GetFixedInfo: TVSFixedFileInfo;
begin
  Result := FFixedInfo^;
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.GetVersionKeyValue(Index: Integer): string;
begin
  Result := FItems.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;

//==================================================================================================
// TJclFileMaskComparator
//==================================================================================================

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;

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

procedure TJclFileMaskComparator.CreateMultiMasks;
const
  WildChars = ['*', '?'];
var
  List: TStrings;
  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, WildChars, False) then
        N := N or 1;
      if StrContainsChars(ES, WildChars, 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;
  LocAttr: Integer;

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

    while CurrentItem <= Counter do
    begin
      // searching for subfolders
      Rslt := FindFirst(Folders[CurrentItem] + '*.*', faDirectory, 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 + PathSeparator);

          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, LocAttr, FindInfo);

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

         case AttributeMatch of
           amAny: Matches := (LocAttr and FindInfo.Attr) <> 0;
           amExact: Matches := LocAttr = FindInfo.Attr;
           amSuperSetOf: Matches := (LocAttr and FindInfo.Attr) = FindInfo.Attr;
           amSubSetOf: Matches := (LocAttr and FindInfo.Attr) = LocAttr;
           amCustom: if @FileMatchFunc <> nil then
                       Matches := FileMatchFunc(LocAttr,  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(Files <> nil);
  FileMask := ExtractFileName(Path);
  RootDir := ExtractFilePath(Path);

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

    if Attr = faAnyFile then
      LocAttr := faReadOnly + faHidden + faSysFile + faArchive
    else
      LocAttr := Attr;

    // 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;
  end;
  Result := True;
end;


end.
