⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 upascalfiles.pas

📁 DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen
💻 PAS
字号:
{  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 UPascalFiles;

{Contains some simple functions to test if a name of a file is a pascal file
 and to search all pascal files in a directory. A function to test if a file is
 in the list of permitted directories and not in the list of forbidden
 directories is also provided. }

interface

uses Classes;


      //the (lower case) file extensions of all file with pascal code
const DelphiFileExtensions: array[0..2{4}] of String =
                            ('pas',   //pascal (general) units
                             'dpr',   //Delphi project: program and library
                             'dpk' {,   //Delphi package
                             'int',   //interface files
                             'pp'});   //FreePascal files


//Tests if the file is a pascal file by the file extension.
function IsPasExt(FileName: String): Boolean;

//Returns a list of pascal file in that directory.
function FindPasFiles(Path: String; List: TStrings; Recurse: Boolean): Cardinal;

//Tests if the file/directory is allowed to be processed.
function FileDirAllowed(Dir: String; Dirs, NotDirs: TStrings): Boolean;


implementation

uses SysUtils,
     UFilePaths
{$IFDEF LINUX}
     ,
     UPascalConsts            //ExtractShortPathName dummy
{$ENDIF}
     ;



{Tests if the file is a pascal file by the file extension.
~param FileName the name of the file, that should be tested if it is a pascal
                file
~result whether the file is a pascal file }
function IsPasExt(FileName: String): Boolean;
var      i       :Integer; //counter through the list of pascal file extensions
begin
 FileName := ExtractFileExt(FileName);      //get the file extension
 Delete(FileName, 1, 1);                    //delete the dot '.'
 FileName := LowerCase(FileName);           //use lower case (case-insensitive)
 i := High(DelphiFileExtensions);
 while (i >= Low(DelphiFileExtensions)) and    //test all file extensions
       (FileName <> DelphiFileExtensions[i]) do  //if equal
  Dec(i);
 Result := i >= low(DelphiFileExtensions);     //if file extension is pascal
end;

{Returns a list of pascal file in the directory, including subdirectories if
 demanded.
~param Path    the path of the directory in which all pascal files should be
               returned
~param List    the list to which all found pascal files should be added
~param Recurse whether files in subdirectories should also be returned
~result the number of found pascal files }
function FindPasFiles(Path: String; List: TStrings; Recurse: Boolean): Cardinal;
var      Dirs        :TStringList;     //the list of directories to be searched
         Index       :Integer;         //counter through Dirs
         FileInfo    :TSearchRec;      //data to find files
begin
 Result := 0;                 //no pascal files found so far

 Dirs := TStringList.Create;  //list of all directories to search in
 try
   Dirs.Append(Path);         //at the moment only the path given
   Index := 0;                //start at his path

   repeat                       //for all paths (if recursive)
     Path := Dirs[Index];         //get path to search in


     if FindFirst(Path + PathDelimiter + '*',
{$IFNDEF LINUX}
  {$IFDEF conditionalexpressions}
    {$WARN SYMBOL_PLATFORM OFF}
  {$ENDIF}
                  faHidden or
  {$IFDEF conditionalexpressions}
    {$WARN SYMBOL_PLATFORM ON}
  {$ENDIF}
{$ENDIF}
                  faDirectory,
                  FileInfo) = 0 then //files available
      try
        repeat                         //for each found file

          if FileInfo.Attr and faDirectory = 0 then //not a directory?
           begin
            if IsPasExt(FileInfo.Name) then  //is a pascal extension?
             begin                             //append file to the list
              List.Append(ExtractShortPathName(ExpandFileName(Path +
                                                              PathDelimiter +
                                                              FileInfo.Name)));
              Inc(Result);                     //another file found
             end;
           end
          else
           if Recurse and   //a directory and should be recursed into?
{$IFDEF LINUX}
  {$WARN SYMBOL_PLATFORM OFF}
              //don't follow symlinked directories (no eternal recursion,
              (FileInfo.Attr and faSymLink = 0) and               //please)
  {$WARN SYMBOL_PLATFORM ON}
{$ENDIF}
              (FileInfo.Name <> '.') and (FileInfo.Name <> '..') then
            //append to paths to search
            Dirs.Append(Path + PathDelimiter + FileInfo.Name);


        until FindNext(FileInfo) <> 0; //until all files have been processed
      finally
       FindClose(FileInfo);            //end the search
      end;

     Inc(Index);               //search next path
   until Index >= Dirs.Count; //all paths searched?

 finally
  Dirs.Free;                  //free list of search paths
 end;
end;


{Tests if the file/directory is allowed to be processed. The file should be
 processed if the longest part of the path is found in Dirs instead of NotDirs.
 If Dirs contains C:\ and C:\a\b\ and NotDirs contains C:\a all files in C:\
 will be processed besides the files in the directory C:\a, but the files in
 the subdirectory C:\a\b will also be processed. For both list the objects are
 treated as boolean values, if they behave like this, this means recursive. If
 not only the directory in the path will be used, not the subdirectories like
 in the example. The paths must always use the short file names, this is needed
 to have unique and unambiguous names of files. The lists must be sorted
 alphabetically, this means longer paths must be after the shorter path if it
 is in the shorter.
~param Dir     the directory/file to be tested
~param Dirs    the list of directories to be processed (with subdirectories)
~param NotDirs the list of directories not to be processed (with subdirectories)
~result whether the file/directory is allowed to be processed }
function FileDirAllowed(Dir: String; Dirs, NotDirs: TStrings): Boolean;

 {Returns the longest match of the path in Dir to the paths in List.
 ~param Dir  the path to search in List
 ~param List the list of paths to compare with Dir
 ~result the longest matching path to Dir in List }
 function FindLongestMatch(const Dir: String; List: TStrings): String;
 var      i     :Integer;    //counter through the list
          S     :String;     //the current path in List
 begin
  Result := '';              //no match found so far
  for i := 0 to List.Count - 1 do  //compare each path
   begin
    S := List[i];                    //get the path
    //is Dir under the path somewhere (or both equal)?
    if (Length(S) > Length(Result)) and (S = Copy(Dir, 1, Length(S))) then
     //only if the path is recursive or the paths match
     if (Length(S) = Length(Dir)) or Boolean(List.Objects[i]) then
      Result := S;                       //use this as the result
   end;
 end;

var      Add, NotAdd   :String;  //the string of the longest matches
begin
 //get the unique path
 Dir := ExtractFileDir(ExtractShortPathName(ExpandFileName(Dir)));
 Add := FindLongestMatch(Dir, Dirs);       //search the best allowed match
 NotAdd := FindLongestMatch(Dir, NotDirs); //search the best disallowed match
 Result := Length(Add) >= Length(NotAdd);  //return if allowed
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -