KngStr 3 жил өмнө
parent
commit
24a8939ef4
1 өөрчлөгдсөн 418 нэмэгдсэн , 0 устгасан
  1. 418 0
      Source/ksIOUtils.pas

+ 418 - 0
Source/ksIOUtils.pas

@@ -0,0 +1,418 @@
+{*******************************************************}
+{                                                       }
+{       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;
+
+implementation
+
+uses
+  System.StrUtils;
+
+{ 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.