ufilepaths.pas

DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen

{  JADD - Just Another DelphiDoc: Documentation from Delphi Source Code

Copyright (C) 2003-2008   Gerold Veith

This file is part of JADD - Just Another DelphiDoc.

DelphiDoc is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License version 3 as
published by the Free Software Foundation.

DelphiDoc 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 General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
}

unit UFilePaths;

{Contains some general functions to handle paths and directories. }

interface

uses SysUtils;


//Checks the path whether it is valid.
function CheckPath(Path: String): String;

//Returns the path as an absolute path.
function GetAbsolutePathCurrent(const Path: String): String;

//Returns the path RelPath as an absolute path.
function GetAbsolutePathRelative(AbsPath: String;
                                 const RelPath: String): String;

//Returns whether the path is an absolute path.
function IsAbsolutePath(const Path: String): Boolean;

//Concatenates two parts of a path.
function ConcatPaths(PrePath, PostPath: String): String;


{$IFDEF LINUX}

//A dummy function for non-Windows platforms.
function ExtractShortPathName(const FilePath: String): String;

{$ENDIF}





//Reads the content of the file.
function ReadFileContent(const FileName: String; var Content: String): Boolean;





//separator of portions of a path (i.e. between directories)
const PathDelimiter{: Char} =
{$IFDEF conditionalexpressions}
                              PathDelim;
{$ELSE}
                              '\';
{$ENDIF}


//separator of/between several paths
const PathsSeparator{: Char} =
{$IFDEF conditionalexpressions}
                               PathSep;
{$ELSE}
                               ';';
{$ENDIF}



implementation


uses Classes;


{$IFNDEF LINUX}

{Checks the path if the path is valid.
~param Path the path to check
~result the path (repaired if appropriate and possible) }
function CheckPath(Path: String): String;
var      UNC      :Boolean;    //is it an UNC-Name "\\Host\Share\...path..." ?
         i        :Integer;    //general index
begin
 //check if it starts with "\\"
 UNC := (length(Path) > 2) and (Path[1] = '\') and (Path[2] = '\');
 if UNC then
  Delete(Path, 1, 2);       //delete first two "\\""

 if Path <> '' then
  begin
   //delete double back slashes "\\"
   i := pos('\\', Path);      //replace each "\\" with "\"
   while (i <> 0) do
    begin
     Delete(Path, i, 1);
     i := pos('\\', Path);
    end;

   //delete current directories in the path ".\"
   i := pos('\.\', Path);     //replace each "\.\" with "\"
   while (i <> 0) do
    begin
     Delete(Path, i, 2);
     i := pos('\.\', Path);
    end;

    // xxx\something\..\yyy => xxx\yyy ??? no, ... let's ExpandFileName do it
  end;

 if UNC then                  //if it was UNC
  Path := '\\' + Path;          //prepend the "\\" again
 Result := Path;              //return the path
end;




{Returns the path as an absolute path.
~param Path the path
~result the absolute path  }
function GetAbsolutePathCurrent(const Path: String): String;
begin
 Result := ExpandFileName(CheckPath(Path));
end;


{Return the path RelPath as an absolute path. If it is not absolute yet, use
 AbsPath as absolute path to what it is relative.
~param AbsPath the path RelPath may be relative to
~param RelPath the path that should be returned as an absolute path
~result the absolute path of RelPath }
function GetAbsolutePathRelative(AbsPath: String;
                                 const RelPath: String): String;
begin
 Result := CheckPath(RelPath);     //make path valid
 //starts not with '\\'?
 if (length(Result) <= 2) or (Result[1] <> '\') or (Result[2] <> '\') then
  begin
   //starts not with 'x:\'?
   if (length(Result) <= 2) or not (Result[1] in ['A'..'Z', 'a'..'z']) or
      (Result[2] <> ':') or (Result[3] <> '\') then
    begin
     AbsPath := CheckPath(AbsPath);    //make path valid
     //starts with 'x:' ?
     if (length(Result) > 1) and (Result[1] in ['A'..'Z', 'a'..'z']) and
        (Result[2] = ':') then
      begin
       if UpCase(Result[1]) <> UpCase(AbsPath[1]) then //is different drive?
        //get current dir on that drive
        GetDir(ord(UpCase(Result[1])) - ord('A') + 1, AbsPath);
       Delete(Result, 1, 2)      //delete drive portion 'x:'
      end
     else                           //absolute to current drive?
      if (Result <> '') and (Result[1] = '\') then
       begin
        AbsPath := ExtractFileDrive(AbsPath);        //just use the given drive
        if AbsPath = '' then                         //no drive given?
         begin
          GetDir(0, AbsPath);                          //get current directory
          AbsPath := ExtractFileDrive(AbsPath);          //use its drive
         end;
       end;

     if (AbsPath[length(AbsPath)] <> '\') and      //need a path separator?
        ((Result = '') or (Result[1] <> '\')) then
      AbsPath := AbsPath + '\'                       //append a path separator
     else
      if (AbsPath[length(AbsPath)] = '\') and        //two path separators?
         (Result <> '') and (Result[1] = '\') then
       Delete(Result, 1, 1);                           //delete path separator

     Result := ExpandFileName(AbsPath + Result);   //concatenate both
    end;
  end;
end;

{Returns whether the path is an absolute path.
~param Path the path to test whether it is absolute
~result whether the path is an absolute path }
function IsAbsolutePath(const Path: String): Boolean;
begin      //does start with '\\' or 'x:\' ?
 Result := (length(Path) >= 2) and
           (((Path[1] = '\') and (Path[2] = '\')) or
            ((length(Path) >= 3) and (Path[1] in ['A'..'Z', 'a'..'z']) and
             (Path[2] = ':') and (Path[3] = '\')));
end;

{Concatenates two parts of a path.
~param PrePath the first part of the path
~param PostPath the rear part of the path
~result the both parts concatenated }
function ConcatPaths(PrePath, PostPath: String): String;
begin
 PrePath := CheckPath(PrePath);              //check both parts
 PostPath := CheckPath(PostPath);

 if (PrePath[length(PrePath)] <> '\') and    //need a path separator?
    ((PostPath = '') or (PostPath[1] <> '\')) then
  PrePath := PrePath + '\'                     //append a path separator
 else
  if (PrePath[length(PrePath)] = '\') and      //two path separators?
     (PostPath <> '') and (PostPath[1] = '\') then
   Delete(PostPath, 1, 1);                       //delete path separator

 Result := PrePath + PostPath;               //concatenate both parts
end;


















{$ELSE}






















{Checks the path whether it is valid.
~param Path the path to check
~result the path (repaired if appropriate and possible) }
function CheckPath(Path: String): String;
var      i        :Integer;    //general index
begin
 if Path <> '' then
  begin
   //delete double slashes "//"
   i := pos('//', Path);      //replace each "//" with "/"
   while (i <> 0) do
    begin
     Delete(Path, i, 1);
     i := pos('//', Path);
    end;

   //delete current directories in the path "./"
   i := pos('/./', Path);     //replace each "/./" with "/"
   while (i <> 0) do
    begin
     Delete(Path, i, 2);
     i := pos('/./', Path);
    end;

    // xxx\something\..\yyy => xxx\yyy ??? no, ... let's ExpandFileName do it
  end;

 Result := Path;              //return the path
end;




{Returns the path as an absolute path.
~param Path the path
~result the absolute path }
function GetAbsolutePathCurrent(const Path: String): String;
begin
 Result := ExpandFileName(CheckPath(Path));
end;


{Return the path RelPath as an absolute path. If it is not absolute yet, use
 AbsPath as absolute path to what it is relative.
~param AbsPath the path RelPath may be relative to
~param RelPath the path that should be returned as an absolute path
~result the absolute path of RelPath }
function GetAbsolutePathRelative(AbsPath: String;
                                 const RelPath: String): String;
begin
 Result := CheckPath(RelPath);                 //make path valid
 //starts not with '/' or '~'?
 if (Result = '') or not (Result[1] in ['/', '~']) then
  begin
   AbsPath := CheckPath(AbsPath);                //make path valid

   if (AbsPath[length(AbsPath)] <> '/') and      //need a path separator?
      ((Result = '') or (Result[1] <> '/')) then
    AbsPath := AbsPath + '/'                       //append a path separator
   else
    if (AbsPath[length(AbsPath)] = '/') and        //two path separators?
       (Result <> '') and (Result[1] = '/') then
     Delete(Result, 1, 1);                           //delete path separator

   Result := ExpandFileName(AbsPath + Result);   //concatenate both
  end;
end;

{Returns whether the path is an absolute path.
~param Path the path to test if whether is absolute
~result whether the path is an absolute path }
function IsAbsolutePath(const Path: String): Boolean;
begin      //does start with '/' or '~' ?
 Result := (Path <> '') and (Path[1] in ['/', '~']);
end;

{Concatenates two parts of a path.
~param PrePath the first part of the path
~param PostPath the rear part of the path
~result the both parts concatenated }
function ConcatPaths(PrePath, PostPath: String): String;
begin
 PrePath := CheckPath(PrePath);              //check both parts
 PostPath := CheckPath(PostPath);

 if (PrePath[length(PrePath)] <> '/') and    //need a path separator?
    ((PostPath = '') or (PostPath[1] <> '/')) then
  PrePath := PrePath + '/'                     //append a path separator
 else
  if (PrePath[length(PrePath)] = '/') and      //two path separators?
     (PostPath <> '') and (PostPath[1] = '/') then
   Delete(PostPath, 1, 1);                       //delete path separator

 Result := PrePath + PostPath;               //concatenate both parts
end;



{$ENDIF}





{$IFDEF LINUX}

{A dummy function for non-Windows platforms.
~param FilePath to return
~result FilePath unchanged }
function ExtractShortPathName(const FilePath: String): String;
begin
 Result := FilePath;
end;

{$ENDIF}













{Reads the content of the file in the parameter Content.
~param FileName the name of the file to read (not ''!)
~param Content  the content of the file is returned through this parameter
~result if the content could be read }
function ReadFileContent(const FileName: String; var Content: String): Boolean;
var      FS             :TFileStream;  //the opened file
         FileContent    :String;       //the content of the file
begin
 Result := False;                      //assume it does not work
 try                                   //open file read-only
   FS := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
   try
     SetLength(FileContent, FS.Size);  //set result-buffer
     if FS.Read(Pointer(FileContent)^, FS.Size) = FS.Size then //read content
      begin
       Content := FileContent;           //set content
       Result := True;                   //content read successfully
      end;
   finally
    FS.Free;
   end;
 except

 end;
end;





end.