1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250
|
{
*****************************************************************************
This file is part of LazUtils.
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
}
{ ****************************************************************************
BB: 2013-05-19
Note to developers:
This unit should contain functions and procedures to
maintain compatibility with Delphi's FileUtil unit.
File routines that specifically deal with UTF8 filenames should go into
the LazFileUtils unit.
***************************************************************************** }
unit FileUtil;
{$mode objfpc}{$H+}
{$i lazutils_defines.inc}
interface
uses
Classes, SysUtils, StrUtils,
// LazUtils
Masks, LazUTF8, LazFileUtils,
Contnrs;
{$IF defined(Windows) or defined(darwin) or defined(HASAMIGA)}
{$define CaseInsensitiveFilenames}
{$ENDIF}
{$IF defined(CaseInsensitiveFilenames) or defined(darwin)}
{$define NotLiteralFilenames}
{$ENDIF}
const
UTF8FileHeader = #$ef#$bb#$bf;
FilenamesCaseSensitive = {$IFDEF CaseInsensitiveFilenames}false{$ELSE}true{$ENDIF};// lower and upper letters are treated the same
FilenamesLiteral = {$IFDEF NotLiteralFilenames}false{$ELSE}true{$ENDIF};// file names can be compared using = string operator
// basic functions similar to the RTL but working with UTF-8 instead of the
// system encoding
// AnsiToUTF8 and UTF8ToAnsi need a widestring manager under Linux, BSD, MacOSX
// but normally these OS use UTF-8 as system encoding so the widestringmanager
// is not needed.
// file and directory operations
function ComparePhysicalFilenames(const Filename1, Filename2: string): integer;
function CompareFilenames(Filename1: PChar; Len1: integer;
Filename2: PChar; Len2: integer; ResolveLinks: boolean): integer; overload;
function ExtractShortPathNameUTF8(Const FileName : String) : String;
function DeleteDirectory(const DirectoryName: string; OnlyChildren: boolean): boolean;
function ProgramDirectory: string;
function ProgramDirectoryWithBundle: string;
function ExpandUNCFileNameUTF8(const FileName: string): string;
function FileSize(const Filename: string): int64; overload; inline;
function FilenameHasPascalExt(const Filename: string): boolean;
function FileIsInPath(const Filename, Path: string): boolean;
function FileIsInDirectory(const Filename, Directory: string): boolean;
function GetAllFilesMask: string; inline;
function GetExeExt: string; inline;
function ReadFileToString(const Filename: string): string;
// file search
type
TSearchFileInPathFlag = (
sffDontSearchInBasePath, // do not search in BasePath, search only in SearchPath.
sffSearchLoUpCase,
sffFile, // must be file, not directory
sffExecutable, // file must be executable
sffDequoteSearchPath // ansi dequote
);
TSearchFileInPathFlags = set of TSearchFileInPathFlag;
const
sffFindProgramInPath = [
{$IFDEF Unix}sffDontSearchInBasePath,{$ENDIF}
{$IFDEF Windows}sffDequoteSearchPath,{$ENDIF}
sffFile,
sffExecutable
];
function SearchFileInPath(const Filename, BasePath: string;
SearchPath: string; const Delimiter: string;
Flags: TSearchFileInPathFlags): string; overload;
function SearchAllFilesInPath(const Filename, BasePath, SearchPath,
Delimiter: string; Flags: TSearchFileInPathFlags): TStrings;
function FindDiskFilename(const Filename: string): string;
function FindDiskFileCaseInsensitive(const Filename: string): string;
function FindDefaultExecutablePath(const Executable: string; const BaseDir: string = ''): string;
type
{ TFileIterator }
TFileIterator = class
private
FPath: String;
FLevel: Integer;
FFileInfo: TSearchRec;
FSearching: Boolean;
function GetFileName: String;
public
procedure Stop;
function IsDirectory: Boolean;
public
property FileName: String read GetFileName;
property FileInfo: TSearchRec read FFileInfo;
property Level: Integer read FLevel;
property Path: String read FPath;
property Searching: Boolean read FSearching;
end;
TFileFoundEvent = procedure (FileIterator: TFileIterator) of object;
TDirectoryFoundEvent = procedure (FileIterator: TFileIterator) of object;
TDirectoryEnterEvent = procedure (FileIterator: TFileIterator) of object;
TQueryFileFoundEvent = procedure (FileIterator: TFileIterator; const Fn: String; var Accept: Boolean) of object;
TQueryDirectoryFoundEvent = procedure (FileIterator: TFileIterator; const Dir: String; var Accept: Boolean) of object;
{ TFileSearcher }
TFileSearcher = class(TFileIterator)
private
FMaskSeparator: char;
FPathSeparator: char;
FFollowSymLink: Boolean;
FOnFileFound: TFileFoundEvent;
FOnDirectoryFound: TDirectoryFoundEvent;
FOnDirectoryEnter: TDirectoryEnterEvent;
FFileAttribute: Word;
FDirectoryAttribute: Word;
FOnQueryFileFound: TQueryFileFoundEvent;
FOnQueryDirectoryEnter: TQueryDirectoryFoundEvent;
FCircularLinkDetection: Boolean;
VisitedDirs: TFPStringHashTable;
procedure RaiseSearchingError;
protected
procedure DoDirectoryEnter; virtual;
procedure DoDirectoryFound; virtual;
procedure DoFileFound; virtual;
procedure DoQueryFileFound(const Fn: String; var Accept: Boolean);
procedure DoQueryDirectoryEnter(const Dir: String; var Accept: Boolean);
public
constructor Create;
procedure Search(const ASearchPath: String; const ASearchMask: String = '';
ASearchSubDirs: Boolean = True; CaseSensitive: Boolean = False);
public
property MaskSeparator: char read FMaskSeparator write FMaskSeparator;
property PathSeparator: char read FPathSeparator write FPathSeparator;
property FollowSymLink: Boolean read FFollowSymLink write FFollowSymLink;
property FileAttribute: Word read FFileAttribute write FFileAttribute default faAnyfile;
property DirectoryAttribute: Word read FDirectoryAttribute write FDirectoryAttribute default faDirectory;
property CircularLinkdetection: Boolean read FCircularLinkdetection write FCircularLinkdetection default False;
property OnDirectoryFound: TDirectoryFoundEvent read FOnDirectoryFound write FOnDirectoryFound;
property OnFileFound: TFileFoundEvent read FOnFileFound write FOnFileFound;
property OnDirectoryEnter: TDirectoryEnterEvent read FOnDirectoryEnter write FOnDirectoryEnter;
property OnQueryFileFound: TQueryFileFoundEvent read FOnQueryFileFound write FOnQueryFileFound;
property OnQueryDirectoryEnter: TQueryDirectoryFoundEvent read FOnQueryDirectoryEnter write FOnQueryDirectoryEnter;
end;
{ TListFileSearcher }
TListFileSearcher = class(TFileSearcher)
private
FList: TStrings;
protected
procedure DoFileFound; override;
public
constructor Create(AList: TStrings);
end;
{ TListDirectoriesSearcher }
TListDirectoriesSearcher = class(TFileSearcher)
private
FDirectoriesList :TStrings;
protected
procedure DoDirectoryFound; override;
public
constructor Create(AList: TStrings);
end;
function FindAllFiles(const SearchPath: String; const SearchMask: String = '';
SearchSubDirs: Boolean = True; DirAttr: Word = faDirectory;
MaskSeparator: char = ';'; PathSeparator: char = ';'): TStringList; overload;
procedure FindAllFiles(AList: TStrings; const SearchPath: String;
const SearchMask: String = ''; SearchSubDirs: Boolean = True; DirAttr: Word = faDirectory;
MaskSeparator: char = ';'; PathSeparator: char = ';'); overload;
function FindAllDirectories(const SearchPath: string;
SearchSubDirs: Boolean = True; PathSeparator: char = ';'): TStringList; overload;
procedure FindAllDirectories(AList: TStrings; const SearchPath: String;
SearchSubDirs: Boolean = true; PathSeparator: char = ';'); overload;
// flags for copy
type
TCopyFileFlag = (
cffOverwriteFile,
cffCreateDestDirectory,
cffPreserveTime
);
TCopyFileFlags = set of TCopyFileFlag;
// Copy a file and a whole directory tree
function CopyFile(const SrcFilename, DestFilename: string;
Flags: TCopyFileFlags=[cffOverwriteFile]; ExceptionOnError: Boolean=False): boolean;
function CopyFile(const SrcFilename, DestFilename: string; PreserveTime: boolean; ExceptionOnError: Boolean=False): boolean;
function CopyDirTree(const SourceDir, TargetDir: string; Flags: TCopyFileFlags=[]): Boolean;
// filename parts
const
PascalFileExt: array[1..3] of string = ('.pas','.pp','.p');
PascalSourceExt: array[1..6] of string = ('.pas','.pp','.p','.lpr','.dpr','.dpk');
AllDirectoryEntriesMask = '*';
implementation
uses
{$IFDEF windows}
Windows;
{$ELSE}
{$IFDEF HASAMIGA}
AmigaDOS;
{$ELSE}
Unix;
{$ENDIF}
{$ENDIF}
{$I fileutil.inc}
{$IFDEF windows}
{$i winfileutil.inc}
{$ELSE}
{$IFDEF HASAMIGA}
{$i unixfileutil.inc} // Reuse UNIX code for Amiga
{$ELSE}
{$i unixfileutil.inc}
{$ENDIF}
{$ENDIF}
end.
|