KsLibs/Source/ksIOUtils.pas

{*******************************************************}
{                                                       }
{       Methods of IO                                   }
{                                                       }
{       CopyRight (C) 2018-2020 KngStr                  }
{                                                       }
{*******************************************************}

unit ksIOUtils;

{$SCOPEDENUMS ON}

interface

uses
{$IFDEF MSWINDOWS}
  Winapi.Windows,
{$ENDIF}
{$IFDEF POSIX}
  Posix.SysTypes, Posix.Errno, Posix.Unistd,
{$ENDIF}
{$IFDEF MACOS}
{$IFDEF IOS}
  iOSApi.Foundation,
{$ELSE !IOS}
  Macapi.CocoaTypes,
{$ENDIF IOS}
{$ENDIF MACOS}
  System.RTLConsts, System.SysUtils, System.Classes, System.Types, System.Masks,
  System.IOUtils;

type
  TDirectoryEx = record
  public
    type
      TActionResult = (Accept, Skip, SkipAll, Stop);
      TFilterPredicate = reference to function(const Path: string;
          const SearchRec: TSearchRec): TActionResult;
      TDirectoryWalkProc = reference to function (const Path: string;
          const FileInfo: TSearchRec): TActionResult;
  private
    class procedure InternalCheckDirPathParam(const Path: string;
        const ExistsCheck: Boolean); static;
    class procedure CheckGetFilesParameters(Path: string;
        const SearchPattern: string); static;

    class function DoGetFiles(const Path, SearchPattern: string;
        const SearchOption: TSearchOption;
        const Predicate: TFilterPredicate;
        PreCallback: TDirectoryWalkProc = nil): TStringDynArray; static;

    class procedure WalkThroughDirectory(const Path, Pattern: string;
        const PreCallback, PostCallback: TDirectoryWalkProc;
        const Recursive: Boolean); static;
  public
    class function GetFiles(const Path: string): TStringDynArray;
        overload; inline; static;
    class function GetFiles(const Path: string;
        const Predicate: TFilterPredicate): TStringDynArray;
        overload; inline; static;
    class function GetFiles(const Path, SearchPattern: string): TStringDynArray;
        overload; inline; static;
    class function GetFiles(const Path, SearchPattern: string;
        const Predicate: TFilterPredicate): TStringDynArray;
        overload; inline; static;
    class function GetFiles(const Path, SearchPattern: string;
        const SearchOption: TSearchOption): TStringDynArray; overload; static;
    class function GetFiles(const Path, SearchPattern: string;
        const SearchOption: TSearchOption;
        const Predicate: TFilterPredicate): TStringDynArray; overload; static;
    class function GetFiles(const Path: string;
        const SearchOption: TSearchOption;
        const Predicate: TFilterPredicate): TStringDynArray; overload; static;
    class function GetFiles(const Path: string;
        PreCallback: TDirectoryWalkProc): TStringDynArray; overload; static;
    class function GetFiles(const Path: string;
        const Predicate: TFilterPredicate;
        PreCallback: TDirectoryWalkProc): TStringDynArray; overload; static;
    class function GetFiles(const Path: string;
        const SearchOption: TSearchOption;
        const Predicate: TFilterPredicate;
        PreCallback: TDirectoryWalkProc): TStringDynArray; overload; static;
    class function GetFiles(const Path, SearchPattern: string;
        const SearchOption: TSearchOption;
        const Predicate: TFilterPredicate;
        PreCallback: TDirectoryWalkProc): TStringDynArray; overload; static;
  end;

  TPathEx = record
  public
    const
      FCCurrentDir: string = '.'; // DO NOT LOCALIZE
      FCParentDir: string = '..'; // DO NOT LOCALIZE
      FCExtendedPrefix: string = '\\?\'; // DO NOT LOCALIZE
      FCExtendedUNCPrefix: string = '\\?\UNC\'; // DO NOT LOCALIZE
  private
    class procedure CheckPathLength(const Path: string; const MaxLength: Integer); static;
    class function DoCombine(const Path1, Path2: string;
        const ValidateParams: Boolean): string; static;
    class function DoGetFullPath(const Path: string): string; static;
    class function DoMatchesPattern(const FileName, Pattern: string): Boolean; inline; static;
    {$IFDEF MSWINDOWS}
    class function HasPathValidColon(const Path: string): Boolean; static;
    {$ENDIF MSWINDOWS}
    {$IFDEF MSWINDOWS}
    class function GetPosAfterExtendedPrefix(const Path: string): Integer;
        overload; inline; static;
    class function GetPosAfterExtendedPrefix(const Path: string;
        out Prefix: TPathPrefixType): Integer; overload; static;
    {$ENDIF MSWINDOWS}
    class function GetExtendedPrefix(const Path: string): TPathPrefixType; static;
  end;

  TFileEx = record
  private
    const
      FCMinFileNameLen = 12;
  end;

