1 {
2 **********************************************************************
3 This file is part of LazUtils.
4 All functions are thread safe unless explicitely stated
5
6 See the file COPYING.modifiedLGPL.txt, included in this distribution,
7 for details about the license.
8 **********************************************************************
9 }
10 unit LazFileUtils;
11
12 {$mode objfpc}{$H+}
13 {$i lazutils_defines.inc}
14 interface
15
16 uses
17 Classes, SysUtils, SysConst, LazUTF8, LazUtilsStrConsts;
18
19 {$IF defined(Windows) or defined(darwin) or defined(HASAMIGA)}
20 {$define CaseInsensitiveFilenames}
21 {$IFDEF Windows}
22 {$define HasUNCPaths}
23 {$ENDIF}
24 {$ENDIF}
25 {$IF defined(CaseInsensitiveFilenames)}
26 {$define NotLiteralFilenames} // e.g. HFS+ normalizes file names
27 {$ENDIF}
28
CompareFilenamesnull29 function CompareFilenames(const Filename1, Filename2: string): integer; overload;
CompareFilenamesIgnoreCasenull30 function CompareFilenamesIgnoreCase(const Filename1, Filename2: string): integer;
CompareFilenameStartsnull31 function CompareFilenameStarts(const Filename1, Filename2: string): integer;
CompareFilenamesnull32 function CompareFilenames(Filename1: PChar; Len1: integer;
33 Filename2: PChar; Len2: integer): integer; overload;
CompareFilenamesPnull34 function CompareFilenamesP(Filename1, Filename2: PChar; IgnoreCase: boolean=false): integer;
CompareFileExtnull35 function CompareFileExt(const Filename: string; Ext: string; CaseSensitive: boolean): integer;
CompareFileExtnull36 function CompareFileExt(const Filename, Ext: string): integer;
FilenameExtIsnull37 function FilenameExtIs(const Filename,Ext: string; CaseSensitive: boolean=false): boolean;
FilenameExtInnull38 function FilenameExtIn(const Filename: string; Exts: array of string;
39 CaseSensitive: boolean=false): boolean;
40
DirPathExistsnull41 function DirPathExists(DirectoryName: string): boolean;
DirectoryIsWritablenull42 function DirectoryIsWritable(const DirectoryName: string): boolean;
ExtractFileNameOnlynull43 function ExtractFileNameOnly(const AFilename: string): string;
ExtractFileNameWithoutExtnull44 function ExtractFileNameWithoutExt(const AFilename: string): string;
FilenameIsAbsolutenull45 function FilenameIsAbsolute(const TheFilename: string):boolean;
FilenameIsWinAbsolutenull46 function FilenameIsWinAbsolute(const TheFilename: string):boolean;
FilenameIsUnixAbsolutenull47 function FilenameIsUnixAbsolute(const TheFilename: string):boolean;
ForceDirectorynull48 function ForceDirectory(DirectoryName: string): boolean;
49 procedure CheckIfFileIsExecutable(const AFilename: string);
50 procedure CheckIfFileIsSymlink(const AFilename: string);
FileIsExecutablenull51 function FileIsExecutable(const AFilename: string): boolean;
FileIsSymlinknull52 function FileIsSymlink(const AFilename: string): boolean;
FileIsHardLinknull53 function FileIsHardLink(const AFilename: string): boolean;
FileIsReadablenull54 function FileIsReadable(const AFilename: string): boolean;
FileIsWritablenull55 function FileIsWritable(const AFilename: string): boolean;
FileIsTextnull56 function FileIsText(const AFilename: string): boolean;
FileIsTextnull57 function FileIsText(const AFilename: string; out FileReadable: boolean): boolean;
FilenameIsTrimmednull58 function FilenameIsTrimmed(const TheFilename: string): boolean;
FilenameIsTrimmednull59 function FilenameIsTrimmed(StartPos: PChar; NameLen: integer): boolean;
TrimFilenamenull60 function TrimFilename(const AFilename: string): string;
ResolveDotsnull61 function ResolveDots(const AFilename: string): string;
CleanAndExpandFilenamenull62 function CleanAndExpandFilename(const Filename: string): string; // empty string returns current directory
CleanAndExpandDirectorynull63 function CleanAndExpandDirectory(const Filename: string): string; // empty string returns current directory
TrimAndExpandFilenamenull64 function TrimAndExpandFilename(const Filename: string; const BaseDir: string = ''): string; // empty string returns empty string
TrimAndExpandDirectorynull65 function TrimAndExpandDirectory(const Filename: string; const BaseDir: string = ''): string; // empty string returns empty string
CreateAbsolutePathnull66 function CreateAbsolutePath(const Filename, BaseDirectory: string): string;
TryCreateRelativePathnull67 function TryCreateRelativePath(const Dest, Source: String; UsePointDirectory: boolean;
68 AlwaysRequireSharedBaseFolder: Boolean; out RelPath: String): Boolean;
CreateRelativePathnull69 function CreateRelativePath(const Filename, BaseDirectory: string;
70 UsePointDirectory: boolean = false; AlwaysRequireSharedBaseFolder: Boolean = True): string;
FileIsInPathnull71 function FileIsInPath(const Filename, Path: string): boolean;
PathIsInPathnull72 function PathIsInPath(const Path, Directory: string): boolean;
73 // Storten a file name for display.
ShortDisplayFilenamenull74 function ShortDisplayFilename(const aFileName: string; aLimit: Integer = 80): string;
75
76 type
77 TPathDelimSwitch = (
78 pdsNone, // no change
79 pdsSystem, // switch to current PathDelim
80 pdsUnix, // switch to slash /
81 pdsWindows // switch to backslash \
82 );
83 const
84 PathDelimSwitchToDelim: array[TPathDelimSwitch] of char = (
85 PathDelim, // pdsNone
86 PathDelim, // pdsSystem
87 '/', // pdsUnix
88 '\' // pdsWindows
89 );
90
91 // Path delimiters
92 procedure ForcePathDelims(Var FileName: string);
GetForcedPathDelimsnull93 function GetForcedPathDelims(const FileName: string): string;
AppendPathDelimnull94 function AppendPathDelim(const Path: string): string;
ChompPathDelimnull95 function ChompPathDelim(const Path: string): string;
SwitchPathDelimsnull96 function SwitchPathDelims(const Filename: string; Switch: TPathDelimSwitch): string;
SwitchPathDelimsnull97 function SwitchPathDelims(const Filename: string; Switch: boolean): string;
CheckPathDelimnull98 function CheckPathDelim(const OldPathDelim: string; out Changed: boolean): TPathDelimSwitch;
IsCurrentPathDelimnull99 function IsCurrentPathDelim(Switch: TPathDelimSwitch): boolean;
100
101 // search paths
CreateAbsoluteSearchPathnull102 function CreateAbsoluteSearchPath(const SearchPath, BaseDirectory: string): string;
CreateRelativeSearchPathnull103 function CreateRelativeSearchPath(const SearchPath, BaseDirectory: string): string;
MinimizeSearchPathnull104 function MinimizeSearchPath(const SearchPath: string): string;
FindPathInSearchPathnull105 function FindPathInSearchPath(APath: PChar; APathLen: integer;
106 SearchPath: PChar; SearchPathLen: integer): PChar; overload;
FindPathInSearchPathnull107 function FindPathInSearchPath(const APath, SearchPath: string): integer; overload;
108
109 // file operations
FileExistsUTF8null110 function FileExistsUTF8(const Filename: string): boolean;
FileAgeUTF8null111 function FileAgeUTF8(const FileName: string): Longint;
DirectoryExistsUTF8null112 function DirectoryExistsUTF8(const Directory: string): Boolean;
ExpandFileNameUTF8null113 function ExpandFileNameUTF8(const FileName: string; {const} BaseDir: string = ''): string;
FindFirstUTF8null114 function FindFirstUTF8(const Path: string; Attr: Longint; out Rslt: TSearchRec): Longint;
FindNextUTF8null115 function FindNextUTF8(var Rslt: TSearchRec): Longint;
116 procedure FindCloseUTF8(var F: TSearchrec); inline;
FileSetDateUTF8null117 function FileSetDateUTF8(const FileName: String; Age: Longint): Longint;
FileGetAttrUTF8null118 function FileGetAttrUTF8(const FileName: String): Longint;
FileSetAttrUTF8null119 function FileSetAttrUTF8(const Filename: String; Attr: longint): Longint;
DeleteFileUTF8null120 function DeleteFileUTF8(const FileName: String): Boolean;
RenameFileUTF8null121 function RenameFileUTF8(const OldName, NewName: String): Boolean;
FileSearchUTF8null122 function FileSearchUTF8(const Name, DirList : String; ImplicitCurrentDir : Boolean = True): String;
FileIsReadOnlyUTF8null123 function FileIsReadOnlyUTF8(const FileName: String): Boolean;
GetCurrentDirUTF8null124 function GetCurrentDirUTF8: String;
SetCurrentDirUTF8null125 function SetCurrentDirUTF8(const NewDir: String): Boolean;
CreateDirUTF8null126 function CreateDirUTF8(const NewDir: String): Boolean;
RemoveDirUTF8null127 function RemoveDirUTF8(const Dir: String): Boolean;
ForceDirectoriesUTF8null128 function ForceDirectoriesUTF8(const Dir: string): Boolean;
129
FileOpenUTF8null130 function FileOpenUTF8(Const FileName : string; Mode : Integer) : THandle;
FileCreateUTF8null131 function FileCreateUTF8(Const FileName : string) : THandle; overload;
FileCreateUTF8null132 function FileCreateUTF8(Const FileName : string; Rights: Cardinal) : THandle; overload;
FileCreateUtf8null133 Function FileCreateUtf8(Const FileName : String; ShareMode : Integer; Rights : Cardinal) : THandle; overload;
134
FileSizeUtf8null135 function FileSizeUtf8(const Filename: string): int64;
GetFileDescriptionnull136 function GetFileDescription(const AFilename: string): string;
ReadAllLinksnull137 function ReadAllLinks(const Filename: string;
138 {%H-}ExceptionOnError: boolean): string; // if a link is broken returns ''
TryReadAllLinksnull139 function TryReadAllLinks(const Filename: string): string; // if a link is broken returns Filename
GetShellLinkTargetnull140 function GetShellLinkTarget(const FileName: string): string;
141
142 // for debugging
DbgSFileAttrnull143 function DbgSFileAttr(Attr: LongInt): String;
144
145
146 type
147 TPhysicalFilenameOnError = (pfeException,pfeEmpty,pfeOriginal);
GetPhysicalFilenamenull148 function GetPhysicalFilename(const Filename: string;
149 OnError: TPhysicalFilenameOnError): string;
150 {$IFDEF Unix}
GetUnixPhysicalFilenamenull151 function GetUnixPhysicalFilename(const Filename: string;
152 ExceptionOnError: boolean): string; // if a link is broken returns ''
153 {$ENDIF}
154
GetAppConfigDirUTF8null155 function GetAppConfigDirUTF8(Global: Boolean; Create: boolean = false): string;
GetAppConfigFileUTF8null156 function GetAppConfigFileUTF8(Global: Boolean; SubDir: boolean = false;
157 CreateDir: boolean = false): string;
GetTempFileNameUTF8null158 function GetTempFileNameUTF8(const Dir, Prefix: String): String;
159
160 // UNC paths
IsUNCPathnull161 function IsUNCPath(const {%H-}Path: String): Boolean;
ExtractUNCVolumenull162 function ExtractUNCVolume(const {%H-}Path: String): String;
ExtractFileRootnull163 function ExtractFileRoot(FileName: String): String;
164
165 // darwin paths
166 {$IFDEF darwin}
GetDarwinSystemFilenamenull167 function GetDarwinSystemFilename(Filename: string): string;
GetDarwinNormalizedFilenamenull168 function GetDarwinNormalizedFilename(Filename: string; nForm:Integer=2): string;
169 {$ENDIF}
170
171 // windows paths
172 {$IFDEF windows}
SHGetFolderPathUTF8null173 function SHGetFolderPathUTF8(ID : Integer) : String;
174 {$ENDIF}
175
176 // Command line
177 procedure SplitCmdLineParams(const Params: string; ParamList: TStrings;
178 ReadBackslash: boolean = false);
StrToCmdLineParamnull179 function StrToCmdLineParam(const Param: string): string;
MergeCmdLineParamsnull180 function MergeCmdLineParams(ParamList: TStrings): string;
181 // ToDo: Study if they are needed or if the above functions could be used instead.
182 procedure SplitCmdLine(const CmdLine: string;
183 out ProgramFilename, Params: string);
PrepareCmdLineOptionnull184 function PrepareCmdLineOption(const Option: string): string;
185
186
187 type
188 TInvalidateFileStateCacheEvent = procedure(const Filename: string);
189 var
190 OnInvalidateFileStateCache: TInvalidateFileStateCacheEvent = nil;
191 procedure InvalidateFileStateCache(const Filename: string = ''); inline;
192
193 implementation
194
195 // to get more detailed error messages consider the os
196 uses
197 {$IFDEF Windows}
198 Windows {$IFnDEF WinCE}, ShlObj, ActiveX, WinDirs{$ENDIF};
199 {$ELSE}
200 {$IFDEF HASAMIGA}
201 exec, amigados;
202 {$ELSE}
203 {$IFDEF darwin}
204 MacOSAll,
205 {$ENDIF}
206 Unix, BaseUnix;
207 {$ENDIF}
208 {$ENDIF}
209
210 {$I lazfileutils.inc}
211 {$IFDEF windows}
212 {$I winlazfileutils.inc}
213 {$ELSE}
214 {$IFDEF HASAMIGA}
215 {$I amigalazfileutils.inc}
216 {$ELSE}
217 {$I unixlazfileutils.inc}
218 {$ENDIF}
219 {$ENDIF}
220
CompareFilenamesnull221 function CompareFilenames(const Filename1, Filename2: string): integer;
222 {$IFDEF darwin}
223 var
224 F1: CFStringRef;
225 F2: CFStringRef;
226 {$ENDIF}
227 begin
228 {$IFDEF darwin}
229 if Filename1=Filename2 then exit(0);
230 if (Filename1='') or (Filename2='') then
231 exit(length(Filename2)-length(Filename1));
232 F1:=CFStringCreateWithCString(nil,Pointer(Filename1),kCFStringEncodingUTF8);
233 F2:=CFStringCreateWithCString(nil,Pointer(Filename2),kCFStringEncodingUTF8);
234 Result:=CFStringCompare(F1,F2,kCFCompareNonliteral
235 {$IFDEF CaseInsensitiveFilenames}+kCFCompareCaseInsensitive{$ENDIF});
236 CFRelease(F1);
237 CFRelease(F2);
238 {$ELSE}
239 {$IFDEF CaseInsensitiveFilenames}
240 Result:=UTF8CompareText(Filename1, Filename2);
241 {$ELSE}
242 Result:=CompareStr(Filename1, Filename2);
243 {$ENDIF}
244 {$ENDIF}
245 end;
246
CompareFilenamesIgnoreCasenull247 function CompareFilenamesIgnoreCase(const Filename1, Filename2: string): integer;
248 {$IFDEF darwin}
249 var
250 F1: CFStringRef;
251 F2: CFStringRef;
252 {$ENDIF}
253 begin
254 {$IFDEF darwin}
255 if Filename1=Filename2 then exit(0);
256 F1:=CFStringCreateWithCString(nil,Pointer(Filename1),kCFStringEncodingUTF8);
257 F2:=CFStringCreateWithCString(nil,Pointer(Filename2),kCFStringEncodingUTF8);
258 Result:=CFStringCompare(F1,F2,kCFCompareNonliteral+kCFCompareCaseInsensitive);
259 CFRelease(F1);
260 CFRelease(F2);
261 {$ELSE}
262 // AnsiCompareText uses UTF8CompareText on Windows, elsewhere system string manager.
263 Result:=AnsiCompareText(Filename1, Filename2);
264 {$ENDIF}
265 end;
266
CompareFilenameStartsnull267 function CompareFilenameStarts(const Filename1, Filename2: string): integer;
268 var
269 len1: Integer;
270 len2: Integer;
271 begin
272 len1:=length(Filename1);
273 len2:=length(Filename2);
274 if len1=len2 then begin
275 Result:=CompareFilenames(Filename1,Filename2);
276 exit;
277 end else if len1>len2 then
278 Result:=CompareFilenames(copy(Filename1,1,len2),Filename2)
279 else
280 Result:=CompareFilenames(Filename1,copy(Filename2,1,len1));
281 if Result<>0 then exit;
282 if len1<len2 then
283 Result:=-1
284 else
285 Result:=1;
286 end;
287
CompareFilenamesnull288 function CompareFilenames(Filename1: PChar; Len1: integer; Filename2: PChar;
289 Len2: integer): integer;
290 var
291 {$IFDEF NotLiteralFilenames}
292 File1: string;
293 File2: string;
294 {$ELSE}
295 i: Integer;
296 {$ENDIF}
297 begin
298 if (Len1=0) or (Len2=0) then begin
299 Result:=Len1-Len2;
300 exit;
301 end;
302 {$IFDEF NotLiteralFilenames}
303 SetLength(File1,Len1);
304 System.Move(Filename1^,File1[1],Len1);
305 SetLength(File2,Len2);
306 System.Move(Filename2^,File2[1],Len2);
307 Result:=CompareFilenames(File1,File2);
308 {$ELSE}
309 Result:=0;
310 i:=0;
311 while (Result=0) and ((i<Len1) and (i<Len2)) do begin
312 Result:=Ord(Filename1[i])
313 -Ord(Filename2[i]);
314 Inc(i);
315 end;
316 if Result=0 Then
317 Result:=Len1-Len2;
318 {$ENDIF}
319 end;
320
CompareFilenamesPnull321 function CompareFilenamesP(Filename1, Filename2: PChar; IgnoreCase: boolean): integer;
322 {$IFDEF darwin}
323 var
324 F1: CFStringRef;
325 F2: CFStringRef;
326 Flags: CFStringCompareFlags;
327 {$ENDIF}
328 begin
329 if (Filename1=nil) or (Filename1^=#0) then begin
330 if (Filename2=nil) or (Filename2^=#0) then begin
331 // both empty
332 exit(0);
333 end else begin
334 // filename1 empty, filename2 not empty
335 exit(-1);
336 end;
337 end else if (Filename2=nil) or (Filename2^=#0) then begin
338 // filename1 not empty, filename2 empty
339 exit(1);
340 end;
341
342 {$IFDEF CaseInsensitiveFilenames}
343 // this platform is by default case insensitive
344 IgnoreCase:=true;
345 {$ENDIF}
346 {$IFDEF darwin}
347 F1:=CFStringCreateWithCString(nil,Pointer(Filename1),kCFStringEncodingUTF8);
348 F2:=CFStringCreateWithCString(nil,Pointer(Filename2),kCFStringEncodingUTF8);
349 Flags:=kCFCompareNonliteral;
350 if IgnoreCase then Flags+=kCFCompareCaseInsensitive;
351 Result:=CFStringCompare(F1,F2,Flags);
352 CFRelease(F1);
353 CFRelease(F2);
354 {$ELSE}
355 if IgnoreCase then // compare case insensitive
356 Result:=UTF8CompareTextP(Filename1, Filename2)
357 else begin
358 // compare literally
359 while (Filename1^=Filename2^) and (Filename1^<>#0) do begin
360 Inc(Filename1);
361 Inc(Filename2);
362 end;
363 Result:=ord(Filename1^)-ord(Filename2^);
364 end;
365 {$ENDIF}
366 end;
367
CompareFileExtnull368 function CompareFileExt(const Filename: string; Ext: string; CaseSensitive: boolean): integer;
369 // Ext can contain a point or not
370 var
371 FnExt: String;
372 FnPos: integer;
373 begin
374 // Filename
375 FnPos := length(Filename);
376 while (FnPos>=1) and (Filename[FnPos]<>'.') do dec(FnPos);
377 if FnPos < 1 then
378 exit(1); // no extension in filename
379 FnExt := Copy(Filename, FnPos+1, length(FileName)); // FnPos+1 skips point
380 // Ext
381 if (length(Ext) > 1) and (Ext[1] = '.') then
382 Delete(Ext, 1, 1);
383 // compare extensions
384 if CaseSensitive then
385 Result := CompareStr(FnExt, Ext)
386 else
387 Result := UTF8CompareLatinTextFast(FnExt, Ext);
388 if Result < 0 then
389 Result := -1
390 else if Result > 0 then
391 Result := 1;
392 end;
393
CompareFileExtnull394 function CompareFileExt(const Filename, Ext: string): integer;
395 begin
396 Result := CompareFileExt(Filename, Ext,
397 {$IFDEF CaseInsensitiveFilenames} False {$ELSE} True {$ENDIF} );
398 end;
399
FilenameExtIsnull400 function FilenameExtIs(const Filename, Ext: string; CaseSensitive: boolean): boolean;
401 // Return True if Filename has an extension Ext.
402 // Ext can contain a point or not. Case-insensitive comparison supports only ASCII.
403 var
404 FnExtLen, ExtLen: integer;
405 FnStart, FnEnd, FnP, ExtP: PChar;
406 begin
407 // Filename
408 FnStart := PChar(Filename);
409 FnEnd := FnStart + Length(Filename) - 1;
410 FnP := FnEnd;
411 while (FnP >= FnStart) and (FnP^ <> '.') do
412 Dec(FnP);
413 if FnP < FnStart then
414 exit(False); // no extension in filename
415 Inc(FnP); // Skip '.' in Filename
416 FnExtLen := 1 + FnEnd - FnP;
417 // Ext
418 ExtLen := Length(Ext);
419 ExtP := PChar(Ext);
420 if ExtP^ = '.' then
421 begin
422 Inc(ExtP); // Skip '.' in Ext
423 Dec(ExtLen);
424 end;
425 if ExtLen <> FnExtLen then
426 exit(False); // Ext has different length than Filename's extension
427 // compare extensions
428 if CaseSensitive then
429 Result := StrLComp(ExtP, FnP, ExtLen) = 0
430 else
431 Result := StrLIComp(ExtP, FnP, ExtLen) = 0
432 end;
433
434 function FilenameExtIn(const Filename: string; Exts: array of string;
435 CaseSensitive: boolean): boolean;
436 // Return True if Filename's extension is one of Exts.
437 // Ext can contain a point or not. Case-insensitive comparison supports only ASCII.
438 var
439 FnExtLen, ExtLen, i: integer;
440 FnStart, FnEnd, FnP, ExtP: PChar;
441 begin
442 // Filename
443 FnStart := PChar(Filename);
444 FnEnd := FnStart + Length(Filename) - 1;
445 FnP := FnEnd;
446 while (FnP >= FnStart) and (FnP^ <> '.') do
447 Dec(FnP);
448 if FnP < FnStart then
449 exit(False); // no extension in filename
450 Inc(FnP); // Skip '.' in Filename
451 FnExtLen := 1 + FnEnd - FnP;
452 // Extensions
453 for i := low(Exts) to high(Exts) do
454 begin
455 ExtLen := Length(Exts[i]);
456 ExtP := PChar(Exts[i]);
457 if ExtP^ = '.' then
458 begin
459 Inc(ExtP); // Skip '.' in Ext
460 Dec(ExtLen);
461 end;
462 if ExtLen <> FnExtLen then
463 continue; // Ext has different length than Filename's extension
464 // compare extensions
465 if CaseSensitive then
466 Result := StrLComp(ExtP, FnP, ExtLen) = 0
467 else
468 Result := StrLIComp(ExtP, FnP, ExtLen) = 0;
469 if Result then exit;
470 end;
471 Result := False;
472 end;
473
474 {$IFDEF darwin}
475 function GetDarwinSystemFilename(Filename: string): string;
476 var
477 s: CFStringRef;
478 l: CFIndex;
479 begin
480 if Filename='' then exit('');
481 s:=CFStringCreateWithCString(nil,Pointer(Filename),kCFStringEncodingUTF8);
482 l:=CFStringGetMaximumSizeOfFileSystemRepresentation(s);
483 SetLength(Result,l);
484 if Result<>'' then begin
485 CFStringGetFileSystemRepresentation(s,@Result[1],length(Result));
486 SetLength(Result,StrLen(PChar(Result)));
487 end;
488 CFRelease(s);
489 end;
490
491 // borrowed from CarbonProcs
492 function CFStringToStr(AString: CFStringRef; Encoding: CFStringEncoding): String;
493 var
494 Str: Pointer;
495 StrSize: CFIndex;
496 StrRange: CFRange;
497 begin
498 if AString = nil then
499 begin
500 Result := '';
501 Exit;
502 end;
503
504 // Try the quick way first
505 Str := CFStringGetCStringPtr(AString, Encoding);
506 if Str <> nil then
507 Result := PChar(Str)
508 else
509 begin
510 // if that doesn't work this will
511 StrRange.location := 0;
512 StrRange.length := CFStringGetLength(AString);
513
514 CFStringGetBytes(AString, StrRange, Encoding,
515 Ord('?'), False, nil, 0, StrSize{%H-});
516 SetLength(Result, StrSize);
517
518 if StrSize > 0 then
519 CFStringGetBytes(AString, StrRange, Encoding,
520 Ord('?'), False, @Result[1], StrSize, StrSize);
521 end;
522 end;
523
524 //NForm can be one of
525 //kCFStringNormalizationFormD = 0; // Canonical Decomposition
526 //kCFStringNormalizationFormKD = 1; // Compatibility Decomposition
527 //kCFStringNormalizationFormC = 2; // Canonical Decomposition followed by Canonical Composition
528 //kCFStringNormalizationFormKC = 3; // Compatibility Decomposition followed by Canonical Composition
GetDarwinNormalizedFilenamenull529 function GetDarwinNormalizedFilename(Filename: string; nForm:Integer=2): string;
530 var
531 theString: CFStringRef;
532 Mutable: CFMutableStringRef;
533 begin
534 theString:=CFStringCreateWithCString(nil, Pointer(FileName), kCFStringEncodingUTF8);
535 Mutable := CFStringCreateMutableCopy(nil, 0, theString);
536 if (NForm<0) or (NForm>3) then NForm := kCFStringNormalizationFormC;
537 CFStringNormalize(Mutable, NForm);
538 Result := CFStringToStr(Mutable, kCFStringEncodingUTF8);
539 CFRelease(Mutable);
540 CFRelease(theString);
541 end;
542
543 {$ENDIF}
544
ExtractFileNameOnlynull545 function ExtractFileNameOnly(const AFilename: string): string;
546 var
547 StartPos: Integer;
548 ExtPos: Integer;
549 begin
550 StartPos:=length(AFilename)+1;
551 while (StartPos>1)
552 and not (AFilename[StartPos-1] in AllowDirectorySeparators)
553 {$IF defined(Windows) or defined(HASAMIGA)}and (AFilename[StartPos-1]<>':'){$ENDIF}
554 do
555 dec(StartPos);
556 ExtPos:=length(AFilename);
557 while (ExtPos>=StartPos) and (AFilename[ExtPos]<>'.') do
558 dec(ExtPos);
559 if (ExtPos<StartPos) then ExtPos:=length(AFilename)+1;
560 Result:=copy(AFilename,StartPos,ExtPos-StartPos);
561 end;
562
ExtractFileNameWithoutExtnull563 function ExtractFileNameWithoutExt(const AFilename: string): string;
564 var
565 p: Integer;
566 begin
567 Result:=AFilename;
568 p:=length(Result);
569 while (p>0) do begin
570 case Result[p] of
571 PathDelim: exit;
572 {$ifdef windows}
573 '/': if ('/' in AllowDirectorySeparators) then exit;
574 {$endif}
575 '.': exit(copy(Result,1, p-1));
576 end;
577 dec(p);
578 end;
579 end;
580
DirPathExistsnull581 function DirPathExists(DirectoryName: string): boolean;
582 begin
583 Result:=DirectoryExistsUTF8(ChompPathDelim(DirectoryName));
584 end;
585
DirectoryIsWritablenull586 function DirectoryIsWritable(const DirectoryName: string): boolean;
587 var
588 TempFilename: String;
589 s: String;
590 fHandle: THANDLE;
591 begin
592 Result:=false;
593 if not DirPathExists(DirectoryName) then exit;
594 TempFilename:=SysUtils.GetTempFilename(AppendPathDelim(DirectoryName),'tstperm');
595 fHandle := FileCreateUtf8(TempFileName, fmCreate, 438);
596 if (THandle(fHandle) <> feInvalidHandle) then
597 begin
598 s:='WriteTest';
599 if FileWrite(fHandle,S[1],Length(S)) > 0 then Result := True;
600 FileClose(fHandle);
601 if not DeleteFileUTF8(TempFilename) then
602 InvalidateFileStateCache(TempFilename);
603 end;
604 end;
605
ForceDirectorynull606 function ForceDirectory(DirectoryName: string): boolean;
607 var
608 i: integer;
609 Dir: string;
610 begin
611 DirectoryName:=AppendPathDelim(DirectoryName);
612 i:=1;
613 while i<=length(DirectoryName) do begin
614 if DirectoryName[i] in AllowDirectorySeparators then begin
615 // optimize paths like \foo\\bar\\foobar
616 while (i<length(DirectoryName)) and (DirectoryName[i+1] in AllowDirectorySeparators) do
617 Delete(DirectoryName,i+1,1);
618 Dir:=copy(DirectoryName,1,i-1);
619 if (Dir<>'') and not DirPathExists(Dir) then begin
620 Result:=CreateDirUTF8(Dir);
621 if not Result then exit;
622 end;
623 end;
624 inc(i);
625 end;
626 Result:=true;
627 end;
628
FileIsTextnull629 function FileIsText(const AFilename: string): boolean;
630 var
631 FileReadable: Boolean;
632 begin
633 Result:=FileIsText(AFilename,FileReadable);
634 if FileReadable then ;
635 end;
636
FileIsTextnull637 function FileIsText(const AFilename: string; out FileReadable: boolean): boolean;
638 var
639 Buf: string;
640 Len: integer;
641 p: PChar;
642 ZeroAllowed: Boolean;
643 fHandle: THandle;
644 const
645 BufSize = 2048;
646 begin
647 Result:=false;
648 FileReadable:=true;
649 fHandle := FileOpenUtf8(AFileName, fmOpenRead or fmShareDenyNone);
650 if (THandle(fHandle) <> feInvalidHandle) then
651 begin
652 try
653 Len:=BufSize;
654 SetLength(Buf{%H-},Len+1);
655 Len := FileRead(fHandle,Buf[1],Len);
656
657 if Len>0 then begin
658 Buf[Len+1]:=#0;
659 p:=PChar(Buf);
660 ZeroAllowed:=false;
661 if (p[0]=#$EF) and (p[1]=#$BB) and (p[2]=#$BF) then begin
662 // UTF-8 BOM (Byte Order Mark)
663 inc(p,3);
664 end else if (p[0]=#$FF) and (p[1]=#$FE) then begin
665 // ucs-2le BOM FF FE
666 inc(p,2);
667 ZeroAllowed:=true;
668 end else if (p[0]=#$FE) and (p[1]=#$FF) then begin
669 // ucs-2be BOM FE FF
670 inc(p,2);
671 ZeroAllowed:=true;
672 end;
673 while true do begin
674 case p^ of
675 #0:
676 if p-PChar(Buf)>=Len then
677 break
678 else if not ZeroAllowed then
679 exit;
680 // #10,#13: new line
681 // #12: form feed
682 // #26: end of file
683 #1..#8,#11,#14..#25,#27..#31: exit;
684 end;
685 inc(p);
686 end;
687 Result:=true;
688 end else
689 Result:=true;
690 finally
691 FileClose(fHandle);
692 end
693 end
694 else
695 FileReadable := False;
696 end;
697
FilenameIsTrimmednull698 function FilenameIsTrimmed(const TheFilename: string): boolean;
699 begin
700 Result:=FilenameIsTrimmed(PChar(Pointer(TheFilename)),// pointer type cast avoids #0 check
701 length(TheFilename));
702 end;
703
FilenameIsTrimmednull704 function FilenameIsTrimmed(StartPos: PChar; NameLen: integer): boolean;
705 var
706 i: Integer;
707 c: Char;
708 begin
709 Result:=false;
710 if NameLen<=0 then begin
711 Result:=true;
712 exit;
713 end;
714 // check heading spaces
715 if StartPos[0]=' ' then exit;
716 // check trailing spaces
717 if StartPos[NameLen-1]=' ' then exit;
718 // check ./ at start
719 if (StartPos[0]='.') and (StartPos[1] in AllowDirectorySeparators) then exit;
720 i:=0;
721 while i<NameLen do begin
722 c:=StartPos[i];
723 if not (c in AllowDirectorySeparators) then
724 inc(i)
725 else begin
726 if c<>PathDelim then exit;
727 inc(i);
728 if i=NameLen then break;
729
730 // check for double path delimiter
731 if (StartPos[i] in AllowDirectorySeparators) then exit;
732
733 if (StartPos[i]='.') and (i>0) then begin
734 inc(i);
735 // check /./ or /. at end
736 if (StartPos[i] in AllowDirectorySeparators) or (i=NameLen) then exit;
737 if StartPos[i]='.' then begin
738 inc(i);
739 // check /../ or /.. at end
740 if (StartPos[i] in AllowDirectorySeparators) or (i=NameLen) then exit;
741 end;
742 end;
743 end;
744 end;
745 Result:=true;
746 end;
747
TrimFilenamenull748 function TrimFilename(const AFilename: string): string;
749 //Trim leading and trailing spaces
750 //then call ResolveDots to trim double path delims and expand special dirs like .. and .
751 var
752 Len, Start: Integer;
753 begin
754 Result := AFileName;
755 Len := Length(AFileName);
756 if (Len = 0) or FilenameIsTrimmed(Result) then exit;
757 if AFilename[1] = #32 then
758 begin
759 Start := 1;
760 while (Start <= Len) and (AFilename[Start] = #32) do Inc(Start);
761 System.Delete(Result,1,Start-1);
762 Len := Length(Result);
763 end;
764 while (Len > 0) and (Result[Len] = #32) do Dec(Len);
765 SetLength(Result, Len);
766 Result := ResolveDots(Result);
767 end;
768
769 {------------------------------------------------------------------------------
770 function CleanAndExpandFilename(const Filename: string): string;
771 ------------------------------------------------------------------------------}
CleanAndExpandFilenamenull772 function CleanAndExpandFilename(const Filename: string): string;
773 begin
774 Result:=ExpandFileNameUTF8(TrimFileName(Filename));
775 end;
776
777 {------------------------------------------------------------------------------
778 function CleanAndExpandDirectory(const Filename: string): string;
779 ------------------------------------------------------------------------------}
CleanAndExpandDirectorynull780 function CleanAndExpandDirectory(const Filename: string): string;
781 begin
782 Result:=AppendPathDelim(CleanAndExpandFilename(Filename));
783 end;
784
TrimAndExpandFilenamenull785 function TrimAndExpandFilename(const Filename: string; const BaseDir: string): string;
786 begin
787 Result:=ChompPathDelim(TrimFilename(Filename));
788 if Result='' then exit;
789 Result:=TrimFilename(ExpandFileNameUTF8(Result,BaseDir));
790 end;
791
TrimAndExpandDirectorynull792 function TrimAndExpandDirectory(const Filename: string; const BaseDir: string): string;
793 begin
794 Result:=TrimFilename(Filename);
795 if Result='' then exit;
796 Result:=TrimFilename(AppendPathDelim(ExpandFileNameUTF8(Result,BaseDir)));
797 end;
798
FileIsInPathnull799 function FileIsInPath(const Filename, Path: string): boolean;
800 var
801 ExpFile: String;
802 ExpPath: String;
803 l: integer;
804 begin
805 if Path='' then exit(false);
806 ExpFile:=ResolveDots(Filename);
807 ExpPath:=AppendPathDelim(ResolveDots(Path));
808 l:=length(ExpPath);
809 Result:=(l>0) and (length(ExpFile)>l) and (ExpFile[l]=PathDelim)
810 and (CompareFilenames(ExpPath,LeftStr(ExpFile,l))=0);
811 end;
812
PathIsInPathnull813 function PathIsInPath(const Path, Directory: string): boolean;
814 // Note: Under Windows this treats C: as C:\
815 var
816 ExpPath: String;
817 ExpDir: String;
818 l: integer;
819 begin
820 if Path='' then exit(false);
821 ExpPath:=AppendPathDelim(ResolveDots(Path));
822 ExpDir:=AppendPathDelim(ResolveDots(Directory));
823 l:=length(ExpDir);
824 Result:=(l>0) and (length(ExpPath)>=l) and (ExpPath[l]=PathDelim)
825 and (CompareFilenames(ExpDir,LeftStr(ExpPath,l))=0);
826 end;
827
ShortDisplayFilenamenull828 function ShortDisplayFilename(const aFileName: string; aLimit: Integer): string;
829 // Shorten a long filename for display.
830 // Add '...' after the 2. path delimiter, then the end part of filename.
831 var
832 StartLen, EndLen, SepCnt: Integer;
833 begin
834 if Length(aFileName) > aLimit then
835 begin
836 StartLen := 1;
837 SepCnt := 0;
838 while StartLen < Length(aFileName) - (aLimit div 2) do
839 begin
840 if aFileName[StartLen] in AllowDirectorySeparators then
841 begin
842 Inc(SepCnt);
843 if SepCnt = 2 then Break;
844 end;
845 Inc(StartLen);
846 end;
847 EndLen := aLimit - StartLen - 3;
848 Result := Copy(aFileName, 1, StartLen) + '...'
849 + Copy(aFileName, Length(aFileName)-EndLen+1, EndLen);
850 end
851 else
852 Result := aFileName;
853 end;
854
855
856 // Path delimiters
857
858 procedure ForcePathDelims(var FileName: string);
859 var
860 i: Integer;
861 begin
862 for i:=1 to length(FileName) do
863 {$IFDEF Windows}
864 if Filename[i]='/' then
865 Filename[i]:='\';
866 {$ELSE}
867 if Filename[i]='\' then
868 Filename[i]:='/';
869 {$ENDIF}
870 end;
871
GetForcedPathDelimsnull872 function GetForcedPathDelims(const FileName: string): string;
873 begin
874 Result:=FileName;
875 ForcePathDelims(Result);
876 end;
877
AppendPathDelimnull878 function AppendPathDelim(const Path: string): string;
879 begin
880 if (Path<>'') and not (Path[length(Path)] in AllowDirectorySeparators) then
881 Result:=Path+PathDelim
882 else
883 Result:=Path;
884 end;
885
ChompPathDelimnull886 function ChompPathDelim(const Path: string): string;
887 var
888 Len, MinLen: Integer;
889 begin
890 Result:=Path;
891 if Path = '' then
892 exit;
893 Len:=length(Result);
894 if (Result[1] in AllowDirectorySeparators) then begin
895 MinLen := 1;
896 {$IFDEF HasUNCPaths}
897 if (Len >= 2) and (Result[2] in AllowDirectorySeparators) then
898 MinLen := 2; // keep UNC '\\', chomp 'a\' to 'a'
899 {$ENDIF}
900 end
901 else begin
902 MinLen := 0;
903 {$IFdef MSWindows}
904 if (Len >= 3) and (Result[1] in ['a'..'z', 'A'..'Z']) and
905 (Result[2] = ':') and (Result[3] in AllowDirectorySeparators)
906 then
907 MinLen := 3;
908 {$ENDIF}
909 end;
910
911 while (Len > MinLen) and (Result[Len] in AllowDirectorySeparators) do dec(Len);
912 if Len<length(Result) then
913 SetLength(Result,Len);
914 end;
915
SwitchPathDelimsnull916 function SwitchPathDelims(const Filename: string; Switch: TPathDelimSwitch): string;
917 var
918 i: Integer;
919 p: Char;
920 begin
921 Result:=Filename;
922 case Switch of
923 pdsSystem: p:=PathDelim;
924 pdsUnix: p:='/';
925 pdsWindows: p:='\';
926 else exit;
927 end;
928 for i:=1 to length(Result) do
929 if Result[i] in ['/','\'] then
930 Result[i]:=p;
931 end;
932
SwitchPathDelimsnull933 function SwitchPathDelims(const Filename: string; Switch: boolean): string;
934 begin
935 if Switch then
936 Result:=SwitchPathDelims(Filename,pdsSystem)
937 else
938 Result:=Filename;
939 end;
940
CheckPathDelimnull941 function CheckPathDelim(const OldPathDelim: string; out Changed: boolean): TPathDelimSwitch;
942 begin
943 Changed:=OldPathDelim<>PathDelim;
944 if Changed then begin
945 if OldPathDelim='/' then
946 Result:=pdsUnix
947 else if OldPathDelim='\' then
948 Result:=pdsWindows
949 else
950 Result:=pdsSystem;
951 end else begin
952 Result:=pdsNone;
953 end;
954 end;
955
IsCurrentPathDelimnull956 function IsCurrentPathDelim(Switch: TPathDelimSwitch): boolean;
957 begin
958 Result:=(Switch in [pdsNone,pdsSystem])
959 or ((Switch=pdsUnix) and (PathDelim='/'))
960 or ((Switch=pdsWindows) and (PathDelim='\'));
961 end;
962
963
CreateAbsoluteSearchPathnull964 function CreateAbsoluteSearchPath(const SearchPath, BaseDirectory: string): string;
965 var
966 PathLen: Integer;
967 EndPos: Integer;
968 StartPos: Integer;
969 CurDir: String;
970 NewCurDir: String;
971 DiffLen: Integer;
972 BaseDir: String;
973 begin
974 Result:=SearchPath;
975 if (SearchPath='') or (BaseDirectory='') then exit;
976 BaseDir:=AppendPathDelim(BaseDirectory);
977
978 PathLen:=length(Result);
979 EndPos:=1;
980 while EndPos<=PathLen do begin
981 StartPos:=EndPos;
982 while (Result[StartPos]=';') do begin
983 inc(StartPos);
984 if StartPos>PathLen then exit;
985 end;
986 EndPos:=StartPos;
987 while (EndPos<=PathLen) and (Result[EndPos]<>';') do inc(EndPos);
988 CurDir:=copy(Result,StartPos,EndPos-StartPos);
989 if not FilenameIsAbsolute(CurDir) then begin
990 NewCurDir:=BaseDir+CurDir;
991 if NewCurDir<>CurDir then begin
992 DiffLen:=length(NewCurDir)-length(CurDir);
993 Result:=copy(Result,1,StartPos-1)+NewCurDir
994 +copy(Result,EndPos,PathLen-EndPos+1);
995 inc(EndPos,DiffLen);
996 inc(PathLen,DiffLen);
997 end;
998 end;
999 StartPos:=EndPos;
1000 end;
1001 end;
1002
CreateRelativeSearchPathnull1003 function CreateRelativeSearchPath(const SearchPath, BaseDirectory: string
1004 ): string;
1005 var
1006 PathLen: Integer;
1007 EndPos: Integer;
1008 StartPos: Integer;
1009 CurDir: String;
1010 NewCurDir: String;
1011 DiffLen: Integer;
1012 begin
1013 Result:=SearchPath;
1014 if (SearchPath='') or (BaseDirectory='') then exit;
1015
1016 PathLen:=length(Result);
1017 EndPos:=1;
1018 while EndPos<=PathLen do begin
1019 StartPos:=EndPos;
1020 while (Result[StartPos]=';') do begin
1021 inc(StartPos);
1022 if StartPos>PathLen then exit;
1023 end;
1024 EndPos:=StartPos;
1025 while (EndPos<=PathLen) and (Result[EndPos]<>';') do inc(EndPos);
1026 CurDir:=copy(Result,StartPos,EndPos-StartPos);
1027 if FilenameIsAbsolute(CurDir) then begin
1028 NewCurDir:=CreateRelativePath(CurDir,BaseDirectory);
1029 if (NewCurDir<>CurDir) and (NewCurDir='') then
1030 NewCurDir:='.';
1031 if NewCurDir<>CurDir then begin
1032 DiffLen:=length(NewCurDir)-length(CurDir);
1033 Result:=copy(Result,1,StartPos-1)+NewCurDir
1034 +copy(Result,EndPos,PathLen-EndPos+1);
1035 inc(EndPos,DiffLen);
1036 inc(PathLen,DiffLen);
1037 end;
1038 end;
1039 StartPos:=EndPos;
1040 end;
1041 end;
1042
MinimizeSearchPathnull1043 function MinimizeSearchPath(const SearchPath: string): string;
1044 // trim the paths, remove doubles and empty paths
1045 var
1046 StartPos: Integer;
1047 EndPos: LongInt;
1048 NewPath: String;
1049 begin
1050 Result:=SearchPath;
1051 StartPos:=1;
1052 while StartPos<=length(Result) do begin
1053 EndPos:=StartPos;
1054 while (EndPos<=length(Result)) and (Result[EndPos]<>';') do
1055 inc(EndPos);
1056 if StartPos<EndPos then begin
1057 // trim path and chomp PathDelim
1058 if (Result[EndPos-1] in AllowDirectorySeparators)
1059 or (not FilenameIsTrimmed(@Result[StartPos],EndPos-StartPos)) then begin
1060 NewPath:=ChompPathDelim(
1061 TrimFilename(copy(Result,StartPos,EndPos-StartPos)));
1062 Result:=copy(Result,1,StartPos-1)+NewPath+copy(Result,EndPos,length(Result));
1063 EndPos:=StartPos+length(NewPath);
1064 end;
1065 // check if path already exists
1066 if (Length(Result) > 0) and
1067 (FindPathInSearchPath(@Result[StartPos],EndPos-StartPos, @Result[1],StartPos-1) <> nil)
1068 then begin
1069 // remove path
1070 System.Delete(Result,StartPos,EndPos-StartPos+1);
1071 end else begin
1072 StartPos:=EndPos+1;
1073 end;
1074 end else begin
1075 // remove empty path
1076 System.Delete(Result,StartPos,1);
1077 end;
1078 end;
1079 if (Result<>'') and (Result[length(Result)]=';') then
1080 SetLength(Result,length(Result)-1);
1081 end;
1082
FindPathInSearchPathnull1083 function FindPathInSearchPath(APath: PChar; APathLen: integer;
1084 SearchPath: PChar; SearchPathLen: integer): PChar;
1085 var
1086 StartPos: Integer;
1087 EndPos: LongInt;
1088 NextStartPos: LongInt;
1089 CmpPos: LongInt;
1090 UseQuickCompare: Boolean;
1091 PathStr: String;
1092 CurFilename: String;
1093 begin
1094 Result:=nil;
1095 if SearchPath=nil then exit;
1096 if (APath=nil) or (APathLen=0) then exit;
1097 // ignore trailing PathDelim at end
1098 while (APathLen>1) and (APath[APathLen-1] in AllowDirectorySeparators) do dec(APathLen);
1099
1100 {$IFDEF CaseInsensitiveFilenames}
1101 UseQuickCompare:=false;
1102 {$ELSE}
1103 {$IFDEF NotLiteralFilenames}
1104 CmpPos:=0;
1105 while (CmpPos<APathLen) and (ord(APath[CmpPos]<128)) do inc(CmpPos);
1106 UseQuickCompare:=CmpPos=APathLen;
1107 {$ELSE}
1108 UseQuickCompare:=true;
1109 {$ENDIF}
1110 {$ENDIF}
1111 if not UseQuickCompare then begin
1112 SetLength(PathStr{%H-},APathLen);
1113 System.Move(APath^,PathStr[1],APathLen);
1114 end;
1115
1116 StartPos:=0;
1117 while StartPos<SearchPathLen do begin
1118 // find current path bounds
1119 NextStartPos:=StartPos;
1120 while (SearchPath[NextStartPos]<>';') and (NextStartPos<SearchPathLen) do
1121 inc(NextStartPos);
1122 EndPos:=NextStartPos;
1123 // ignore trailing PathDelim at end
1124 while (EndPos>StartPos+1) and (SearchPath[EndPos-1] in AllowDirectorySeparators) do
1125 dec(EndPos);
1126 // compare current path
1127 if UseQuickCompare then begin
1128 if EndPos-StartPos=APathLen then begin
1129 CmpPos:=0;
1130 while CmpPos<APathLen do begin
1131 if APath[CmpPos]<>SearchPath[StartPos+CmpPos] then
1132 break;
1133 inc(CmpPos);
1134 end;
1135 if CmpPos=APathLen then begin
1136 Result:=@SearchPath[StartPos];
1137 exit;
1138 end;
1139 end;
1140 end else if EndPos>StartPos then begin
1141 // use CompareFilenames
1142 CurFilename:='';
1143 SetLength(CurFilename,EndPos-StartPos);
1144 System.Move(SearchPath[StartPos],CurFilename[1],EndPos-StartPos);
1145 if CompareFilenames(PathStr,CurFilename)=0 then begin
1146 Result:=@SearchPath[StartPos];
1147 exit;
1148 end;
1149 end;
1150 StartPos:=NextStartPos+1;
1151 end;
1152 end;
1153
FindPathInSearchPathnull1154 function FindPathInSearchPath(const APath, SearchPath: string): integer;
1155 var
1156 p: PChar;
1157 SearchP: PChar;
1158 begin
1159 SearchP:=PChar(SearchPath);
1160 p:=FindPathInSearchPath(PChar(APath),length(APath),SearchP,length(SearchPath));
1161 if p=nil then
1162 Result:=-1
1163 else
1164 Result:=p-SearchP+1;
1165 end;
1166
FileSearchUTF8null1167 function FileSearchUTF8(const Name, DirList: String; ImplicitCurrentDir : Boolean = True): String;
1168 Var
1169 I : longint;
1170 Temp : String;
1171
1172 begin
1173 Result:=Name;
1174 temp:=SetDirSeparators(DirList);
1175 // Start with checking the file in the current directory
1176 If ImplicitCurrentDir and (Result <> '') and FileExistsUTF8(Result) Then
1177 exit;
1178 while True do begin
1179 If Temp = '' then
1180 Break; // No more directories to search - fail
1181 I:=pos(PathSeparator,Temp);
1182 If I<>0 then
1183 begin
1184 Result:=Copy (Temp,1,i-1);
1185 system.Delete(Temp,1,I);
1186 end
1187 else
1188 begin
1189 Result:=Temp;
1190 Temp:='';
1191 end;
1192 If Result<>'' then
1193 Result:=AppendPathDelim(Result)+Name;
1194 If (Result <> '') and FileExistsUTF8(Result) Then
1195 exit;
1196 end;
1197 Result:='';
1198 end;
1199
FileIsReadOnlyUTF8null1200 function FileIsReadOnlyUTF8(const FileName: String): Boolean;
1201 begin
1202 Result:=FileGetAttrUTF8(FileName) and faReadOnly > 0;
1203 end;
1204
1205
1206
GetTempFileNameUTF8null1207 function GetTempFileNameUTF8(const Dir, Prefix: String): String;
1208 var
1209 I: Integer;
1210 Start: String;
1211 begin
1212 if Assigned(OnGetTempFile) then
1213 Result:=OnGetTempFile(Dir,Prefix)
1214 else
1215 begin
1216 if (Dir='') then
1217 Start:=GetTempDir
1218 else
1219 Start:=IncludeTrailingPathDelimiter(Dir);
1220 if (Prefix='') then
1221 Start:=Start+'TMP'
1222 else
1223 Start:=Start+Prefix;
1224 I:=0;
1225 repeat
1226 Result:=SysUtils.Format('%s%.5d.tmp',[Start,I]);
1227 Inc(I);
1228 until not FileExistsUTF8(Result);
1229 end;
1230 end;
1231
ForceDirectoriesUTF8null1232 function ForceDirectoriesUTF8(const Dir: string): Boolean;
1233 var
1234 E: EInOutError;
1235 ADrv : String;
1236
DoForceDirectoriesnull1237 function DoForceDirectories(Const Dir: string): Boolean;
1238 var
1239 ADir : String;
1240 APath: String;
1241 begin
1242 Result:=True;
1243 ADir:=ExcludeTrailingPathDelimiter(Dir);
1244 if (ADir='') then Exit;
1245 if Not DirectoryExistsUTF8(ADir) then
1246 begin
1247 APath := ExtractFilePath(ADir);
1248 //this can happen on Windows if user specifies Dir like \user\name/test/
1249 //and would, if not checked for, cause an infinite recusrsion and a stack overflow
1250 if (APath = ADir) then
1251 Result := False
1252 else
1253 Result:=DoForceDirectories(APath);
1254 if Result then
1255 Result := CreateDirUTF8(ADir);
1256 end;
1257 end;
1258
IsUncDrivenull1259 function IsUncDrive(const Drv: String): Boolean;
1260 begin
1261 Result := (Length(Drv) > 2) and (Drv[1] in AllowDirectorySeparators) and (Drv[2] in AllowDirectorySeparators);
1262 end;
1263
1264 begin
1265 Result := False;
1266 ADrv := ExtractFileDrive(Dir);
1267 if (ADrv<>'') and (not DirectoryExistsUTF8(ADrv))
1268 {$IFNDEF FORCEDIR_NO_UNC_SUPPORT} and (not IsUncDrive(ADrv)){$ENDIF} then Exit;
1269 if Dir='' then
1270 begin
1271 E:=EInOutError.Create(SCannotCreateEmptyDir);
1272 E.ErrorCode:=3;
1273 Raise E;
1274 end;
1275 Result := DoForceDirectories(GetForcedPathDelims(Dir));
1276 end;
1277
TryReadAllLinksnull1278 function TryReadAllLinks(const Filename: string): string;
1279 begin
1280 Result:=ReadAllLinks(Filename,false);
1281 if Result='' then
1282 Result:=Filename;
1283 end;
1284
1285 procedure InvalidateFileStateCache(const Filename: string);
1286 begin
1287 if Assigned(OnInvalidateFileStateCache) then
1288 OnInvalidateFileStateCache(Filename);
1289 end;
1290
1291 procedure SplitCmdLineParams(const Params: string; ParamList: TStrings;
1292 ReadBackslash: boolean = false);
1293 // split spaces, quotes are parsed as single parameter
1294 // if ReadBackslash=true then \" is replaced to " and not treated as quote
1295 // #0 is always end
1296 type
1297 TMode = (mNormal,mApostrophe,mQuote);
1298 var
1299 p: Integer;
1300 Mode: TMode;
1301 Param: String;
1302 begin
1303 p:=1;
1304 while p<=length(Params) do
1305 begin
1306 // skip whitespace
1307 while (p<=length(Params)) and (Params[p] in [' ',#9,#10,#13]) do inc(p);
1308 if (p>length(Params)) or (Params[p]=#0) then
1309 break;
1310 //writeln('SplitCmdLineParams After Space p=',p,'=[',Params[p],']');
1311 // read param
1312 Param:='';
1313 Mode:=mNormal;
1314 while p<=length(Params) do
1315 begin
1316 case Params[p] of
1317 #0:
1318 break;
1319 '\':
1320 begin
1321 inc(p);
1322 if ReadBackslash then
1323 begin
1324 // treat next character as normal character
1325 if (p>length(Params)) or (Params[p]=#0) then
1326 break;
1327 if ord(Params[p])<128 then
1328 begin
1329 Param+=Params[p];
1330 inc(p);
1331 end else begin
1332 // next character is already a normal character
1333 end;
1334 end else begin
1335 // treat backslash as normal character
1336 Param+='\';
1337 end;
1338 end;
1339 '''':
1340 begin
1341 inc(p);
1342 case Mode of
1343 mNormal:
1344 Mode:=mApostrophe;
1345 mApostrophe:
1346 Mode:=mNormal;
1347 mQuote:
1348 Param+='''';
1349 end;
1350 end;
1351 '"':
1352 begin
1353 inc(p);
1354 case Mode of
1355 mNormal:
1356 Mode:=mQuote;
1357 mApostrophe:
1358 Param+='"';
1359 mQuote:
1360 Mode:=mNormal;
1361 end;
1362 end;
1363 ' ',#9,#10,#13:
1364 begin
1365 if Mode=mNormal then break;
1366 Param+=Params[p];
1367 inc(p);
1368 end;
1369 else
1370 Param+=Params[p];
1371 inc(p);
1372 end;
1373 end;
1374 //writeln('SplitCmdLineParams Param=#'+Param+'#');
1375 ParamList.Add(Param);
1376 end;
1377 end;
1378
StrToCmdLineParamnull1379 function StrToCmdLineParam(const Param: string): string;
1380 { <empty> -> ''
1381 word -> word
1382 word1 word2 -> 'word1 word2'
1383 word's -> "word's"
1384 a" -> 'a"'
1385 "a" -> '"a"'
1386 'a' -> "'a'"
1387 #0 character -> cut the rest
1388 }
1389 const
1390 NoQuot = ' ';
1391 AnyQuot = '*';
1392 SysQuot = {$IFDEF Windows}'"'{$ELSE}''''{$ENDIF};
1393 var
1394 Quot: Char;
1395 p: PChar;
1396 i: Integer;
1397 begin
1398 Result:=Param;
1399 if Result='' then
1400 Result:=''''''
1401 else begin
1402 p:=PChar(Result);
1403 Quot:=NoQuot;
1404 repeat
1405 case p^ of
1406 #0:
1407 begin
1408 i:=p-PChar(Result);
1409 if i<length(Result) then
1410 Delete(Result,i+1,length(Result));
1411 case Quot of
1412 AnyQuot: Result:=SysQuot+Result+SysQuot;
1413 '''': Result+='''';
1414 '"': Result+='"';
1415 end;
1416 break;
1417 end;
1418 ' ',#9,#10,#13:
1419 begin
1420 if Quot=NoQuot then
1421 Quot:=AnyQuot;
1422 inc(p);
1423 end;
1424 '''':
1425 begin
1426 case Quot of
1427 NoQuot,AnyQuot:
1428 begin
1429 // need "
1430 Quot:='"';
1431 i:=p-PChar(Result);
1432 System.Insert('"',Result,1);
1433 p:=PChar(Result)+i+1;
1434 end;
1435 '"':
1436 inc(p);
1437 '''':
1438 begin
1439 // ' within a '
1440 // => end ', start "
1441 i:=p-PChar(Result)+1;
1442 System.Insert('''"',Result,i);
1443 p:=PChar(Result)+i+1;
1444 Quot:='"';
1445 end;
1446 end;
1447 end;
1448 '"':
1449 begin
1450 case Quot of
1451 NoQuot,AnyQuot:
1452 begin
1453 // need '
1454 Quot:='''';
1455 i:=p-PChar(Result);
1456 System.Insert('''',Result,1);
1457 p:=PChar(Result)+i+1;
1458 end;
1459 '''':
1460 inc(p);
1461 '"':
1462 begin
1463 // " within a "
1464 // => end ", start '
1465 i:=p-PChar(Result)+1;
1466 System.Insert('"''',Result,i);
1467 p:=PChar(Result)+i+1;
1468 Quot:='''';
1469 end;
1470 end;
1471 end;
1472 else
1473 inc(p);
1474 end;
1475 until false;
1476 end;
1477 end;
1478
1479 function MergeCmdLineParams(ParamList: TStrings): string;
1480 var
1481 i: Integer;
1482 begin
1483 Result:='';
1484 if ParamList=nil then exit;
1485 for i:=0 to ParamList.Count-1 do
1486 begin
1487 if i>0 then Result+=' ';
1488 Result+=StrToCmdLineParam(ParamList[i]);
1489 end;
1490 end;
1491
1492 procedure SplitCmdLine(const CmdLine: string;
1493 out ProgramFilename, Params: string);
1494 var
1495 p: integer;
1496
1497 procedure SkipChar; inline;
1498 begin
1499 {$IFDEF Unix}
1500 if (CmdLine[p]='\') and (p<length(CmdLine)) then
1501 // skip escaped char
1502 inc(p,2)
1503 else
1504 {$ENDIF}
1505 inc(p);
1506 end;
1507
1508 var s, l: integer;
1509 quote: char;
1510 begin
1511 ProgramFilename:='';
1512 Params:='';
1513 if CmdLine='' then exit;
1514 p:=1;
1515 s:=1;
1516 if (CmdLine[p] in ['"','''']) then
1517 begin
1518 // skip quoted string
1519 quote:=CmdLine[p];
1520 inc(s);
1521 inc(p);
1522 while (p<=length(CmdLine)) and (CmdLine[p]<>quote) do
1523 SkipChar;
1524 // go past last character or quoted string
1525 l:=p-s;
1526 inc(p);
1527 end else begin
1528 while (p<=length(CmdLine)) and (CmdLine[p]>' ') do
1529 SkipChar;
1530 l:=p-s;
1531 end;
1532 ProgramFilename:=Copy(CmdLine,s,l);
1533 while (p<=length(CmdLine)) and (CmdLine[p]<=' ') do inc(p);
1534 Params:=copy(CmdLine,p,length(CmdLine));
1535 end;
1536
1537 function PrepareCmdLineOption(const Option: string): string;
1538 // If there is a space in the option add " " around the whole option
1539 var
1540 i: integer;
1541 begin
1542 Result:=Option;
1543 if (Result='') or (Result[1] in ['"','''']) then exit;
1544 for i:=1 to length(Result) do begin
1545 case Result[i] of
1546 ' ','''':
1547 begin
1548 Result:=AnsiQuotedStr(Result,'"');
1549 exit;
1550 end;
1551 '"':
1552 begin
1553 Result:=AnsiQuotedStr(Result,'''');
1554 exit;
1555 end;
1556 end;
1557 end;
1558 end;
1559 {
1560 function AddCmdLineParameter(const CmdLine, AddParameter: string): string;
1561 begin
1562 Result:=CmdLine;
1563 if (Result<>'') and (Result[length(Result)]<>' ') then
1564 Result:=Result+' ';
1565 Result:=Result+AddParameter;
1566 end;
1567 }
1568 {
1569 Returns
1570 - DriveLetter + : + PathDelim on Windows (if present) or
1571 - UNC Share on Windows if present or
1572 - PathDelim if FileName starts with PathDelim on Unix or Wince or
1573 - Empty string of non eof the above applies
1574 }
1575 function ExtractFileRoot(FileName: String): String;
1576 var
1577 Len: Integer;
1578 begin
1579 Result := '';
1580 Len := Length(FileName);
1581 if (Len > 0) then
1582 begin
1583 if IsUncPath(FileName) then
1584 begin
1585 Result := ExtractUNCVolume(FileName);
1586 // is it like \\?\C:\Directory? then also include the "C:\" part
1587 if (Result = '\\?\') and (Length(FileName) > 6) and
1588 (FileName[5] in ['a'..'z','A'..'Z']) and (FileName[6] = ':') and (FileName[7] in AllowDirectorySeparators)
1589 then
1590 Result := Copy(FileName, 1, 7);
1591 end
1592 else
1593 begin
1594 {$if defined(unix) or defined(wince)}
1595 if (FileName[1] = PathDelim) then Result := PathDelim;
1596 {$else}
1597 {$ifdef HASAMIGA}
1598 if Pos(':', FileName) > 1 then
1599 Result := Copy(FileName, 1, Pos(':', FileName));
1600 {$else}
1601 if (Len > 2) and (FileName[1] in ['a'..'z','A'..'Z']) and (FileName[2] = ':') and (FileName[3] in AllowDirectorySeparators) then
1602 Result := UpperCase(Copy(FileName,1,3));
1603 {$endif}
1604 {$endif}
1605 end;
1606 end;
1607 end;
1608
1609 initialization
1610 InitLazFileUtils;
1611
1612 finalization
1613 FinalizeLazFileUtils;
1614
1615 end.
1616
1617 end.
1618
1619