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