(****************************************************************************
 * WANT - A build management tool.                                          *
 * Copyright (c) 2001-2003 Juancarlo Anez, Caracas, Venezuela.              *
 * All rights reserved.                                                     *
 *                                                                          *
 * This library is free software; you can redistribute it and/or            *
 * modify it under the terms of the GNU Lesser General Public               *
 * License as published by the Free Software Foundation; either             *
 * version 2.1 of the License, or (at your option) any later version.       *
 *                                                                          *
 * This library is distributed in the hope that it will be useful,          *
 * but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU        *
 * Lesser General Public License for more details.                          *
 *                                                                          *
 * You should have received a copy of the GNU Lesser General Public         *
 * License along with this library; if not, write to the Free Software      *
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA *
 ****************************************************************************)
{
    @brief 

    @author Juanco Aņez
}

unit WildPaths;
{:
@BUG:  SplitPath is not consisten with PathConcat. The output of the first
       can not be put back together with the second. This is a problem for
       UNC paths.

@TODO: File-by-file matching currently relies too much on the OS, so it may
       not work consistently in Windows and Linux.

       To make it consistent:
         * Allways retreive lists of files with an '*' pattern
         * Filter the resulting list using IsMatch and our own pattern.

       Besides consistency, our own matching would allow us to use extended,
       Unix-like file matching ([-] ranges, etc.) on Windows.

       Do not make these changes until specific user stories prove them
       necessary.

@TODO: Factor out stuff that JCL already handles well.
}

interface

uses
  Windows,
  SysUtils,
  Math,
  Classes,

  JclFileUtils,

  WantUtils;

const
  WildChars        = '?*';
  InvalidPathChars = string(';' {$IFDEF LINUX} + ':' {$ENDIF});

  {$IFDEF LINUX}
  SystemPathDelimiter: string = '/';
  {$ELSE}
  SystemPathDelimiter: string = '\';
  {$ENDIF}

type
  TPath  = type string;
  TPattern  = TPath;
  TPaths = array of TPath;
  TPatterns = TPaths;

  TSystemPath  = string;
  TSystemPaths = array of TSystemPath;

  EPathException = class(Exception);
  EFileOpException    = class(EPathException);

  TFileAttribute = (
    ReadOnly,  {= $00000001 }
    Hidden,    {= $00000002 }
    SysFile,   {= $00000004 }
    VolumeID,  {= $00000008 }
    Directory, {= $00000010 }
    Archive,   {= $00000020 }
    NoFile     {= -1}
  );
  TFileAttributes = set of TFileAttribute;

const
  AnyFileAttribute = [];

function  IsLocalPath(const Path: TPath): boolean;
procedure AssertIsLocalPath(const Path: TPath);

function IsWindowsPath(const Path: TPath):boolean;

function PathDrive(const Path: TPath): string;
function PathServer(Path: TPath): string;
function PathFile(const Path: TPath): TPath;
function PathDir(const Path: TPath): TPath;

function RemovePathDrive(Path: TPath):TPath;
function RemovePathServer(Path: TPath):TPath;

function PathConcat(Path1, Path2: TPath): TPath;

function ToSystemPath(const Path: TPath; const BasePath: TPath = ''):TSystemPath;
function ToPath(SystemPath: TSystemPath;  const BasePath: TPath = ''):TPath;

function ToSystemPaths(const Paths: TPaths; const BasePath: TPath = ''): TSystemPaths; overload;
function ToPaths(OSPaths: TSystemPaths; const BasePath: TPath = ''): TPaths;

procedure ToSystemPaths(Paths: TStrings; const BasePath: TPath = ''); overload;


function StringsToPaths(S: TStrings):TPaths;
function SplitPath(Path: TPath): TPaths;
function JoinPaths(Paths: TPaths): TPath;

function  MovePath(Path, FromBase: TPath; ToBase: TPath = ''): TPath;
function  MovePaths(const Paths: TPaths; const FromBase: TPath; const ToBase: TPath = ''): TPaths;

function  ToRelativePath(Path, BasePath: TPath):TPath;
function  ToRelativePaths(const Paths: TPaths; const BasePath: TPath):TPaths; overload;
function  ToRelativePaths(Paths: TStrings; const BasePath: TPath):TPaths; overload;
function  NormalizePath(Path :TPath) :TPath;