/// <summary>
/// load bak file if exist to avoid error file
/// </summary>
procedure SafeLoadFile(AFile: string; ACallback: TProc; ABakExt: string = '.bak');
/// <summary>
/// use bak file if exist to avoid error file
/// </summary>
procedure SafeSaveFile(AFile: string; ACallback: TProc; ABakExt: string = '.bak');

implementation

uses
  System.StrUtils;

procedure SafeLoadFile(AFile: string; ACallback: TProc; ABakExt: string);
var
  LFile: string;
begin
  LFile := AFile + ABakExt;
  if FileExists(LFile) then begin
    if FileExists(AFile) then
      DeleteFile(AFile);
    RenameFile(LFile, AFile);
  end;
  if FileExists(AFile) then
    ACallback;
end;

procedure SafeSaveFile(AFile: string; ACallback: TProc; ABakExt: string);
var
  LFile: string;
begin
  LFile := AFile + ABakExt;
  if FileExists(LFile) then
    DeleteFile(LFile);
  if (not FileExists(AFile)) or (not RenameFile(AFile, LFile)) then
    LFile := '';
  ACallback;
  if LFile <> '' then
    DeleteFile(LFile);
end;

{ TDirectoryEx }

class procedure TDirectoryEx.CheckGetFilesParameters(Path: string;
  const SearchPattern: string);
begin
  Path := TPathEx.DoGetFullPath(Path);

  if Trim(SearchPattern) = '' then // DO NOT LOCALIZE
    raise EArgumentException.CreateRes(@SInvalidCharsInSearchPattern);
  if not TPath.HasValidFileNameChars(SearchPattern, True) then
    raise EArgumentException.CreateRes(@SInvalidCharsInSearchPattern);

  InternalCheckDirPathParam(Path, True);
end;

class function TDirectoryEx.DoGetFiles(const Path, SearchPattern: string;
  const SearchOption: TSearchOption;
  const Predicate: TFilterPredicate;
  PreCallback: TDirectoryWalkProc): TStringDynArray;
var
  ResultArray: TStringDynArray;
  LPreCallback: TDirectoryWalkProc;
begin
  ResultArray := nil;

  LPreCallback :=
    function (const Path: string; const FileInfo: TSearchRec): TActionResult
    var
      CanAdd: Boolean;
      FIsDir: Boolean;
    begin
      Result := TActionResult.Accept;
      CanAdd := False;
      FIsDir := FileInfo.Attr and System.SysUtils.faDirectory <> 0;

      if FIsDir and ((FileInfo.Name = TPathEx.FCCurrentDir) or
        (FileInfo.Name = TPathEx.FCParentDir)) then
        Exit(TDirectoryEx.TActionResult.Skip);

      if Assigned (PreCallback) then
        Result := PreCallback(Path, FileInfo)
      else if (not FIsDir) and Assigned(Predicate) then
        Result := Predicate(Path, FileInfo);
      if (Result = TActionResult.Accept) and not FIsDir then
        CanAdd := True;

      if CanAdd then begin
        SetLength(ResultArray, Length(ResultArray) + 1);
        ResultArray[Length(ResultArray) - 1] := TPathEx.DoCombine(Path, FileInfo.Name, False);
      end;
    end;

  WalkThroughDirectory(Path, SearchPattern, LPreCallback, nil,
    SearchOption = TSearchOption.soAllDirectories);

{$IFDEF LINUX}
  TArray.Sort<string>(ResultArray);
{$ENDIF}
  Result := ResultArray;
end;

class function TDirectoryEx.GetFiles(const Path: string): TStringDynArray;
begin
  Result := GetFiles(Path, '*', TSearchOption.soTopDirectoryOnly); // DO NOT LOCALIZE
end;

class function TDirectoryEx.GetFiles(const Path,
  SearchPattern: string): TStringDynArray;
begin
  Result := GetFiles(Path, SearchPattern, TSearchOption.soTopDirectoryOnly);
end;

