* TPath.Combine rework by Bart B. Fixes issue #40513

packages/vcl-compat/src/system.ioutils.pp

@@ -185,7 +185,10 @@ type
     class function DriveExists(const aPath: string): Boolean;
     class function MatchesPattern(const FileName, Pattern: string; const CaseSensitive: Boolean): Boolean;
     class function ChangeExtension(const aPath, Extension: string): string;
-    class function Combine(const Path1, Path2: string): string;
+    class function Combine(const Path1, Path2: string; const ValidateParams: Boolean = True): string;
+    class function Combine(const Path1, Path2, Path3: string; const ValidateParams: Boolean = True): string;
+    class function Combine(const Path1, Path2, Path3, Path4: string; const ValidateParams: Boolean = True): string;
+    class function Combine(const Paths: array of string; const ValidateParams: Boolean = True): string;
     class function GetDirectoryName(FileName: string): string;
     class function GetExtension(const FileName: string): string;
     class function GetFileName(const FileName: string): string;
@@ -866,7 +869,7 @@ begin
   Result:=ChangeFileExt(aPath, Extension);
 end;
 
-class function TPath.Combine(const Path1, Path2: string): string;
+class function TPath.Combine(const Path1, Path2: string; const ValidateParams : Boolean = True): string;
 begin
   if (Path1='') or (Path2='') then
     begin
@@ -878,13 +881,61 @@ begin
   else
     begin
     if not TPath.HasValidPathChars(Path1,False) then
-      Raise EArgumentException.CreateFmt('Path %s has invalid characters',[Path1]);
+      Raise EArgumentException.CreateFmt(SErrInvalidCharsInPath,[Path1]);
     if not TPath.HasValidPathChars(Path2,False) then
-      Raise EArgumentException.CreateFmt('Path %s has invalid characters',[Path2]);
+      Raise EArgumentException.CreateFmt(SErrInvalidCharsInPath,[Path2]);
     Result:=ConcatPaths([Path1, Path2]);
     end;
 end;
 
+class function TPath.Combine(const Path1, Path2, Path3 : string; const ValidateParams : Boolean = True): string;
+
+begin
+  Result:=Combine([Path1,Path2,Path3],ValidateParams);
+end;
+
+class function TPath.Combine(const Path1, Path2, Path3,Path4 : string; const ValidateParams : Boolean = True): string;
+
+begin
+  Result:=Combine([Path1,Path2,Path3,Path4],ValidateParams);
+end;
+
+class function TPath.Combine(const Paths: array of string; const ValidateParams: Boolean = True): string;
+  function AppendPathDelim(const Path: string): string;
+  begin
+    if (Path = '') or (Path[Length(Path)] in AllowDirectorySeparators)
+    {$ifdef mswindows}
+      //don't add a PathDelim to e.g. 'C:'
+      or ((Length(Path) = 2) and (Path[2] = ':') and (UpCase(Path[1]) in ['A'..'Z']))
+    {$endif}
+    then
+      Result:=Path
+    else
+      Result:=Path + DirectorySeparator;
+  end;
+var
+  i: Integer;
+  Path: String;
+begin
+  if ValidateParams then
+    for i := Low(Paths) to High(Paths) do
+      if not TPath.HasValidPathChars(Paths[i], False) then
+        Raise EInOutArgumentException.CreateFmt(SErrInvalidCharsInPath,[Paths[i]],Path[i]);
+  Result := '';
+  for i := High(Paths) downto Low(Paths) do
+  begin
+    Path := Paths[i];
+    if (Path <> '') then
+    begin
+      if (Result <> '') then
+        Path := AppendPathDelim(Path);
+      Result := Path + Result;
+      if not TPath.IsRelativePath(Result) then
+        Exit;
+    end;
+  end;
+end;
+
 class function TPath.GetDirectoryName(FileName: string): string;
 begin
   Result:=ExcludeTrailingPathDelimiter(ExtractFileDir(FileName));

packages/vcl-compat/tests/tciotuils.pas

@@ -41,6 +41,7 @@ type
     Procedure TestMatchesPattern;
     Procedure TestChangeExtension;
     Procedure TestCombine;
+    Procedure TestCombineMulti;
     Procedure TestGetDirectoryName;
     Procedure TestGetExtension;
     Procedure TestGetFileName;
@@ -390,6 +391,80 @@ begin
   TestIt('/path/a.doc','/path/','a.doc');
 end;
 
+procedure TTestTPath.TestCombineMulti;
+
+  procedure DoTest(const Paths: array of String; Validate: Boolean; Expected: string; ExceptionExpected: Boolean=False);
+
+    function ArgsToStr: string;
+    var
+      i: Integer;
+    begin
+      Result := '';
+      for i := Low(Paths) to High(Paths) do
+        Result := Result+''''+Paths[i] + ''',';
+      if (Result <> '') then SetLength(Result, Length(Result)-1);
+      Result := '['+Result+']';
+    end;
+
+  var
+    Res,FailMsg: String;
+    P : Array of string;
+    I : Integer;
+
+  begin
+    FailMsg:='';
+    try
+      SetLength(P,Length(Paths));
+      for I:=0 to Length(Paths)-1 do
+        begin
+        P[i]:=Paths[i];
+        DoDirSeparators(P[i]);
+        end;
+      DoDirSeparators(Expected);
+      Res := TPath.Combine(P,Validate);
+      AssertEquals(ArgsToStr,Expected,Res)
+    except
+      on E: Exception do
+        if not ExceptionExpected then
+          FailMsg:=Format('%s : an unexpected exception %s occurred: %s',[ArgsToStr,E.ClassName,E.Message])
+    end;
+    if FailMsg<>'' then
+      Fail(FailMsg);
+  end;
+
+  var
+    S: String;
+
+begin
+  //EInOutError
+  DoTest([''],True,'');
+  DoTest(['',''],True,'');
+  DoTest(['','',''],True,'');
+  DoTest(['a','b','c'],True,'a\b\c');
+  DoTest(['a','b','\c'],True,'\c');
+  DoTest(['a','\b','c'],True,'\b\c');
+  DoTest(['\a','\b','c'],True,'\b\c');
+  DoTest(['\a','\b','\c'],True,'\c');
+  DoTest(['\a','b','\c:'],True,'\c:');
+  DoTest(['a','<>','\b','c','\d'],True,'',True);
+  {$IFDEF WINDOWS}
+  DoTest(['c:','a','b'],True,'c:a\b',False);
+  {$ENDIF}
+  DoTest(['\1','..\2','..\3','..4'],True,'\1\..\2\..\3\..4');
+  DoTest(['\1','','','4','','6',''],True,'\1\4\6');
+  DoTest(['','','','<>|'],True,'<>|',True);
+  DoTest([''],False,'');
+  DoTest(['',''],False,'');
+  DoTest(['','',''],False,'');
+  DoTest(['a','b','c'],False,'a\b\c');
+  DoTest(['a','b','\c'],False,'\c');
+  DoTest(['a','\b','c'],False,'\b\c');
+  DoTest(['\a','\b','c'],False,'\b\c');
+  DoTest(['\a','\b','\c'],False,'\c');
+  DoTest(['\a','b','\c:'],False,'\c:');
+  DoTest(['a','<>','\b','c','\d'],False,'\d',False);
+end;
+
 procedure TTestTPath.TestGetDirectoryName;
 
   Procedure TestIt(aResult,aFile : String);