function  PathIsAbsolute(Path: TPath): boolean;
procedure ForceRelativePath(var Path, BasePath: TPath);

function FindPaths(Path: TPath; BasePath: TPath = '';
                   IncludeAttr: TFileAttributes = AnyFileAttribute;
                   ExcludeAttr: TFileAttributes = []
                   ): TPaths;
function FindFiles(const Path: TPath; const BasePath: TPath = ''): TPaths;
function FindDirs(const  Path: TPath; const BasePath: TPath  = ''): TPaths;

function  Wild(    Pattern: TPath; BasePath: TPath = '';
                   IncludeAttr: TFileAttributes = AnyFileAttribute;
                   ExcludeAttr: TFileAttributes = []
                ):TPaths; overload;
procedure Wild(Files: TStrings; Pattern: TPath; BasePath: TPath = '';
                   IncludeAttr: TFileAttributes = AnyFileAttribute;
                   ExcludeAttr: TFileAttributes = []
          ); overload;


function IsMatch(Pattern, Path: TPath):boolean; overload;
function IsMatch(const Patterns: TPatterns; const Paths: TPaths; s: Integer = 0; p: Integer = 0):boolean; overload;

function  PathExists(Path: TPath):boolean;
function  PathIsDir(Path: TPath):boolean;
function  PathIsFile(Path: TPath):boolean;
function  SuperPath(Path: TPath): TPath;


// file operations

procedure MakeDir(const Path: TPath);
function  ChangeDir(const Path: TPath; Verify :boolean = true) :boolean;

function  CurrentDir: TPath;
function  CurrentDrive :TPath;

procedure CopyFile(const Src, Dst: TPath);
procedure CopyFiles(const Sources, Dests: TPaths);  overload;
procedure CopyFiles(const Files: TPaths; FromPath, ToPath: TPath);  overload;
procedure CopyFiles(const Pattern: TPattern; const FromPath, ToPath: TPath); overload;

procedure MoveFile(const Src, Dst: TPath);
procedure MoveFiles(const Sources, Dests: TPaths);  overload;
procedure MoveFiles(const Files: TPaths; const FromPath, ToPath: TPath);  overload;
procedure MoveFiles(const Pattern: TPattern; const FromPath, ToPath: TPath); overload;

procedure DeleteFile(const Path: TPath; DeleteReadOnly: boolean = false);
procedure DeleteFiles(const Files: TPaths; DeleteReadOnly: boolean = false);  overload;
procedure DeleteFiles(const Pattern: TPath; const BasePath: TPath= ''; DeleteReadOnly: boolean = false);  overload;

procedure TouchFile(const Path: TPath; When: TDateTime = 0); overload;
procedure TouchFile(const Path: TPath; When: string); overload;

function  FileAttributes(const Path: TPath):TFileAttributes;
procedure SetFileAttributes(const Path: TPath; const Attr: TFileAttributes);

function  FileTime(const Path: TPath): TDateTime;

function  SystemFileAttributes(const Path: TPath): Integer;
function  SystemFileTime(const Path: TPath): Longint;

function  TimeToSystemFileTime(const Time: TDateTime):Integer;
function  FileAttributesToSystemAttributes(const Attr: TFileAttributes):Byte;
function  SystemAttributesToFileAttributes(Attr: Integer) :TFileAttributes;
function  ChangeExtension( Path: TPath; extension : String ): TPath;

implementation


procedure Wild( Files: TStrings; const Patterns: TPatterns; BasePath: TPath = '';
                Index: Integer = 0;
                IncludeAttr: TFileAttributes = AnyFileAttribute;
                ExcludeAttr: TFileAttributes = []
                );
  overload; forward;


function IsLocalPath(const Path: TPath): boolean;
begin
  Result := ( Pos(SystemPathDelimiter, Path) = 0 );
end;

function IsWindowsPath(const Path: TPath):boolean;
begin
  Result := Pos(':', Path) <> 0;
end;

function CurrentDrive :TPath;
begin
  Result := ToPath(ExtractFileDrive(GetCurrentDir));
end;

function PathDrive(const Path: TPath): string;
var
  p: Integer;
begin
  if not IsWindowsPath(Path) then
    Result := ''
  else
  begin
    p := Pos(':', Path);
    Result := StrLeft(Path, p);
  end;
end;