class function TDirectoryEx.GetFiles(const Path, SearchPattern: string;
  const SearchOption: TSearchOption): TStringDynArray;
begin
  Result := GetFiles(Path, SearchPattern, SearchOption, nil);
end;

class function TDirectoryEx.GetFiles(const Path: string;
  const SearchOption: TSearchOption;
  const Predicate: TFilterPredicate): TStringDynArray;
begin
  Result := GetFiles(Path, '*', SearchOption, Predicate); // DO NOT LOCALIZE
end;

class function TDirectoryEx.GetFiles(const Path: string;
  const Predicate: TFilterPredicate): TStringDynArray;
begin
  Result := GetFiles(Path, '*', TSearchOption.soTopDirectoryOnly, Predicate); // DO NOT LOCALIZE
end;

class function TDirectoryEx.GetFiles(const Path, SearchPattern: string;
  const Predicate: TFilterPredicate): TStringDynArray;
begin
  Result := GetFiles(Path, SearchPattern, TSearchOption.soTopDirectoryOnly, Predicate);
end;

class function TDirectoryEx.GetFiles(const Path, SearchPattern: string;
  const SearchOption: TSearchOption;
  const Predicate: TFilterPredicate): TStringDynArray;
begin
  Result := GetFiles(Path, SearchPattern, SearchOption, Predicate, nil);
end;

class function TDirectoryEx.GetFiles(const Path: string;
  PreCallback: TDirectoryWalkProc): TStringDynArray;
begin
  Result := GetFiles(Path, '*', TSearchOption.soTopDirectoryOnly, nil, PreCallback); // DO NOT LOCALIZE
end;

class function TDirectoryEx.GetFiles(const Path: string;
  const Predicate: TFilterPredicate;
  PreCallback: TDirectoryWalkProc): TStringDynArray;
begin
  Result := GetFiles(Path, '*', TSearchOption.soTopDirectoryOnly, Predicate, PreCallback); // DO NOT LOCALIZE
end;

class function TDirectoryEx.GetFiles(const Path: string;
  const SearchOption: TSearchOption; const Predicate: TFilterPredicate;
  PreCallback: TDirectoryWalkProc): TStringDynArray;
begin
  Result := GetFiles(Path, '*', SearchOption, Predicate, PreCallback); // DO NOT LOCALIZE
end;

class function TDirectoryEx.GetFiles(const Path, SearchPattern: string;
  const SearchOption: TSearchOption; const Predicate: TFilterPredicate;
  PreCallback: TDirectoryWalkProc): TStringDynArray;
begin
  CheckGetFilesParameters(Path, SearchPattern);

  Result := DoGetFiles(Path, SearchPattern, SearchOption, Predicate, PreCallback);
end;

class procedure TDirectoryEx.InternalCheckDirPathParam(const Path: string;
  const ExistsCheck: Boolean);
begin
  TPathEx.CheckPathLength(Path, MAX_PATH {$IFDEF MSWINDOWS}- TFileEx.FCMinFileNameLen{$ENDIF});
{$IFDEF MSWINDOWS}
  { Windows-only: Check for valid colon char in the path }
  if not TPathEx.HasPathValidColon(Path) then
    raise ENotSupportedException.CreateRes(@SPathFormatNotSupported);
{$ENDIF MSWINDOWS}

  if Trim(Path) = '' then // DO NOT LOCALIZE
    raise EArgumentException.CreateRes(@SInvalidCharsInPath);
  if not TPath.HasValidPathChars(Path, False) then
    raise EArgumentException.CreateRes(@SInvalidCharsInPath);
  if ExistsCheck and (not TDirectory.Exists(Path)) then
    raise EDirectoryNotFoundException.CreateRes(@SPathNotFound);
end;

class procedure TDirectoryEx.WalkThroughDirectory(const Path, Pattern: string;
  const PreCallback, PostCallback: TDirectoryWalkProc;
  const Recursive: Boolean);
var
  SearchRec: TSearchRec;
  Match: Boolean;
  Stop: Boolean;
