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
|
{
*****************************************************************************
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;
{$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 FilenameIsPascalUnit(const Filename: string): boolean;
function FileIsInPath(const Filename, Path: string): boolean;
function FileIsInDirectory(const Filename, Directory: string): boolean;
function ExtractFileNameWithoutExt(const AFilename: string): string; deprecated 'Use the function from unit LazFileUtils';
function CreateAbsoluteSearchPath(const SearchPath, BaseDirectory: string): string; deprecated 'Use the function from unit LazFileUtils';
function CreateAbsolutePath(const Filename, BaseDirectory: string): string; deprecated 'Use the function from unit LazFileUtils';
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
);
TSearchFileInPathFlags = set of TSearchFileInPathFlag;
function SearchFileInPath(const Filename, BasePath, SearchPath,
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;
{ TFileSearcher }
TFileSearcher = class(TFileIterator)
private
FMaskSeparator: char;
FFollowSymLink: Boolean;
FOnFileFound: TFileFoundEvent;
FOnDirectoryFound: TDirectoryFoundEvent;
FOnDirectoryEnter: TDirectoryEnterEvent;
FFileAttribute: Word;
FDirectoryAttribute: Word;
procedure RaiseSearchingError;
protected
procedure DoDirectoryEnter; virtual;
procedure DoDirectoryFound; virtual;
procedure DoFileFound; virtual;
public
constructor Create;
procedure Search(ASearchPath: String; ASearchMask: String = '';
ASearchSubDirs: Boolean = True; CaseSensitive: Boolean = False);
public
property MaskSeparator: char read FMaskSeparator write FMaskSeparator;
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 OnDirectoryFound: TDirectoryFoundEvent read FOnDirectoryFound write FOnDirectoryFound;
property OnFileFound: TFileFoundEvent read FOnFileFound write FOnFileFound;
property OnDirectoryEnter: TDirectoryEnterEvent read FOnDirectoryEnter write FOnDirectoryEnter;
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; SearchMask: String = '';
SearchSubDirs: Boolean = True; DirAttr: Word = faDirectory): TStringList; overload;
procedure FindAllFiles(AList: TStrings; const SearchPath: String;
SearchMask: String = ''; SearchSubDirs: Boolean = True; DirAttr: Word = faDirectory); overload;
function FindAllDirectories(const SearchPath: string;
SearchSubDirs: Boolean = True): TStringList; overload;
procedure FindAllDirectories(AList: TStrings; const SearchPath: String;
SearchSubDirs: Boolean = true); 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.
|