function PathServer(Path: TPath): string;
var
  P: string;
begin
  Path := ToPath(Path);
  if StrLeft(Path, 2) <> '//' then
    Result := PathDrive(Path)
  else
  begin
    P := Copy(Path, 3, Length(Path));
    Result := '//'+ StrToken(P, '/');
  end;
end;

function PathFile(const Path: TPath): TPath;
var
  splits :TPaths;
begin
  Result := '';
  splits := SplitPath(Path);
  if Length(splits) > 0 then
    Result := splits[High(splits)];
end;

function PathDir(const Path: TPath): TPath;
var
  splits :TPaths;
begin
  Result := '';
  splits := SplitPath(Path);
  if Length(splits) > 0 then
  begin
    SetLength(splits, Length(splits)-1);
    Result := JoinPaths(splits); 
  end;
end;

function RemovePathDrive(Path: TPath):TPath;
var
  p: Integer;
begin
  Result := Path;
  p := Pos(':', Result);
  Delete(Result, 1, p);
end;

function RemovePathServer(Path: TPath):TPath;
var
  Server: string;
begin
  Result := Path;
  Server := PathServer(Path);
  if Server <> '' then
    Delete(Result, 1, 3 + Length(Server));
end;


procedure AssertIsLocalPath(const Path: TPath);
begin
  if Pos(SystemPathDelimiter, Path) <> 0 then
    raise EPathException.Create( Format( '"%s" looks like a system path. Expected a system independent one.',
                                  [Path])
                            );
end;

function PathConcat(Path1, Path2: TPath): TPath;
var
  Parts: TPaths;
  i    : Integer;
  P1   : TPath;
  P2   : TPath;
begin
  Path1 := ToPath(Path1);
  Path2 := ToPath(Path2);

  Parts := nil;
  if (Length(Path1) = 0)
  //or (P1 = '.')
  or PathIsAbsolute(Path2) then
    Result := Path2
  else if Length(Path2) = 0 then
    Result := Path1
  else begin
    P1 := Path1;
    P2 := Path2;
    if P1[Length(P1)] = '/' then
      Delete(P1, Length(P1), 1);
    Result := P1;
    Parts := SplitPath(P2);
    for i := Low(Parts) to High(Parts) do
    begin
      if Parts[i] = '..' then
        Result := SuperPath(Result)
      else if Parts[i] = '.' then
        // do nothing
      else
        Result := Result + '/' + Parts[i];
    end;
  end;
  Assert(Pos('//', Result) <= 1);
end;

procedure CheckPath(Path :TPath);
var
  i :Integer;
begin
  for i := 1 to Length(InvalidPathChars) do
  begin
    if Pos(InvalidPathChars[i], Path) <> 0 then
      raise EPathException.Create('invalid path chars in ' + Path);
  end;
end;

function ToPath(SystemPath: TSystemPath; const BasePath: TPath): TPath;
begin
  CheckPath(SystemPath);
  CheckPath(BasePath);

  Result := SystemPath;
  if (Length(Result) >= 2)
  and (Result[2] = ':')
  and (Result[1] in ['a'..'z', 'A'..'Z'])
  then
  begin
    Result[1] := LowerCase(''+Result[1])[1];
    Result := SystemPathDelimiter + Result;
  end;
  Result := StringReplace(Result, SystemPathDelimiter, '/', [rfReplaceAll]);
  if (BasePath <> '') then
  begin
    if (Length(Result) = 0) then
      Result := ToPath(BasePath)
    else if Result[1] <> '/'  then
    begin
      Result := ToPath(BasePath) + '/' + Result;
    end;
  end;
end;

function ToSystemPath(const Path: TPath; const BasePath: TPath): string;
begin
   CheckPath(Path);
   CheckPath(BasePath);

   Result := MovePath(Path, '', BasePath);
   if (Length(Result) >= 3) and (Result[3] = ':') and (Result[1] = '/') then
     Delete(Result,1, 1);
   if (Length(Result) >= 1) and (Result[Length(Result)] = '/') then
     Delete(Result,Length(Result), 1);
   Result := StringReplace(Result, '/', SystemPathDelimiter, [rfReplaceAll]);
   if PathIsAbsolute(Path) then
     Result := ExpandFileName(Result);
end;

function ToSystemPaths(const Paths: TPaths; const BasePath: TPath = ''): TSystemPaths;
var
  i: Integer;
