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