begin
  if FindFirst(TPathEx.DoCombine(Path, '*', False), faAnyFile, SearchRec) = 0 then // DO NOT LOCALIZE
  try
    Stop := False;

    repeat
      Match := TPathEx.DoMatchesPattern(SearchRec.Name, Pattern);

      // call the preorder callback method
      if Match and Assigned(PreCallback) then begin
        case PreCallback(Path, SearchRec) of
          TActionResult.Skip: Continue;
          TActionResult.SkipAll: Break;
          TActionResult.Stop: Stop := True;
        end;
      end;

      if not Stop then
      begin
        // go recursive in subdirectories
        if Recursive and (SearchRec.Attr and System.SysUtils.faDirectory <> 0) and
           (SearchRec.Name <> TPathEx.FCCurrentDir) and
           (SearchRec.Name <> TPathEx.FCParentDir) then
          WalkThroughDirectory(TPathEx.DoCombine(Path, SearchRec.Name, False),
            Pattern, PreCallback, PostCallback, Recursive);

        // call the post-order callback method
        if Match and Assigned(PostCallback) then begin
          case PostCallback(Path, SearchRec) of
            TActionResult.Skip: Continue;
            TActionResult.SkipAll: Break;
            TActionResult.Stop: Stop := True;
          end;
        end;
      end;
    until Stop or (FindNext(SearchRec) <> 0);
  finally
    FindClose(SearchRec);
  end;
end;

{ TPathEx }

class procedure TPathEx.CheckPathLength(const Path: string;
  const MaxLength: Integer);
begin
{$IFDEF MSWINDOWS}
  if (Length(Path) >= MaxLength) and (not TPath.IsExtendedPrefixed(Path)) then // Check the length in Chars on Win32
{$ENDIF MSWINDOWS}
{$IFDEF POSIX}
  if (Length(UTF8Encode(Path)) >= MaxLength) then // Check the length in bytes on POSIX
{$ENDIF POSIX}
    raise EPathTooLongException.CreateRes(@SPathTooLong);
end;

class function TPathEx.DoCombine(const Path1, Path2: string;
  const ValidateParams: Boolean): string;
begin
  { TODO -oAdministrator -c : not complete 2021-02-14 13:50:46 }
  Result := TPath.Combine(Path1, Path2);
end;

class function TPathEx.DoGetFullPath(const Path: string): string;
begin
  { TODO -oAdministrator -c : not complete 2021-02-14 13:50:46 }
  Result := TPath.GetFullPath(Path);
end;

class function TPathEx.DoMatchesPattern(const FileName,
  Pattern: string): Boolean;
begin
  { TODO -oAdministrator -c : not complete 2021-02-14 13:50:46 }
  Result := TPath.MatchesPattern(FileName, Pattern, True);
end;

class function TPathEx.GetExtendedPrefix(const Path: string): TPathPrefixType;
{$IFDEF MSWINDOWS}
begin
  Result := TPathPrefixType.pptNoPrefix;
  if Path <> '' then
  begin
    if Path.StartsWith(FCExtendedUNCPrefix) then
      Result := TPathPrefixType.pptExtendedUNC
    else
      if Path.StartsWith(FCExtendedPrefix) then
        Result := TPathPrefixType.pptExtended;
  end;
end;
{$ENDIF MSWINDOWS}
{$IFDEF POSIX}
begin
  Result := TPathPrefixType.pptNoPrefix;  // No support for extended prefixes on Unixes
end;
{$ENDIF POSIX}

{$IFDEF MSWINDOWS}
class function TPathEx.GetPosAfterExtendedPrefix(const Path: string;
  out Prefix: TPathPrefixType): Integer;
begin
  Prefix := GetExtendedPrefix(Path);
  case Prefix of
    TPathPrefixType.pptNoPrefix:
      Result := 1;
    TPathPrefixType.pptExtended:
      Result := Length(FCExtendedPrefix) + 1;
    TPathPrefixType.pptExtendedUNC:
      Result := Length(FCExtendedUNCPrefix) + 1;
  else
    Result := 1;
  end;
end;

class function TPathEx.GetPosAfterExtendedPrefix(const Path: string): Integer;
var
  Prefix: TPathPrefixType;
begin
  Result := GetPosAfterExtendedPrefix(Path, Prefix);
end;

class function TPathEx.HasPathValidColon(const Path: string): Boolean;
var
  StartIdx: Integer;
begin
  Result := True;
  if Trim(Path) <> '' then // DO NOT LOCALIZE
  begin
    StartIdx := GetPosAfterExtendedPrefix(Path);
    if TPath.IsDriveRooted(Path) then
      Inc(StartIdx, 2);

    Result := PosEx(TPath.VolumeSeparatorChar, Path, StartIdx) = 0;
  end;
end;
{$ENDIF MSWINDOWS}

end.