begin
  SetLength(Result, Length(Paths));
  for i := 0 to High(Result) do
    Result[i] := ToSystemPath(Paths[i], BasePath);
end;

procedure ToSystemPaths(Paths: TStrings; const BasePath: TPath = '');
var
  i: Integer;
begin
  for i := 0 to Paths.Count-1 do
    Paths[i] := ToSystemPath(Paths[i], BasePath);
end;



function ToPaths(OSPaths: TSystemPaths; const BasePath: TPath = ''): TPaths;
var
  i: Integer;
begin
  SetLength(Result, Length(OSPaths));
  for i := 0 to High(Result) do
    Result[i] := ToPath(OSPaths[i], BasePath);
end;


function FindPaths( Path: TPath; BasePath: TPath;
                    IncludeAttr: TFileAttributes;
                    ExcludeAttr: TFileAttributes
                    ):TPaths;
var
  S: TStringList;
  Search: TSearchRec;
  SearchResult: Integer;
  Pattern :TPath;
  Dir     :TPath;
  Lookup  :TPath;
begin
  Path    := ToPath(Path);
  Dir     := PathDir(Path);
  Pattern := PathFile(Path);

  if (Pos('*', Pattern) > 0) or (Pos('?', Pattern) > 0)then
    Lookup := ToSystemPath(PathConcat(Dir, '*'), BasePath)
  else
    Lookup := ToSystemPath(Path, BasePath);

  S := TStringList.Create;
  S.Sorted := True;
  try
    SearchResult := FindFirst(Lookup, faAnyFile, Search);
    try
      while SearchResult = 0 do
      begin
        if  (Search.Name <> '.' )
        and (Search.Name <> '..' )
        and ((IncludeAttr = AnyFileAttribute) or ((SystemAttributesToFileAttributes(Search.Attr) * IncludeAttr) <> []))
        and ((SystemAttributesToFileAttributes(Search.Attr) * ExcludeAttr) =  [])
        and IsMatch(Pattern, Search.Name)
        then
          S.Add(ToPath(Search.Name, BasePath));
        SearchResult := FindNext(Search);
      end;
    finally
      FindClose(Search);
    end;
    Result := StringsToPaths(S);
  finally
    FreeAndNil(S);
  end;
end;

function FindDirs(const Path: TPath; const BasePath: TPath): TPaths;
begin
   Result := FindPaths(Path, BasePath, [Directory]);
end;

function FindFiles(const Path: TPath; const BasePath: TPath): TPaths;
begin
   Result := FindPaths(Path, BasePath, AnyFileAttribute, [Directory]);
end;

function SplitPath(Path: TPath): TPaths;
var
  S   : TStrings;
  n,
  i   : Integer;
  Base: TPath;
begin
  Path := ToPath(Path);

  S := TStringList.Create;
  try
    n := 0;
    if PathIsAbsolute(Path) then
    begin
      ForceRelativePath(Path, Base);
      SetLength(Result, 1);
      Result[0] := Base;
      n := 1;
    end;

    StrToStrings(Path, '/', S);

    SetLength(Result, n+S.Count);
    for i := 0 to S.Count-1 do
      Result[i+n] := S[i];
  finally
    FreeAndNil(S);
  end;
end;

function JoinPaths(Paths: TPaths): TPath;
var
 i :Integer;
begin
  if Length(Paths) = 0 then
    Result := ''
  else
  begin
    Result := Paths[0];
    for i := 1 to High(Paths) do
      Result := PathConcat(Result, Paths[i]);
  end;
end;


function StringsToPaths(S: TStrings): TPaths;
var
  i: Integer;
begin
  SetLength(Result, S.Count);
  for i := 0 to S.Count-1 do
    Result[i] := S[i];
end;

function MovePath(Path, FromBase, ToBase: TPath): TPath;
begin
  Path     := ToPath(Path);
  FromBase := ToPath(FromBase);
  ToBase   := ToPath(ToBase);

  if (FromBase <> '') and (Pos(FromBase+'/', Path) = 1) then
    Result := PathConcat(ToBase, Copy(Path, 2+Length(FromBase), Length(Path)))
  else if PathIsAbsolute(Path) then
    Result :=  Path
  else
    Result := PathConcat(ToBase, Path);
end;


