QuickLib/Quick.Files.pas

{ ***************************************************************************

  Copyright (c) 2016-2019 Kike Pérez

  Unit        : Quick.Files
  Description : Files functions
  Author      : Kike Pérez
  Version     : 1.5
  Created     : 09/03/2018
  Modified    : 23/05/2019

  This file is part of QuickLib: https://github.com/exilon/QuickLib

 ***************************************************************************

  Licensed under the Apache License, Version 2.0 (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.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.

 *************************************************************************** }

unit Quick.Files;

{$i QuickLib.inc}

interface

uses
  Classes,
  SysUtils,
  {$IFDEF MSWINDOWS}
  Windows,
  {$ENDIF}
  {$IFDEF FPC}
  strutils,
    {$IFDEF LINUX}
    baseunix,
    {$ENDIF}
  {$ENDIF}
  {$IFDEF POSIX}
  Posix.Base,
  Posix.SysStat,
  Posix.Utime,
  {$ENDIF}
  DateUtils;

{$IFDEF FPC}
resourcestring

  SPathTooLong = 'The specified path is too long';
  SPathNotFound = 'The specified path was not found';
  SPathFormatNotSupported = 'The path format is not supported';
  SDirectoryNotEmpty = 'The specified directory is not empty';
  SDirectoryAlreadyExists = 'The specified directory already exists';
  SDirectoryInvalid = 'The specified directory name is invalid';
  SSourceDirIsDestDir = 'The source directory is the same as the destination directory';
  SSourceFileIsDestFile = 'The source file is the same as the destination file';
  SPathToFileNeeded = 'The path must specify a file';
  SSameRootDrive = 'The source and destination paths must contain the same root drive';
  SDriveNotFound = 'The drive cannot be found';
  SFileNotFound = 'The specified file was not found';
  SFileAlreadyExists = 'The specified file already exists';
  SInvalidCharsInPath = 'Invalid characters in path';
  SInvalidCharsInFileName = 'Invalid characters in file name';
{$ENDIF}

type


  {$IFNDEF FPC}
    TTextFileOperation = (tfOpenRead,tfOpenOverwrite,tfOpenAppend);

    TTextStreamFile = class
      private
        fReadStream : TStreamReader;
        fWriteStream : TStreamWriter;
        function GetEOF : Boolean;
      public
        constructor Create(const aFileName : string; aOpenMode : TTextFileOperation);
        destructor Destroy; override;
        function ReadLn: string; overload;
        function ReadLn(out Data: string): Boolean; overload;
        procedure WriteLn (const Data : string);
        procedure Close;
        property EOF: Boolean read GetEOF;
    end;
    {$IF Defined(MACOS) OR Defined(NEXTGEN) OR Defined(DELPHILINUX)}
    TFileTime = LongInt;
    {$ENDIF}
  {$ELSE}
    {$IFDEF LINUX}
    TFILETIME = LongInt;
    {$ENDIF}
  {$ENDIF}

  {$IFDEF FPC}
  EStreamError = class(Exception);
  EFileStreamError = class(EStreamError)
    constructor Create(ResStringRec: PResStringRec; const FileName: string);
  end;

  TPathPrefixType = (pptNoPrefix, pptExtended, pptExtendedUNC);

  { TPath }

  TPath = class
  private
    const
      FCCurrentDir: string = '.';
      FCParentDir: string = '..';
      FCExtendedPrefix: string = '\\?\';
      FCExtendedUNCPrefix: string = '\\?\UNC\';
    class procedure CheckPathLength(const Path: string; const MaxLength: Integer);
  public
    class function GetFileNameWithoutExtension(const FileName : string) : string;
    class function GetDirectoryName(const FileName : string) : string;
    class function GetExtension(const Path : string) : string;
    class function ChangeExtension(const Path, NewExtension : string) : string;
    class function GetFileName(const aPath : string) : string;
    class function EndsWithDelimiter(const aPath : string) : Boolean;
    class function Combine(const aPath1, aPath2 : string) : string;
  end;

  TDirectory = class
  public
    class function Exists(const Path: string; FollowLink: Boolean = True): Boolean;
    class function GetDirectories(const Path : string) : TArray<string>;
  end;

  TFile = class
  public
    class function Exists(const Path : string) : Boolean;
    class function IsInUse(const Path : string) : Boolean;
    class function GetSize(const Path : string) : Int64;
    class function Create(const Path: string; const BufferSize: Integer): TFileStream; overload;
    class function Create(const Path: string): TFileStream; overload;
    class function GetExtension(const Path : string) : string;
    class function GetCreationTime(const Path : string): TDateTime;
    class function GetLastAccessTime(const Path : string): TDateTime;
    class function GetLastWriteTime(const Path : string): TDateTime;
    class procedure SetCreationTime(const Path: string; const CreationTime: TDateTime);
    class procedure SetLastAccessTime(const Path: string; const LastAccessTime: TDateTime);
    class procedure SetLastWriteTime(const Path: string; const LastWriteTime: TDateTime);
    class function IsReadOnly(const Path : string) : Boolean;
    class function Delete(const Path : string) : Boolean;
    class function Move(const SourceFileName, DestFileName: string) : Boolean;
  end;

  TTextWriter = class
  public
    procedure Close; virtual; abstract;
    procedure Flush; virtual; abstract;
    procedure Write(Value: Boolean); overload; virtual; abstract;
    procedure Write(Value: Char); overload; virtual; abstract;
    procedure Write(Value: Double); overload; virtual; abstract;
    procedure Write(Value: Integer); overload; virtual; abstract;
    procedure Write(Value: Int64); overload; virtual; abstract;
    procedure Write(Value: TObject); overload; virtual; abstract;
    procedure Write(Value: Single); overload; virtual; abstract;
    procedure Write(const Value: string); overload; virtual; abstract;
    procedure Write(const aFormat: string; Args: array of const); overload; virtual; abstract;
    procedure WriteLine; overload; virtual; abstract;
    procedure WriteLine(Value: Boolean); overload; virtual; abstract;
    procedure WriteLine(Value: Char); overload; virtual; abstract;
    procedure WriteLine(Value: Double); overload; virtual; abstract;
    procedure WriteLine(Value: Integer); overload; virtual; abstract;
    procedure WriteLine(Value: Int64); overload; virtual; abstract;
    procedure WriteLine(Value: TObject); overload; virtual; abstract;
    procedure WriteLine(Value: Single); overload; virtual; abstract;
    procedure WriteLine(const Value: string); overload; virtual; abstract;
    procedure WriteLine(const aFormat: string; Args: array of const); overload; virtual; abstract;
  end;

  TStreamWriter = class(TTextWriter)
  private
    FStream: TStream;
    FEncoding: TEncoding;
    FNewLine: string;
    FAutoFlush: Boolean;
    FOwnsStream: Boolean;
    FBufferIndex: Integer;
    FBuffer: TBytes;
    procedure WriteBytes(Bytes: TBytes);
  public
    constructor Create(Stream: TStream); overload;
    constructor Create(Stream: TStream; Encoding: TEncoding; BufferSize: Integer = 4096); overload;
    constructor Create(const Filename: string; Append: Boolean = False); overload;
    constructor Create(const Filename: string; Append: Boolean; Encoding: TEncoding; BufferSize: Integer = 4096); overload;
    destructor Destroy; override;
    procedure Close; override;
    procedure Flush; override;
    procedure OwnStream; inline;
    procedure Write(Value: Boolean); override;
    procedure Write(Value: Char); override;
    procedure Write(Value: Double); override;
    procedure Write(Value: Integer); override;
    procedure Write(Value: Int64); override;
    procedure Write(Value: TObject); override;
    procedure Write(Value: Single); override;
    procedure Write(const Value: string); override;
    procedure Write(const aFormat: string; Args: array of const); override;
    procedure WriteLine; override;
    procedure WriteLine(Value: Boolean); override;
    procedure WriteLine(Value: Char); override;
    procedure WriteLine(Value: Double); override;
    procedure WriteLine(Value: Integer); override;
    procedure WriteLine(Value: Int64); override;
    procedure WriteLine(Value: TObject); override;
    procedure WriteLine(Value: Single); override;
    procedure WriteLine(const Value: string); override;
    procedure WriteLine(const aFormat: string; Args: array of const); override;
    property AutoFlush: Boolean read FAutoFlush write FAutoFlush;
    property NewLine: string read FNewLine write FNewLine;
    property Encoding: TEncoding read FEncoding;
    property BaseStream: TStream read FStream;
  end;
  {$ENDIF FPC}

  function CreateDummyFile(const aFilename : string; const aSize : Int64) : Boolean;
  procedure SplitFile(const aFileName : string; aSplitByteSize : Int64);
  procedure MergeFiles(const aFirstSplitFileName, aOutFileName : string); overload;
  procedure MergeFiles(aFilenames : array of string; const aOutFileName : string); overload;
  {$IFNDEF NEXTGEN}
  function IsFileInUse(const aFileName : string) : Boolean;
  {$ENDIF}
  procedure FileReplaceText(const aFileName, aSearchText, AReplaceText : string);
  {$IFNDEF NEXTGEN}
  function FileSearchText(const aFileName, SearchText: string; caseSensitive : Boolean): Longint;
  {$ENDIF}
  function GetCreationTime(const aFilename : string): TDateTime;
  function GetLastAccessTime(const aFileName: string): TDateTime;
  function GetLastWriteTime(const aFileName : string): TDateTime;
  {$IFDEF FPC}
  function FindDelimiter(const Delimiters, S: string; StartIdx: Integer = 1): Integer;
  {$ENDIF}
  function ConvertDateTimeToFileTime(const DateTime: TDateTime; const UseLocalTimeZone: Boolean): TFileTime;
  procedure SetDateTimeInfo(const Path: string; const CreationTime, LastAccessTime, LastWriteTime: PDateTime; const UseLocalTimeZone: Boolean);

implementation

{ TTextStreamFile }

{$IFNDEF FPC}
constructor TTextStreamFile.Create(const aFileName : string; aOpenMode : TTextFileOperation);
var
  Append : Boolean;
begin
  if aOpenMode = tfOpenRead then fReadStream := TStreamReader.Create(aFileName,True)
  else
  begin
    if aOpenMode = tfOpenAppend then Append := True
      else Append := False;
    fWriteStream := TStreamWriter.Create(aFileName,Append);
  end;
end;

destructor TTextStreamFile.Destroy;
begin
   if Assigned(fReadStream) then fReadStream.Free;
   if Assigned(fWriteStream) then fWriteStream.Free;
   inherited Destroy;
end;

function TTextStreamFile.ReadLn(out Data: string): Boolean;
begin
   Data := fReadStream.ReadLine;
   Result := Data <> '';
end;

function TTextStreamFile.ReadLn: string;
begin
   Result := fReadStream.ReadLine;
end;

procedure TTextStreamFile.WriteLn (const Data : string);
begin
  fWriteStream.WriteLine(Data);
end;

function TTextStreamFile.GetEOF : Boolean;
begin
  Result := fReadStream.EndOfStream;
end;

procedure TTextStreamFile.Close;
begin
  if Assigned(fReadStream) then fReadStream.Close;
  if Assigned(fWriteStream) then fWriteStream.Close;
end;

{$ENDIF NFPC}

{$IFDEF FPC}

{ EFileStreamError }

constructor EFileStreamError.Create(ResStringRec: PResStringRec;
  const FileName: string);
begin
  {$IFNDEF LINUX}
  inherited CreateResFmt(ResStringRec, [ExpandFileName(FileName), SysErrorMessage(GetLastError)]);
  {$ELSE}
  inherited CreateResFmt(ResStringRec, [ExpandFileName(FileName), SysErrorMessage(errno)]);
  {$ENDIF}
end;

{ TPath }

class function TPath.GetFileNameWithoutExtension(const FileName: string
  ): string;
var
  fname : string;
begin
  fname := ExtractFileName(FileName);
  Result := Copy(fname, 1, Length(fname) - Length(ExtractFileExt(fname)));
end;

class function TPath.ChangeExtension(const Path, NewExtension : string) : string;
var
  dot : string;
begin
  if NewExtension.Contains('.') then dot := ''
    else dot := '.';
  Result := TPath.GetFileNameWithoutExtension(Path) + dot + NewExtension;
end;

class function TPath.GetFileName(const aPath: string): string;
begin
  Result := ExtractFileName(aPath);
end;

class function TPath.GetDirectoryName(const FileName : string) : string;
begin
  Result := ExtractFileDir(Filename);
end;

class procedure TPath.CheckPathLength(const Path: string; const MaxLength: Integer);
begin
{$IFDEF MSWINDOWS}
  if (Length(Path) >= MaxLength) then
{$ENDIF MSWINDOWS}
{$IFDEF POSIX}
  if (Length(UTF8Encode(Path)) >= MaxLength) then
{$ENDIF POSIX}
    raise EPathTooLongException.CreateRes(@SPathTooLong);
end;

class function TPath.GetExtension(const Path : string) : string;
begin
  Result := ExtractFileExt(Path);
end;

class function TPath.EndsWithDelimiter(const aPath : string) : Boolean;
var
  c : Char;
begin
  if aPath = '' then Exit(False);
  c := aPath[High(aPath)];
  Result := (c = '\') or (c = '/');
end;

class function TPath.Combine(const aPath1, aPath2 : string) : string;
var
  delim : string;
begin
  delim := '';
  if aPath1.Contains('/') then delim := '/'
     else if aPath1.Contains('\') then delim := '\';
  if delim = '' then
  begin
    {$IFDEF LINUX}
    delim := '/';
    {$ELSE}
    delim := '\';
    {$ENDIF}
  end;
  if EndsWithDelimiter(aPath1) then
  begin
    if EndsWithDelimiter(aPath2) then Result := aPath1 + Copy(aPath2,2,aPath2.Length)
      else Result := aPath1 + aPath2;
  end
  else
  begin
    if EndsWithDelimiter(aPath2) then Result := aPath1 + aPath2
      else Result := aPath1 + delim + aPath2;
  end;
end;

{ TDirectory }

class function TDirectory.Exists(const Path: string; FollowLink: Boolean = True): Boolean;
begin
  Result := DirectoryExists(Path);
end;

class function TDirectory.GetDirectories(const Path : string) : TArray<string>;
var
  rec : TSearchRec;
begin
  if FindFirst(TPath.Combine(Path,'*'),faAnyFile and faDirectory,rec) = 0 then
  repeat
    if ((rec.Attr and faDirectory) = faDirectory) and (rec.Name <> '.') and (rec.Name <> '..') then
    begin
      Result := Result + [rec.Name];
    end;
  until FindNext(rec) <> 0;
  SysUtils.FindClose(rec);
end;

{ TFile }

class function TFile.Exists(const Path : string) : Boolean;
begin
  Result := FileExists(Path);
end;

class procedure TFile.SetCreationTime(const Path: string; const CreationTime: TDateTime);
begin
  SetDateTimeInfo(Path,@CreationTime,nil,nil,True);
end;

class procedure TFile.SetLastAccessTime(const Path: string; const LastAccessTime: TDateTime);
begin
  SetDateTimeInfo(Path,nil,@LastAccessTime,nil,True);
end;

class procedure TFile.SetLastWriteTime(const Path: string; const LastWriteTime: TDateTime);
begin
  SetDateTimeInfo(Path,nil,nil,@LastWriteTime,True);
end;

class function TFile.IsReadOnly(const Path : string) : Boolean;
begin
  Result := FileIsReadOnly(Path);
end;

class function TFile.Delete(const Path : string) : Boolean;
begin
  Result := DeleteFile(PChar(Path));
end;

class function TFile.Move(const SourceFileName, DestFileName: string) : Boolean;
begin
  {$IFNDEF LINUX}
  Result := MoveFile(PChar(SourceFileName),PChar(DestFileName));
  {$ELSE}
  Result := RenameFile(PChar(SourceFileName),PChar(DestFileName));
  {$ENDIF}
end;

{$IFNDEF NEXTGEN}
class function TFile.IsInUse(const Path : string) : Boolean;
begin
  Result := IsFileInUse(Path);
end;
{$ENDIF}

class function TFile.GetSize(const Path : string) : Int64;
var
  f : File of Byte;
begin
  Assign(f,Path);
  try
    Reset (f);
    Result := FileSize(f);
  finally
    CloseFile(f);
  end;
end;

class function TFile.GetExtension(const Path : string) : string;
begin
  Result := ExtractFileExt(Path);
end;

class function TFile.GetCreationTime(const Path : string) : TDateTime;
begin
  Result := Quick.Files.GetCreationTime(Path);
end;

class function TFile.GetLastAccessTime(const Path : string) : TDateTime;
begin
  Result := Quick.Files.GetLastAccessTime(Path);
end;

class function TFile.GetLastWriteTime(const Path : string) : TDateTime;
begin
  Result := Quick.Files.GetLastWriteTime(Path);
end;

class function TFile.Create(const Path: string; const BufferSize: Integer): TFileStream;
begin
  try
    Result := TFileStream.Create(Path,fmCreate);
  except
    on E: EFileStreamError do
      raise EInOutError.Create(E.Message);
  end;
end;

class function TFile.Create(const Path: string): TFileStream;
begin
  Result := Create(Path, 0);
end;

{ TStreamWriter }

procedure TStreamWriter.Close;
begin
  Flush;
  if FOwnsStream  then
    FreeAndNil(FStream);
end;

constructor TStreamWriter.Create(Stream: TStream);
begin
  inherited Create;
  FOwnsStream := False;
  FStream := Stream;
  FEncoding := TEncoding.UTF8;
  SetLength(FBuffer, 1024);
  FBufferIndex := 0;
  FNewLine := sLineBreak;
  FAutoFlush := True;
end;

constructor TStreamWriter.Create(Stream: TStream; Encoding: TEncoding; BufferSize: Integer);
begin
  inherited Create;
  FOwnsStream := False;
  FStream := Stream;
  FEncoding := Encoding;
  if BufferSize >= 128 then
    SetLength(FBuffer, BufferSize)
  else
    SetLength(FBuffer, 128);
  FBufferIndex := 0;
  FNewLine := sLineBreak;
  FAutoFlush := True;
  if Stream.Position = 0 then
    WriteBytes(FEncoding.GetPreamble);
end;

constructor TStreamWriter.Create(const Filename: string; Append: Boolean);
begin
  if (not FileExists(Filename)) or (not Append) then
    FStream := TFileStream.Create(Filename, fmCreate)
  else
  begin
    FStream := TFileStream.Create(Filename, fmOpenWrite);
    FStream.Seek(0, soEnd);
  end;
  Create(FStream);
  FOwnsStream := True;
end;

constructor TStreamWriter.Create(const Filename: string; Append: Boolean;
  Encoding: TEncoding; BufferSize: Integer);
begin
  if (not FileExists(Filename)) or (not Append) then
    FStream := TFileStream.Create(Filename, fmCreate)
  else
  begin
    FStream := TFileStream.Create(Filename, fmOpenWrite);
    FStream.Seek(0, soEnd);
  end;
  Create(FStream, Encoding, BufferSize);
  FOwnsStream := True;
end;

destructor TStreamWriter.Destroy;
begin
  Close;
  SetLength(FBuffer, 0);
  inherited;
end;

procedure TStreamWriter.Flush;
begin
  if FBufferIndex = 0 then
    Exit;
  if FStream = nil then
    Exit;

  FStream.Write(FBuffer[0], FBufferIndex);
  FBufferIndex := 0;
end;

procedure TStreamWriter.OwnStream;
begin
  FOwnsStream := True;
end;

procedure TStreamWriter.Write(const Value: string);
begin
  WriteBytes(FEncoding.GetBytes(Value));
end;

procedure TStreamWriter.WriteBytes(Bytes: TBytes);
var
  ByteIndex: Integer;
  WriteLen: Integer;
begin
  ByteIndex := 0;

  while ByteIndex < Length(Bytes) do
  begin
    WriteLen := Length(Bytes) - ByteIndex;
    if WriteLen > Length(FBuffer) - FBufferIndex then
      WriteLen := Length(FBuffer) - FBufferIndex;

    Move(Bytes[ByteIndex], FBuffer[FBufferIndex], WriteLen);

    Inc(FBufferIndex, WriteLen);
    Inc(ByteIndex, WriteLen);

    if FBufferIndex >= Length(FBuffer) then
      Flush;
  end;

  if FAutoFlush then
    Flush;
end;

procedure TStreamWriter.Write(const aFormat: string; Args: array of const);
begin
  WriteBytes(FEncoding.GetBytes(Format(aFormat, Args)));
end;

procedure TStreamWriter.Write(Value: Single);
begin
  WriteBytes(FEncoding.GetBytes(FloatToStr(Value)));
end;

procedure TStreamWriter.Write(Value: Double);
begin
  WriteBytes(FEncoding.GetBytes(FloatToStr(Value)));
end;

procedure TStreamWriter.Write(Value: Integer);
begin
  WriteBytes(FEncoding.GetBytes(IntToStr(Value)));
end;

procedure TStreamWriter.Write(Value: Char);
begin
  WriteBytes(FEncoding.GetBytes(Value));
end;

procedure TStreamWriter.Write(Value: TObject);
begin
  WriteBytes(FEncoding.GetBytes(Value.ToString));
end;

procedure TStreamWriter.Write(Value: Int64);
begin
  WriteBytes(FEncoding.GetBytes(IntToStr(Value)));
end;

procedure TStreamWriter.Write(Value: Boolean);
begin
  WriteBytes(FEncoding.GetBytes(BoolToStr(Value, True)));
end;

procedure TStreamWriter.WriteLine(Value: Double);
begin
  WriteBytes(FEncoding.GetBytes(FloatToStr(Value) + FNewLine));
end;

procedure TStreamWriter.WriteLine(Value: Integer);
begin
  WriteBytes(FEncoding.GetBytes(IntToStr(Value) + FNewLine));
end;

procedure TStreamWriter.WriteLine;
begin
  WriteBytes(FEncoding.GetBytes(FNewLine));
end;

procedure TStreamWriter.WriteLine(Value: Boolean);
begin
  WriteBytes(FEncoding.GetBytes(BoolToStr(Value, True) + FNewLine));
end;

procedure TStreamWriter.WriteLine(Value: Char);
begin
  WriteBytes(FEncoding.GetBytes(Value));
  WriteBytes(FEncoding.GetBytes(FNewLine));
end;

procedure TStreamWriter.WriteLine(Value: Int64);
begin
  WriteBytes(FEncoding.GetBytes(IntToStr(Value) + FNewLine));
end;

procedure TStreamWriter.WriteLine(const aFormat: string; Args: array of const);
begin
  WriteBytes(FEncoding.GetBytes(Format(aFormat, Args) + FNewLine));
end;

procedure TStreamWriter.WriteLine(Value: TObject);
begin
  WriteBytes(FEncoding.GetBytes(Value.ToString + FNewLine));
end;

procedure TStreamWriter.WriteLine(Value: Single);
begin
  WriteBytes(FEncoding.GetBytes(FloatToStr(Value) + FNewLine));
end;

procedure TStreamWriter.WriteLine(const Value: string);
begin
  WriteBytes(FEncoding.GetBytes(Value + FNewLine));
end;

{$ENDIF FPC}

{other functions}

function CreateDummyFile(const aFilename : string; const aSize : Int64 ) : Boolean;
var
  fs : TFileStream;
  i : Integer;
  buf : string;
Begin
  Result := False;
  fs := TFileStream.Create(aFilename,fmCreate);
  buf := 'A';
  try
    fs.Seek(0, soBeginning);
    for i := 0 to aSize do fs.Write(buf[1], Length(buf));
  finally
    fs.Free;
  end;
  Result := FileExists(aFilename);
End;

procedure SplitFile(const aFileName : string; aSplitByteSize : Int64);
var
  fs, ss: TFileStream;
  cnt : integer;
  splitname: string;
begin
   fs := TFileStream.Create(aFileName, fmOpenRead or fmShareDenyWrite) ;
   try
     for cnt := 1 to Trunc(fs.Size / aSplitByteSize) + 1 do
     begin
       splitname := ChangeFileExt(aFileName, Format('%s%.3d', ['.',cnt])) ;
       ss := TFileStream.Create(splitname, fmCreate or fmShareExclusive) ;
       try
         if fs.Size - fs.Position < aSplitByteSize then
           aSplitByteSize := fs.Size - fs.Position;
         ss.CopyFrom(fs, aSplitByteSize) ;
       finally
         ss.Free;
       end;
     end;
   finally
     fs.Free;
   end;
end;

procedure MergeFiles(const aFirstSplitFileName, aOutFileName : string);
var
  fs, ss: TFileStream;
  cnt: integer;
  splitfilename : string;
begin
   cnt := 1;
   splitfilename := aFirstSplitFileName;
   fs := TFileStream.Create(aOutFileName, fmCreate or fmShareExclusive) ;
   try
     while FileExists(splitfilename) do
     begin
       ss := TFileStream.Create(splitfilename, fmOpenRead or fmShareDenyWrite) ;
       try
         fs.CopyFrom(ss, 0) ;
       finally
         ss.Free;
       end;
       Inc(cnt) ;
       splitfilename := ChangeFileExt(aFirstSplitFileName, Format('%s%.3d', ['.',cnt])) ;
     end;
   finally
     fs.Free;
   end;
end;

procedure MergeFiles(aFilenames : array of string; const aOutFileName : string);
var
  filename : string;
  fs,
  ss : TFileStream;
begin
   fs := TFileStream.Create(aOutFileName,fmCreate or fmShareExclusive) ;
   try
     for filename in aFilenames do
     begin
       if not FileExists(filename) then raise Exception.CreateFmt('Merge file %s not found!',[filename]);
       ss := TFileStream.Create(filename, fmOpenRead or fmShareDenyWrite) ;
       try
         fs.CopyFrom(ss,0);
       finally
         ss.Free;
       end;
     end;
   finally
     fs.Free;
   end;
end;

function IsFileInUse(const aFileName : string) : Boolean;
{$IF NOT Defined(LINUX) AND NOT Defined(MACOS) AND NOT Defined(ANDROID)}
var
  HFileRes: HFILE;
begin
  Result := False;
  if not FileExists(aFileName) then Exit;
  try
   HFileRes := CreateFile(PChar(aFileName),
    GENERIC_READ or GENERIC_WRITE
    ,0
    ,nil
    ,OPEN_EXISTING
    ,FILE_ATTRIBUTE_NORMAL
    ,0);

   Result := (HFileRes = INVALID_HANDLE_VALUE);

   if not(Result) then begin
     CloseHandle(HFileRes);
   end;
  except
    Result := True;
  end;
end;
{$ELSE}
var
  fs : TFileStream;
begin
  try
    fs := TFileStream.Create(aFileName, fmOpenReadWrite, fmShareExclusive);
    Result := True;
    fs.Free;
  except
    Result := False;
  end;

end;
{$ENDIF}

procedure FileReplaceText(const aFileName, aSearchText, AReplaceText : string);
var
  fs: TFileStream;
  S: string;
begin
  fs := TFileStream.Create(aFileName, fmOpenread or fmShareDenyNone);
  try
    SetLength(S, fs.Size);
    fs.ReadBuffer(S[1], fs.Size);
  finally
    fs.Free;
  end;
  S  := StringReplace(S, aSearchText, AReplaceText, [rfReplaceAll, rfIgnoreCase]);
  fs := TFileStream.Create(aFileName, fmCreate);
  try
    fs.WriteBuffer(S[1], Length(S));
  finally
    fs.Free;
  end;
end;

{$IFNDEF NEXTGEN}
function FileSearchText(const aFileName, SearchText: string; caseSensitive : Boolean): Longint;
const
  BufferSize = $8001;
var
  pBuf, pEnd, pScan, pPos: PAnsiChar;
  filesize: LongInt;
  bytesRemaining: LongInt;
  bytesToRead: Integer;
  F: file;
  SearchFor: PAnsiChar;
  oldMode: Word;
begin
  Result := -1;
  if (Length(SearchText) = 0) or (Length(aFileName) = 0) then Exit;
  SearchFor := nil;
  pBuf      := nil;
  AssignFile(F, aFileName);
  oldMode  := FileMode;
  FileMode := 0;
  Reset(F, 1);
  FileMode := oldMode;
  try
    {$IFDEF FPC}
    SearchFor := PChar(StrAlloc(Length(SearchText) + 1));
    {$ELSE}
    {$IFDEF DELPHI2010_UP}
    SearchFor := PAnsiChar(StrAlloc(Length(SearchText) + 1));
    {$ELSE}
      SearchFor := StrAlloc(Length(SearchText) + 1);
    {$ENDIF}
    {$ENDIF FPC}
    StrPCopy(SearchFor, SearchText);
    {$IFDEF FPC}
    if not caseSensitive then UpperCase(SearchFor);
    {$ELSE}
    if not caseSensitive then AnsiUpperCase(SearchFor);
    {$ENDIF}
    GetMem(pBuf, BufferSize);
    filesize := System.Filesize(F);
    bytesRemaining := filesize;
    pPos := nil;
    while bytesRemaining > 0 do
    begin
      if bytesRemaining >= BufferSize then bytesToRead := Pred(BufferSize)
        else bytesToRead := bytesRemaining;
      BlockRead(F, pBuf^, bytesToRead, bytesToRead);
      pEnd := @pBuf[bytesToRead];
      pEnd^ := #0;
      pScan := pBuf;
      while pScan < pEnd do
      begin
        {$IFDEF FPC}
        if not caseSensitive then UpperCase(pScan);
        {$ELSE}
        if not caseSensitive then AnsiUpperCase(pScan);
        {$ENDIF}
        pPos := StrPos(pScan, SearchFor);
        if pPos <> nil then
        begin
          Result := FileSize - bytesRemaining +
            Longint(pPos) - Longint(pBuf);
          Break;
        end;
        pScan := StrEnd(pScan);
        Inc(pScan);
      end;
      if pPos <> nil then Break;
      bytesRemaining := bytesRemaining - bytesToRead;
      if bytesRemaining > 0 then
      begin
        Seek(F, FilePos(F) - Length(SearchText));
        bytesRemaining := bytesRemaining + Length(SearchText);
      end;
    end;
  finally
    CloseFile(F);
    if SearchFor <> nil then StrDispose(SearchFor);
    if pBuf <> nil then FreeMem(pBuf, BufferSize);
  end;
end;
{$ENDIF}

{$IFDEF MSWINDOWS}
function GetLastAccessTime(const aFileName: string): TDateTime;
var
  ffd: TWin32FindData;
  dft: DWORD;
  lft: TFileTime;
  h:   THandle;
begin
  {$IFDEF FPC}
  h := FindFirstFile(PAnsiChar(aFileName), ffd);
  {$ELSE}
  h := FindFirstFile(PChar(aFileName), ffd);
  {$ENDIF}
  if (INVALID_HANDLE_VALUE <> h) then
  begin
    FindClose(h);
    FileTimeToLocalFileTime(ffd.ftLastAccessTime, lft);
    FileTimeToDosDateTime(lft, LongRec(dft).Hi, LongRec(dft).Lo);
    Result := FileDateToDateTime(dft);
  end;
end;

function GetCreationTime(const aFilename : string): TDateTime;
var
  ffd: TWin32FindData;
  dft: DWORD;
  lft: TFileTime;
  h:   THandle;
begin
  {$IFDEF FPC}
  h := FindFirstFile(PAnsiChar(aFileName), ffd);
  {$ELSE}
  h := FindFirstFile(PChar(aFileName), ffd);
  {$ENDIF}
  if (INVALID_HANDLE_VALUE <> h) then
  begin
    FindClose(h);
    FileTimeToLocalFileTime(ffd.ftCreationTime, lft);
    FileTimeToDosDateTime(lft, LongRec(dft).Hi, LongRec(dft).Lo);
    Result := FileDateToDateTime(dft);
  end;
end;

function GetLastWriteTime(const aFileName : string): TDateTime;
var
  ffd: TWin32FindData;
  dft: DWORD;
  lft: TFileTime;
  h:   THandle;
begin
  {$IFDEF FPC}
  h := FindFirstFile(PAnsiChar(aFileName), ffd);
  {$ELSE}
  h := FindFirstFile(PChar(aFileName), ffd);
  {$ENDIF}
  if (INVALID_HANDLE_VALUE <> h) then
  begin
    FindClose(h);
    FileTimeToLocalFileTime(ffd.ftLastWriteTime, lft);
    FileTimeToDosDateTime(lft, LongRec(dft).Hi, LongRec(dft).Lo);
    Result := FileDateToDateTime(dft);
  end;
end;
{$ELSE}
  {$IFDEF FPC} //FPC Linux
  function GetLastAccessTime(const aFileName: string): TDateTime;
  var
    info : stat;
  begin
    Result := 0;
    if fpstat(aFileName,info) <> 0 then
    begin
      Result := info.st_atime;
    end;
  end;

  function GetCreationTime(const aFilename : string): TDateTime;
  var
    info : stat;
  begin
    Result := 0;
    if fpstat(aFileName,info) <> 0 then
    begin
      Result := info.st_ctime;
    end;
  end;

  function GetLastWriteTime(const aFileName : string): TDateTime;
  var
    info : stat;
  begin
    Result := 0;
    if fpstat(aFileName,info) <> 0 then
    begin
      Result := info.st_mtime;
    end;
  end;
  {$ELSE} //Delphi Nextgen & Linux
  function GetLastAccessTime(const aFileName: string): TDateTime;
  var
    info : TDateTimeInfoRec;
  begin
    if FileGetDateTimeInfo(aFileName,info,True) then Result := info.LastAccessTime
      else Result := 0.0;
  end;

  function GetCreationTime(const aFilename : string): TDateTime;
   var
    info : TDateTimeInfoRec;
  begin
    if FileGetDateTimeInfo(aFileName,info,True) then Result := info.CreationTime
      else Result := 0.0;
  end;

  function GetLastWriteTime(const aFileName : string): TDateTime;
   var
    info : TDateTimeInfoRec;
  begin
    if FileGetDateTimeInfo(aFileName,info,True) then Result := info.TimeStamp
      else Result := 0.0;
  end;
  {$ENDIF}
{$ENDIF}

{$IFDEF FPC}
function FindDelimiter(const Delimiters, S: string; StartIdx: Integer = 1): Integer;
var
  Stop: Boolean;
  Len: Integer;
begin
  Result := 0;

  Len := S.Length;
  Stop := False;
  while (not Stop) and (StartIdx <= Len) do
    if IsDelimiter(Delimiters, S, StartIdx) then
    begin
      Result := StartIdx;
      Stop := True;
    end
    else
      Inc(StartIdx);
end;
{$ENDIF}

{$IFDEF MSWINDOWS}
function ConvertDateTimeToFileTime(const DateTime: TDateTime; const UseLocalTimeZone: Boolean): TFileTime;
var
  LFileTime: TFileTime;
  SysTime: TSystemTime;
begin
  Result.dwLowDateTime := 0;
  Result.dwLowDateTime := 0;
  DecodeDateTime(DateTime, SysTime.wYear, SysTime.wMonth, SysTime.wDay,
    SysTime.wHour, SysTime.wMinute, SysTime.wSecond, SysTime.wMilliseconds);

  if SystemTimeToFileTime(SysTime, LFileTime) then
    if UseLocalTimeZone then
      LocalFileTimeToFileTime(LFileTime, Result)
    else
      Result := LFileTime;
end;
{$ENDIF}
{$If Defined(FPC) AND Defined(LINUX)}
function ConvertDateTimeToFileTime(const DateTime: TDateTime; const UseLocalTimeZone: Boolean): TFileTime;
begin
  { Use the time zone if necessary }
  if not UseLocalTimeZone then
    Result := DateTimeToFileDate(DateTime)
  else
    Result := DateTimeToFileDate(DateTime);
end;
{$ENDIF}
{$IFDEF POSIX}
function ConvertDateTimeToFileTime(const DateTime: TDateTime; const UseLocalTimeZone: Boolean): TFileTime;
begin
  { Use the time zone if necessary }
  if not UseLocalTimeZone then
    Result := DateTimeToFileDate(TTimeZone.Local.ToLocalTime(DateTime))
  else
    Result := DateTimeToFileDate(DateTime);
end;
{$ENDIF}

procedure SetDateTimeInfo(const Path: string; const CreationTime, LastAccessTime, LastWriteTime: PDateTime; const UseLocalTimeZone: Boolean);
{$IFDEF MSWINDOWS}
var
  LFileHnd: THandle;
  LFileAttr: Cardinal;
  LFileCreationTime: PFileTime;
  LFileLastAccessTime: PFileTime;
  LFileLastWriteTime: PFileTime;
begin
  // establish what date-times must be set to the directory
  LFileHnd := 0;
  LFileCreationTime := nil;
  LFileLastAccessTime := nil;
  LFileLastWriteTime := nil;

  try
    try
      if Assigned(CreationTime) then
      begin
        New(LFileCreationTime);
        LFileCreationTime^ := ConvertDateTimeToFileTime(CreationTime^, UseLocalTimeZone);
      end;
      if Assigned(LastAccessTime) then
      begin
        New(LFileLastAccessTime);
        LFileLastAccessTime^ := ConvertDateTimeToFileTime(LastAccessTime^, UseLocalTimeZone);
      end;
      if Assigned(LastWriteTime) then
      begin
        New(LFileLastWriteTime);
        LFileLastWriteTime^ := ConvertDateTimeToFileTime(LastWriteTime^, UseLocalTimeZone);
      end;

      // determine if Path points to a directory or a file
      SetLastError(ERROR_SUCCESS);
      LFileAttr := FileGetAttr(Path);
      if LFileAttr and faDirectory <> 0 then
        LFileAttr := FILE_FLAG_BACKUP_SEMANTICS
      else
        LFileAttr := FILE_ATTRIBUTE_NORMAL;

      // set the new date-times to the directory or file
      LFileHnd := CreateFile(PChar(Path), GENERIC_WRITE, FILE_SHARE_WRITE, nil,
        OPEN_EXISTING, LFileAttr, 0);

      if LFileHnd <> INVALID_HANDLE_VALUE then
        SetFileTime(LFileHnd, LFileCreationTime, LFileLastAccessTime, LFileLastWriteTime);
    except
      on E: EConvertError do
        raise EArgumentOutOfRangeException.Create(E.Message);
    end;
  finally
    CloseHandle(LFileHnd);
    SetLastError(ERROR_SUCCESS);

    Dispose(LFileCreationTime);
    Dispose(LFileLastAccessTime);
    Dispose(LFileLastWriteTime);
  end;
end;
{$ENDIF}
{$IFDEF POSIX}
var
  LFileName: Pointer;
  LStatBuf: _stat;
  LBuf: utimbuf;
  ErrCode: Integer;
  M: TMarshaller;
begin
  { Do nothing if no date/time passed. Ignore CreationTime. Unixes do not support creation times for files. }
  if (LastAccessTime = nil) and (LastWriteTime = nil) then
    Exit;

  LFileName := M.AsAnsi(Path, CP_UTF8).ToPointer;

  { Obtain the file times. lstat may fail }
  if ((LastAccessTime = nil) or (LastWriteTime = nil)) then
  begin
    ErrCode := stat(LFileName, LStatBuf);

    { Fail if we can't access the file properly }
    if ErrCode <> 0 then
      Exit; // Fail here prematurely. Do not chnage file times if we failed to fetch the old ones.
  end;

  try
    { Preserve of set the new value }
    if LastAccessTime <> nil then
      LBuf.actime := ConvertDateTimeToFileTime(LastAccessTime^, UseLocalTimeZone)
    else
      LBuf.actime := LStatBuf.st_atime;

    { Preserve of set the new value }
    if LastWriteTime <> nil then
      LBuf.modtime := ConvertDateTimeToFileTime(LastWriteTime^, UseLocalTimeZone)
    else
      LBuf.modtime := LStatBuf.st_mtime;

    { Call utime to set the file times }
    utime(LFileName, LBuf);
  except
    on E: EConvertError do // May rise in ConvertDateTimeToFileTime
      raise EArgumentOutOfRangeException.Create(E.Message);
  end;
end;
{$ENDIF}
{$if Defined(FPC) AND Defined(LINUX)}
begin
end;
{$ENDIF}

end.