function MovePaths(const Paths: TPaths; const FromBase: TPath; const ToBase: TPath): TPaths;
var
  i: Integer;
begin
   SetLength(Result, Length(Paths));
   for i := Low(Paths) to High(Paths) do
     Result[i] := MovePath(Paths[i], FromBase, ToBase);
end;

function NormalizePath(Path :TPath) :TPath;
begin
  Result := ToPath(Path);
  if not PathIsAbsolute(Path) then
    Result := PathConcat(CurrentDir, Result);
  if PathDrive(Result) = '' then
    Result := CurrentDrive + Result;
end;


function  ToRelativePath(Path, BasePath: TPath):TPath;
var
  P, B  : TPaths;
  i, j: Integer;
begin
  P := nil;
  B := nil;
  Path     := PathConcat('.', ToPath(Path));
  if not PathIsAbsolute(Path)
  and PathIsAbsolute(BasePath) then
    Result := Path
  else
  begin
    BasePath := ToPath(BasePath);

    if (PathDrive(Path) <> PathDrive(BasePath)) then
    begin
      Path     := NormalizePath(Path);
      BasePath := NormalizePath(BasePath);
    end;

    if (PathDrive(Path) <> PathDrive(BasePath)) then
      Result := Path
    else
    begin
      Result := '';

      P := SplitPath(Path);
      B := SplitPath(BasePath);
      i := 0;
      j := 0;
      while (i <= High(P))
      and   (j <= High(B))
      and   (P[i] = B[j])
      do begin
        Inc(i);
        Inc(j);
      end;

      if j > High(B) then
        Result := '.'
      else
      begin
        while  j <= High(B) do
        begin
          if Result = '' then
            Result := '..'
          else
            Result := Result + '/..';
          Inc(j);
        end;
      end;
      while i <= High(P) do
      begin
        Result := PathConcat(Result, P[i]);
        Inc(i);
      end;
    end;

    if Result = '' then
      Result := '.';
  end;
end;

function  ToRelativePaths(const Paths: TPaths; const BasePath: TPath):TPaths;
begin
  Result := MovePaths(Paths, BasePath, '');
end;

function  ToRelativePaths(Paths: TStrings; const BasePath: TPath):TPaths;
var
  i :Integer;
begin
  for i := 0 to Paths.Count-1 do
    Paths[i] := ToRelativePath(Paths[i], BasePath);
end;

function  PathIsAbsolute(Path: TPath): boolean;
begin
  Path := ToPath(Path);

  Result :=    (Length(Path) > 0) and (Path[1] = '/')
             or (Length(Path) >= 3) and (Path[2] = ':') and (Path[3] = '/');
end;

procedure ForceRelativePath(var Path, BasePath: TPath);
var
  p: Integer;
begin
  Path := ToPath(Path);
  BasePath := ToPath(BasePath);

  if PathIsAbsolute(Path) then
  begin
    BasePath := '';
    p := Pos('/', Path);
    BasePath := BasePath + Copy(Path, 1, p);
    Delete(Path, 1, p);
    if PathIsAbsolute(Path) then
    begin // must be UNC, URI, or C:/ style
      p := 1+Pos('/', Copy(Path, 2, Length(Path)));
      if p = 1 then
      begin
        BasePath := BasePath + Path;
        Path := '';
      end
      else
      begin
        BasePath := BasePath + Copy(Path, 1, p-1);
        Delete(Path, 1, p);
      end;
    end;
  end;
end;

function Wild(      Pattern: TPath; BasePath: TPath;
                    IncludeAttr: TFileAttributes;
                    ExcludeAttr: TFileAttributes
                    ):TPaths;
var
  Files: TStringList;
begin
  Pattern  := ToPath(Pattern);
  BasePath := ToPath(BasePath);

  Files := TStringList.Create;
  try
    Files.Sorted := True;
    Wild(Files, Pattern, BasePath, IncludeAttr, ExcludeAttr);
    Result := StringsToPaths(Files);
  finally
    FreeAndNil(Files);
  end;
end;

procedure Wild(Files: TStrings; Pattern: TPath; BasePath: TPath;
               IncludeAttr: TFileAttributes;
               ExcludeAttr: TFileAttributes
               );
var
  Pats: string;
  Pat : TPath;
begin
  Pattern  := ToPath(Pattern);
  BasePath := ToPath(BasePath);

  Pats := Pattern;
  Pat  := StrToken(Pats, ',');
  while Pat <> '' do
  begin
    //ForceRelativePath(Pattern, BasePath);
    if PathIsAbsolute(Pattern) then
      Wild(Files, SplitPath(Pat), '',       0, IncludeAttr, ExcludeAttr)
    else
      Wild(Files, SplitPath(Pat), BasePath, 0, IncludeAttr, ExcludeAttr);
    Pat  := StrToken(Pats, ',');
  end;
end;

procedure Wild( Files: TStrings; const Patterns: TPatterns; BasePath: TPath;
                Index: Integer;
                IncludeAttr: TFileAttributes;
                ExcludeAttr: TFileAttributes
                );
var
  i      : Integer;
  Matches: TPaths;
  NewBase: TPath;
begin
  BasePath := ToPath(BasePath);
  Matches := nil;

  if Index > High(Patterns) then
    EXIT;

  NewBase := BasePath;
  // absorb all non-wildcard patterns
  while (Index < High(Patterns))
  and ((LastDelimiter(WildChars, Patterns[Index]) = 0)
       or (Patterns[Index] = '.')
      )
  do
  begin
    NewBase := PathConcat(NewBase, Patterns[Index]);
    Inc(Index);
  end;
  Assert(Index <= High(Patterns));
  if Index = High(Patterns) then
  begin // add files (works for '**' too)
    Matches := FindPaths(Patterns[Index], NewBase, IncludeAttr, ExcludeAttr);
    for i := Low(Matches) to High(Matches) do
      Files.Add(PathConcat(NewBase, Matches[i]))
  end;
  // handle wildcards
  if Patterns[Index] = '**' then
  begin // match anything and recurse
    Wild(Files, Patterns, NewBase, Index+1, IncludeAttr, ExcludeAttr);
    Matches := FindDirs('*', NewBase);
    // use same Index ('**') to recurse
    for i := Low(Matches) to High(Matches) do
      Wild(Files, Patterns, PathConcat(NewBase, Matches[i]), Index, IncludeAttr, ExcludeAttr);
  end
  else if Index < High(Patterns) then
  begin // match directories
    Matches := FindDirs(Patterns[Index], NewBase);
    for i := Low(Matches) to High(Matches) do
      Wild(Files, Patterns, PathConcat(NewBase, Matches[i]), Index+1, IncludeAttr, ExcludeAttr);
  end;
end;

function Matches(A, B: TPath; i: Integer = 1; j: Integer = 1):boolean;
begin
  while (i <= Length(A))
  and   (j <= Length(B))
  and   (UpCase(A[i]) = UpCase(B[j])) do
  begin
    Inc(i);
    Inc(j);
  end;
  if B = '.' then
    Result := True
  else if j > Length(B) then
    Result := i > Length(A)
  else if i > Length(A) then
    Result := False
  else if B[j] = '?' then
    Result :=    Matches(A, B, i+1, j+1)
              or Matches(A, B, i,   j+1)
  else if B[j] = '*' then
    Result :=    Matches(A, B, i+1, j+1)
              or Matches(A, B, i+1, j)
              or Matches(A, B, i  , j+1)
  else
    Result := False;
end;

function IsMatch(const Patterns: TPatterns; const Paths: TPaths; s: Integer = 0; p: Integer = 0):boolean;
begin
  while (p <= High(Paths))
  and   (s <= High(Patterns))
  and   (Patterns[s] <> '**')
  and   Matches(Paths[p], Patterns[s]) do
  begin
    Inc(p);
    Inc(s);
  end;
  if s > High(Patterns) then
    Result := p > High(Paths)
  else if Patterns[s] = '**' then
  begin
    if p > High(Paths) then
      Result := s = High(Patterns)
    else
      Result :=    IsMatch(Patterns, Paths, s+1,   p)
                or IsMatch(Patterns, Paths, s+1, p+1)
                or IsMatch(Patterns, Paths, s,   p+1)
  end
  else
    Result := False;
end;

function IsMatch(Pattern, Path : TPath):boolean;
begin
  Pattern  := ToPath(Pattern);
  Path     := ToPath(Path);

  Result := IsMatch(SplitPath(Pattern), SplitPath(Path));
end;

function  PathExists(Path: TPath):boolean;
begin
  Path     := ToPath(Path);

  Result := Length(FindPaths(Path)) >= 1;
end;

function  PathIsDir(Path: TPath):boolean;
begin
  Path     := ToPath(Path);

  Result := (FileAttributes(Path) * [NoFile, Directory]) = [Directory];
end;

function  PathIsFile(Path: TPath):boolean;
begin
  Path     := ToPath(Path);
  Result := (FileAttributes(Path) * [NoFile, Directory]) = [];
end;

function  SuperPath(Path: TPath): TPath;
var
  p   : Integer;
  f   : string;
begin
  Path     := ToPath(Path);

  if (Path = '.') or (Path = '') then
    Result := '..'
  else if Path = '..' then
    Result := '../..'
  else
  begin
    Result := Path;
    p := LastDelimiter('/', Result);
    f := Copy(Result, p+1, Length(Result));
    if (p = Length(Result)) or (f = '.') then
    begin
      Result := Copy(Result, 1, p-1);
      p := LastDelimiter('/', Result);
      f := Copy(Result, p+1, Length(Result))
    end;
    if  f = '..' then
      Result := Result + '/..'
    else
      Result := Copy(Result, 1, p-1);
  end;
end;



// file operations


procedure MakeDir(const Path: TPath);
begin
  if (Length(Path) > 0)
  and (Path[Length(Path)] <> ':')  // Oops! Windows specific!
  and not PathIsDir(Path) then
  begin
    MakeDir(SuperPath(Path));
    SysUtils.CreateDir(ToSystemPath(Path));
    if not PathIsDir(Path) then
      raise EFileOpException.Create(Format('Could not create directory "%s"', [Path]));
  end;
end;

function ChangeDir(const Path: TPath; Verify :boolean) :boolean;
begin
  Result := True;
  if (Path <> '') and (Path <> CurrentDir) then
    Result := SetCurrentDir(ToSystemPath(Path));
    if not Result and Verify then
      raise EFileOpException.CreateFmt('Could not change to directory "%s"',[Path]);
end;

function  CurrentDir: TPath;
begin
  Result := ToPath(SysUtils.GetCurrentDir);
end;


procedure CopyFile(const Src, Dst: TPath);
begin
   MakeDir(SuperPath(Dst));
   if PathIsDir(Src) then
     MakeDir(Dst)
   else if not Windows.CopyFile( PChar(ToSystemPath(Src)),
                                 PChar(ToSystemPath(Dst)),
                                 False)
     then
       raise EFileOpException.Create(SysErrorMessage(GetLastError));
end;

procedure CopyFiles(const Pattern: TPattern; const FromPath, ToPath: TPath);
begin
  CopyFiles(Wild(Pattern, FromPath), FromPath, ToPath);
end;

procedure CopyFiles(const Files: TPaths; FromPath, ToPath: TPath);
begin
  CopyFiles(Files, MovePaths(Files, FromPath, ToPath));
end;

procedure CopyFiles(const Sources, Dests: TPaths);
var
  f  : Integer;
begin
  for f := Max(Low(Sources), Low(Dests)) to Min(High(Sources), High(Dests)) do
  begin
    CopyFile(Sources[f], Dests[f]);
  end;
end;

procedure MoveFile(const Src, Dst: TPath);
begin
  if PathIsDir(Src) then
  begin
    raise EFileOpException.Create(Format('Don''t know how to move dir "%s" to "%s"', [Src, Dst]));
  end;

  (* MoveFileEx not implemented on Win9x. Some help files say it is, but see
     this link for current doc:
       http://msdn.microsoft.com/library/psdk/winbase/filesio_9oe0.htm

     In addition, MOVEFILE_REPLACE_EXISTING does not work with read only files
  if not Windows.MoveFileEx(PChar(ToSystemPath(Src)), PChar(ToSystemPath(Dst)),
                            MOVEFILE_COPY_ALLOWED or
                            MOVEFILE_REPLACE_EXISTING or
                            MOVEFILE_WRITE_THROUGH)  -- Chrismo *)

  WildPaths.CopyFile(Src, Dst);
  WildPaths.DeleteFile(Src);
end;

procedure MoveFiles(const Pattern: TPattern; const FromPath, ToPath: TPath);
begin
  MoveFiles(Wild(Pattern, FromPath), FromPath, ToPath);
end;

procedure MoveFiles(const Files: TPaths; const FromPath, ToPath: TPath);
begin
  MoveFiles(Files, MovePaths(Files, FromPath, ToPath));
end;

procedure MoveFiles(const Sources, Dests: TPaths);
var
  f  : Integer;
begin
  for f := Max(Low(Sources), Low(Dests)) to Min(High(Sources), High(Dests)) do
  begin
    MoveFile(Sources[f], Dests[f]);
  end;
end;

procedure DeleteFile(const Path: TPath; DeleteReadOnly: boolean = false);
var
  SysPath: string;
  FileAttr: Integer;
begin
  SysPath := ToSystemPath(Path);
  if not PathIsDir(Path) then
  begin
    if DeleteReadOnly then
    begin
      { take off read only attribute if it exists }
      FileAttr := SysUtils.FileGetAttr(SysPath);
      FileAttr := FileAttr and (not $00000001); // faReadOnly. Avoid warning.
      SysUtils.FileSetAttr(SysPath, FileAttr);
    end;
    SysUtils.DeleteFile(SysPath)
  end
  else
    SysUtils.RemoveDir(SysPath);
end;

procedure DeleteFiles(const Pattern: TPath; const BasePath: TPath; DeleteReadOnly :boolean);
begin
  DeleteFiles(Wild(Pattern, BasePath), DeleteReadOnly);
end;

procedure DeleteFiles(const Files: TPaths; DeleteReadOnly: boolean = false);
var
  f: Integer;
begin
  for f := Low(Files) to High(Files) do
    if not PathIsDir(Files[f]) then
      DeleteFile(Files[f], DeleteReadOnly);
  for f := Low(Files) to High(Files) do
    if PathIsDir(Files[f]) then
      DeleteFile(Files[f], DeleteReadOnly);
end;

procedure TouchFile(const Path: TPath; When: string);
begin
  //!!! StrToDateTime changes with locale and platform!!
  TouchFile(Path, StrToDateTime(When));
end;


procedure TouchFile(const Path: TPath; When: TDateTime);
var
  Handle: Integer;
begin
   if When = 0 then
     When := Now;

   MakeDir(SuperPath(Path));
   
   Handle := FileOpen(ToSystemPath(Path), fmOpenWrite or fmShareDenyNone);
   if Handle < 0 then
     Handle := FileCreate(ToSystemPath(Path));
   try
     FileSetDate(Handle, DateTimeToFileDate(When))
   finally
     FileClose(Handle);
   end;
end;

function FileAttributes(const Path: TPath):TFileAttributes;
var
  Attr :Integer;
begin
  Attr := SystemFileAttributes(Path);
  if Attr < 0 then
    Result := [NoFile]
  else
    Result := TFileAttributes(Byte(Attr));
end;

procedure SetFileAttributes(const Path: TPath; const Attr: TFileAttributes);
begin
  SysUtils.FileSetAttr(ToSystemPath(Path), FileAttributesToSystemAttributes(Attr));
end;

function  FileTime(const Path: TPath): TDateTime;
var
  SystemTime: Longint;
begin
  SystemTime := SystemFileTime(Path);
  if SystemTime <= 0 then
    Result := 0
  else
    Result := FileDateToDateTime(SystemTime);
end;

function  SystemFileAttributes(const Path: TPath): Integer;
begin
  Result := Byte(SysUtils.FileGetAttr(ToSystemPath(Path)));
end;

function  SystemFileTime(const Path: TPath)    : Longint;
begin
  Result := SysUtils.FileAge(ToSystemPath(Path));
  if Result < 0 then
    Result := 0;
end;

function  TimeToSystemFileTime(const Time: TDateTime):Integer;
begin
  Result := DateTimeToFileDate(Time);
end;

function  FileAttributesToSystemAttributes(const Attr: TFileAttributes):Byte;
begin
  Result := Byte(Attr);
end;

function  SystemAttributesToFileAttributes(Attr: Integer) :TFileAttributes;
begin
  Result := TFileAttributes(Byte(Attr));
end;

function ChangeExtension( Path: TPath; extension : String ): TPath;
var
  p : integer ;
begin
  p:=LastDelimiter('.',Path);
  if (p < Length(Path)) then
  begin
    Result:=copy(Path,1,p)+extension;
  end
  else Result:=Path
end;

end.