← Back to branch summary

~ubuntu-branches/ubuntu/vivid/lazarus/vivid

« back to all changes in this revision

Viewing changes to components/lazutils/lazfileutils.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Paul Gevers
  • Date: 2014-02-22 10:25:57 UTC
  • mfrom: (1.1.11)
  • Revision ID: package-import@ubuntu.com-20140222102557-ors9d31r84nz31jq
Tags: 1.2~rc2+dfsg-1
http://bugs.debian.org/724776
[ Abou Al Montacir ]
* New upstream pre-release.
  + Moved ideintf to components directory.
  + Added new package cairocanvas.
* Remove usage of depreciated parameters form of find. (Closes: Bug#724776)
* Bumped standard version to 3.9.5.
* Clean the way handling make files generation and removal.

[ Paul Gevers ]
* Remove nearly obsolete bzip compression for binary packages
  (See https://lists.debian.org/debian-devel/2014/01/msg00542.html)
* Update d/copyright for newly added dir in examples and components
* Update Vcs-* fields with new packaging location
* Update d/watch file to properly (Debian way) change upstreams versions
* Prevent 46MB of package size by sym linking duplicate files
* Patches
  - refresh to remove fuzz
  - add more Lintian found spelling errors
  - new patch to add shbang to two scripts in lazarus-src
* Drop lcl-# from Provides list of lcl-units-#
* Make lazarus-ide-qt4-# an arch all until it really contains stuff
* Make all metapackages arch all as the usecase for arch any doesn't
  seem to warrant the addition archive hit
* Fix permissions of non-scripts in lazarus-src-#

Show diffs side-by-side

added added

removed removed

Lines of Context:
components/lazutils/lazfileutils.pas
 
1
{
 
2
  All functions are thread safe unless explicitely stated
 
3
}
1
4
unit LazFileUtils;
2
5
 
3
6
{$mode objfpc}{$H+}
5
8
interface
6
9
 
7
10
uses
8
 
  Classes, SysUtils, LazUTF8, LUResStrings;
 
11
  Classes, SysUtils, SysConst, LazUTF8, LazUtilsStrConsts;
9
12
 
10
13
{$IFDEF Windows}
11
14
  {$define CaseInsensitiveFilenames}
21
24
function CompareFilenames(const Filename1, Filename2: string): integer;
22
25
function CompareFilenamesIgnoreCase(const Filename1, Filename2: string): integer;
23
26
function CompareFileExt(const Filename, Ext: string;
24
 
                        CaseSensitive: boolean): integer;
 
27
                        CaseSensitive: boolean): integer; overload;
 
28
function CompareFileExt(const Filename, Ext: string): integer; overload;
 
29
 
25
30
function CompareFilenameStarts(const Filename1, Filename2: string): integer;
26
31
function CompareFilenames(Filename1: PChar; Len1: integer;
27
32
  Filename2: PChar; Len2: integer): integer;
 
33
function CompareFilenamesP(Filename1, Filename2: PChar;
 
34
  IgnoreCase: boolean = false // false = use default
 
35
  ): integer;
 
36
 
28
37
function DirPathExists(DirectoryName: string): boolean;
29
38
function DirectoryIsWritable(const DirectoryName: string): boolean;
30
39
function ExtractFileNameOnly(const AFilename: string): string;
33
42
function FilenameIsUnixAbsolute(const TheFilename: string):boolean;
34
43
function ForceDirectory(DirectoryName: string): boolean;
35
44
procedure CheckIfFileIsExecutable(const AFilename: string);
 
45
procedure CheckIfFileIsSymlink(const AFilename: string);
36
46
function FileIsExecutable(const AFilename: string): boolean;
 
47
function FileIsSymlink(const AFilename: string): boolean;
 
48
function FileIsHardLink(const AFilename: string): boolean;
37
49
function FileIsReadable(const AFilename: string): boolean;
38
50
function FileIsWritable(const AFilename: string): boolean;
39
51
function FileIsText(const AFilename: string): boolean;
41
53
function FilenameIsTrimmed(const TheFilename: string): boolean;
42
54
function FilenameIsTrimmed(StartPos: PChar; NameLen: integer): boolean;
43
55
function TrimFilename(const AFilename: string): string;
 
56
function ResolveDots(const AFilename: string): string;
 
57
Procedure ForcePathDelims(Var FileName: string);
 
58
Function GetForcedPathDelims(Const FileName: string): String;
44
59
function CleanAndExpandFilename(const Filename: string): string; // empty string returns current directory
45
60
function CleanAndExpandDirectory(const Filename: string): string; // empty string returns current directory
46
61
function TrimAndExpandFilename(const Filename: string; const BaseDir: string = ''): string; // empty string returns empty string
47
62
function TrimAndExpandDirectory(const Filename: string; const BaseDir: string = ''): string; // empty string returns empty string
 
63
function TryCreateRelativePath(const Dest, Source: String; UsePointDirectory: boolean;
 
64
                               AlwaysRequireSharedBaseFolder: Boolean; out RelPath: String): Boolean;
48
65
function CreateRelativePath(const Filename, BaseDirectory: string;
49
 
                            UsePointDirectory: boolean = false): string;
 
66
                            UsePointDirectory: boolean = false; AlwaysRequireSharedBaseFolder: Boolean = True): string;
50
67
function FileIsInPath(const Filename, Path: string): boolean;
51
68
function AppendPathDelim(const Path: string): string;
52
69
function ChompPathDelim(const Path: string): string;
62
79
function FileExistsUTF8(const Filename: string): boolean;
63
80
function FileAgeUTF8(const FileName: string): Longint;
64
81
function DirectoryExistsUTF8(const Directory: string): Boolean;
65
 
function ExpandFileNameUTF8(const FileName: string; const BaseDir: string = ''): string;
 
82
function ExpandFileNameUTF8(const FileName: string; {const} BaseDir: string = ''): string;
66
83
function FindFirstUTF8(const Path: string; Attr: Longint; out Rslt: TSearchRec): Longint;
67
84
function FindNextUTF8(var Rslt: TSearchRec): Longint;
68
 
procedure FindCloseUTF8(var F: TSearchrec);
 
85
procedure FindCloseUTF8(var F: TSearchrec); inline;
69
86
function FileSetDateUTF8(const FileName: String; Age: Longint): Longint;
70
87
function FileGetAttrUTF8(const FileName: String): Longint;
71
88
function FileSetAttrUTF8(const Filename: String; Attr: longint): Longint;
72
89
function DeleteFileUTF8(const FileName: String): Boolean;
73
90
function RenameFileUTF8(const OldName, NewName: String): Boolean;
74
 
function FileSearchUTF8(const Name, DirList : String): String;
 
91
function FileSearchUTF8(const Name, DirList : String; ImplicitCurrentDir : Boolean = True): String;
75
92
function FileIsReadOnlyUTF8(const FileName: String): Boolean;
76
93
function GetCurrentDirUTF8: String;
77
94
function SetCurrentDirUTF8(const NewDir: String): Boolean;
79
96
function RemoveDirUTF8(const Dir: String): Boolean;
80
97
function ForceDirectoriesUTF8(const Dir: string): Boolean;
81
98
 
 
99
function FileOpenUTF8(Const FileName : string; Mode : Integer) : THandle;
 
100
function FileCreateUTF8(Const FileName : string) : THandle; overload;
 
101
function FileCreateUTF8(Const FileName : string; Rights: Cardinal) : THandle; overload;
 
102
Function FileCreateUtf8(Const FileName : String; ShareMode : Integer; Rights : Cardinal) : THandle; overload;
 
103
 
 
104
function FileSizeUtf8(const Filename: string): int64;
 
105
function GetFileDescription(const AFilename: string): string;
 
106
 
 
107
 
 
108
function GetAppConfigDirUTF8(Global: Boolean; Create: boolean = false): string;
 
109
function GetAppConfigFileUTF8(Global: Boolean; SubDir: boolean = false;
 
110
  CreateDir: boolean = false): string;
 
111
function GetTempFileNameUTF8(const Dir, Prefix: String): String;
 
112
 
82
113
// UNC paths
83
114
function IsUNCPath(const {%H-}Path: String): Boolean;
84
115
function ExtractUNCVolume(const {%H-}Path: String): String;
 
116
function ExtractFileRoot(FileName: String): String;
 
117
 
 
118
// darwin paths
 
119
{$IFDEF darwin}
 
120
function GetDarwinSystemFilename(Filename: string): string;
 
121
{$ENDIF}
 
122
 
 
123
procedure SplitCmdLineParams(const Params: string; ParamList: TStrings;
 
124
                             ReadBackslash: boolean = false);
 
125
function StrToCmdLineParam(const Param: string): string;
 
126
function MergeCmdLineParams(ParamList: TStrings): string;
85
127
 
86
128
type
87
129
  TInvalidateFileStateCacheEvent = procedure(const Filename: string);
94
136
// to get more detailed error messages consider the os
95
137
uses
96
138
{$IFDEF Windows}
97
 
  Windows;
 
139
  Windows, WinDirs;
98
140
{$ELSE}
99
141
  {$IFDEF darwin}
100
142
  MacOSAll,
102
144
  Unix, BaseUnix;
103
145
{$ENDIF}
104
146
 
 
147
{$I lazfileutils.inc}
 
148
{$IFDEF windows}
 
149
  {$I winlazfileutils.inc}
 
150
{$ELSE}
 
151
  {$I unixlazfileutils.inc}
 
152
{$ENDIF}
 
153
 
105
154
function CompareFilenames(const Filename1, Filename2: string): integer;
106
155
{$IFDEF darwin}
107
156
var
148
197
  {$ENDIF}
149
198
end;
150
199
 
151
 
function CompareFileExt(const Filename, Ext: string;
152
 
  CaseSensitive: boolean): integer;
 
200
function CompareFileExt(const Filename, Ext: string; CaseSensitive: boolean): integer;
 
201
// Ext can contain a point or not
153
202
var
 
203
  n, e : AnsiString;
154
204
  FileLen, FilePos, ExtLen, ExtPos: integer;
155
 
  FileChar, ExtChar: char;
156
205
begin
157
 
  FileLen:=length(Filename);
158
 
  ExtLen:=length(Ext);
159
 
  FilePos:=FileLen;
 
206
  FileLen := length(Filename);
 
207
  ExtLen := length(Ext);
 
208
  FilePos := FileLen;
160
209
  while (FilePos>=1) and (Filename[FilePos]<>'.') do dec(FilePos);
161
 
  if FilePos<1 then begin
 
210
  if FilePos < 1 then begin
162
211
    // no extension in filename
163
212
    Result:=1;
164
213
    exit;
165
214
  end;
166
215
  // skip point
167
216
  inc(FilePos);
168
 
  ExtPos:=1;
169
 
  if (ExtPos<=ExtLen) and (Ext[1]='.') then inc(ExtPos);
 
217
  ExtPos := 1;
 
218
  if (ExtPos <= ExtLen) and (Ext[1] = '.') then inc(ExtPos);
 
219
 
170
220
  // compare extensions
171
 
  while true do begin
172
 
    if FilePos<=FileLen then begin
173
 
      if ExtPos<=ExtLen then begin
174
 
        FileChar:=Filename[FilePos];
175
 
        ExtChar:=Ext[ExtPos];
176
 
        if not CaseSensitive then begin
177
 
          FileChar:=FPUpChars[FileChar];
178
 
          ExtChar:=FPUpChars[ExtChar];
179
 
        end;
180
 
        if FileChar=ExtChar then begin
181
 
          inc(FilePos);
182
 
          inc(ExtPos);
183
 
        end else if FileChar>ExtChar then begin
184
 
          Result:=1;
185
 
          exit;
186
 
        end else begin
187
 
          Result:=-1;
188
 
          exit;
189
 
        end;
190
 
      end else begin
191
 
        // fileext longer than ext
192
 
        Result:=1;
193
 
        exit;
194
 
      end;
195
 
    end else begin
196
 
      if ExtPos<=ExtLen then begin
197
 
        // fileext shorter than ext
198
 
        Result:=-1;
199
 
        exit;
200
 
      end else begin
201
 
        // equal
202
 
        Result:=0;
203
 
        exit;
204
 
      end;
205
 
    end;
206
 
  end;
207
 
end;
208
 
 
209
 
function FileIsExecutable(const AFilename: string): boolean;
210
 
{$IFNDEF WINDOWS}
211
 
var
212
 
  Info : Stat;
213
 
{$ENDIF}
214
 
begin
215
 
  {$IFDEF WINDOWS}
216
 
  Result:=FileExistsUTF8(AFilename);
217
 
  {$ELSE}
218
 
  // first check AFilename is not a directory and then check if executable
219
 
  Result:= (FpStat(AFilename,info{%H-})<>-1) and FPS_ISREG(info.st_mode) and
220
 
           (BaseUnix.FpAccess(AFilename,BaseUnix.X_OK)=0);
221
 
  {$ENDIF}
222
 
end;
223
 
 
224
 
procedure CheckIfFileIsExecutable(const AFilename: string);
225
 
{$IFNDEF Windows}
226
 
var AText: string;
227
 
{$ENDIF}
228
 
begin
229
 
  // TProcess does not report, if a program can not be executed
230
 
  // to get good error messages consider the OS
231
 
  if not FileExistsUTF8(AFilename) then begin
232
 
    raise Exception.CreateFmt(ctsFileDoesNotExist,[AFilename]);
233
 
  end;
234
 
  {$IFNDEF Windows}
235
 
  if not(BaseUnix.FpAccess(AFilename,BaseUnix.X_OK)=0) then
236
 
  begin
237
 
    AText:='"'+AFilename+'"';
238
 
    case fpGetErrno of
239
 
    ESysEAcces:
240
 
      AText:='read access denied for '+AText;
241
 
    ESysENoEnt:
242
 
      AText:='a directory component in '+AText
243
 
                          +' does not exist or is a dangling symlink';
244
 
    ESysENotDir:
245
 
      AText:='a directory component in '+Atext+' is not a directory';
246
 
    ESysENoMem:
247
 
      AText:='insufficient memory';
248
 
    ESysELoop:
249
 
      AText:=AText+' has a circular symbolic link';
250
 
    else
251
 
      AText:=Format(ctsFileIsNotExecutable,[AText]);
252
 
    end;
253
 
    raise Exception.Create(AText);
254
 
  end;
255
 
  {$ENDIF}
256
 
 
257
 
  // ToDo: windows and xxxbsd
 
221
  n := Copy(Filename, FilePos, length(FileName));
 
222
  e := Copy(Ext, ExtPos, length(Ext));
 
223
  if CaseSensitive then
 
224
    Result := CompareStr(n, e)
 
225
  else
 
226
    Result := UTF8CompareText(n, e);
 
227
  if Result < 0
 
228
    then Result := -1
 
229
  else
 
230
    if Result > 0 then Result := 1;
 
231
end;
 
232
 
 
233
function CompareFileExt(const Filename, Ext: string): integer;
 
234
begin
 
235
  Result := CompareFileExt(Filename, Ext, False);
258
236
end;
259
237
 
260
238
function ExtractFileNameOnly(const AFilename: string): string;
261
 
var ExtLen: integer;
262
 
begin
263
 
  // beware: filename.ext1.ext2
264
 
  Result:=ExtractFilename(AFilename);
265
 
  ExtLen:=length(ExtractFileExt(Result));
266
 
  Result:=copy(Result,1,length(Result)-ExtLen);
267
 
end;
268
 
 
269
 
function FilenameIsAbsolute(const TheFilename: string):boolean;
270
 
begin
271
 
  {$IFDEF Windows}
272
 
  // windows
273
 
  Result:=FilenameIsWinAbsolute(TheFilename);
274
 
  {$ELSE}
275
 
  // unix
276
 
  Result:=FilenameIsUnixAbsolute(TheFilename);
277
 
  {$ENDIF}
278
 
end;
279
 
 
280
 
function FilenameIsWinAbsolute(const TheFilename: string): boolean;
281
 
begin
282
 
  Result:=((length(TheFilename)>=2) and (TheFilename[1] in ['A'..'Z','a'..'z'])
283
 
           and (TheFilename[2]=':'))
284
 
     or ((length(TheFilename)>=2)
285
 
         and (TheFilename[1]='\') and (TheFilename[2]='\'));
286
 
end;
287
 
 
288
 
function FilenameIsUnixAbsolute(const TheFilename: string): boolean;
289
 
begin
290
 
  Result:=(TheFilename<>'') and (TheFilename[1]='/');
 
239
var
 
240
  StartPos: Integer;
 
241
  ExtPos: Integer;
 
242
begin
 
243
  StartPos:=length(AFilename)+1;
 
244
  while (StartPos>1)
 
245
  and not (AFilename[StartPos-1] in AllowDirectorySeparators)
 
246
  {$IFDEF Windows}and (AFilename[StartPos-1]<>':'){$ENDIF}
 
247
  do
 
248
    dec(StartPos);
 
249
  ExtPos:=length(AFilename);
 
250
  while (ExtPos>=StartPos) and (AFilename[ExtPos]<>'.') do
 
251
    dec(ExtPos);
 
252
  if (ExtPos<StartPos) then ExtPos:=length(AFilename)+1;
 
253
  Result:=copy(AFilename,StartPos,ExtPos-StartPos);
291
254
end;
292
255
 
293
256
{$IFDEF darwin}
362
325
  {$ENDIF}
363
326
end;
364
327
 
 
328
function CompareFilenamesP(Filename1, Filename2: PChar;
 
329
  IgnoreCase: boolean = false): integer;
 
330
var
 
331
  {$IFDEF darwin}
 
332
  F1: CFStringRef;
 
333
  F2: CFStringRef;
 
334
  Flags: CFStringCompareFlags;
 
335
  {$ELSE}
 
336
  File1, File2: string;
 
337
  Len1: SizeInt;
 
338
  Len2: SizeInt;
 
339
  {$ENDIF}
 
340
begin
 
341
  if (Filename1=nil) or (Filename1^=#0) then begin
 
342
    if (Filename2=nil) or (Filename2^=#0) then begin
 
343
      // both empty
 
344
      exit(0);
 
345
    end else begin
 
346
      // filename1 empty, filename2 not empty
 
347
      exit(-1);
 
348
    end;
 
349
  end else if (Filename2=nil) or (Filename2^=#0) then begin
 
350
    // filename1 not empty, filename2 empty
 
351
    exit(1);
 
352
  end;
 
353
 
 
354
  {$IFDEF CaseInsensitiveFilenames}
 
355
  // this platform is by default case insensitive
 
356
  IgnoreCase:=true;
 
357
  {$ENDIF}
 
358
  {$IFDEF darwin}
 
359
  F1:=CFStringCreateWithCString(nil,Pointer(Filename1),kCFStringEncodingUTF8);
 
360
  F2:=CFStringCreateWithCString(nil,Pointer(Filename2),kCFStringEncodingUTF8);
 
361
  Flags:=kCFCompareNonliteral;
 
362
  if IgnoreCase then Flags+=kCFCompareCaseInsensitive;
 
363
  Result:=CFStringCompare(F1,F2,Flags);
 
364
  CFRelease(F1);
 
365
  CFRelease(F2);
 
366
  {$ELSE}
 
367
  if IgnoreCase then begin
 
368
    // compare case insensitive
 
369
    Len1:=StrLen(Filename1);
 
370
    SetLength(File1,Len1);
 
371
    System.Move(Filename1^,File1[1],Len1);
 
372
    Len2:=StrLen(Filename2);
 
373
    SetLength(File2,Len2);
 
374
    System.Move(Filename2^,File2[1],Len2);
 
375
    Result:=UTF8CompareText(File1,File2);
 
376
  end else begin
 
377
    // compare literally
 
378
    while (Filename1^=Filename2^) and (Filename1^<>#0) do begin
 
379
      inc(Filename1);
 
380
      Inc(Filename2);
 
381
    end;
 
382
    Result:=ord(Filename1^)-ord(Filename2^);
 
383
  end;
 
384
  {$ENDIF}
 
385
end;
 
386
 
365
387
function DirPathExists(DirectoryName: string): boolean;
366
388
begin
367
389
  Result:=DirectoryExistsUTF8(ChompPathDelim(DirectoryName));
370
392
function DirectoryIsWritable(const DirectoryName: string): boolean;
371
393
var
372
394
  TempFilename: String;
373
 
  fs: TFileStream;
374
395
  s: String;
 
396
  fHandle: THANDLE;
375
397
begin
376
398
  TempFilename:=SysUtils.GetTempFilename(AppendPathDelim(DirectoryName),'tstperm');
377
399
  Result:=false;
378
 
  try
379
 
    fs:=TFileStream.Create(UTF8ToSys(TempFilename),fmCreate);
 
400
  fHandle := FileCreateUtf8(TempFileName, fmCreate, 438);
 
401
  if (THandle(fHandle) <> feInvalidHandle) then
 
402
  begin
380
403
    s:='WriteTest';
381
 
    fs.Write(s[1],length(s));
382
 
    fs.Free;
 
404
    if FileWrite(fHandle,S[1],Length(S)) > 0 then Result := True;
 
405
    FileClose(fHandle);
383
406
    if not DeleteFileUTF8(TempFilename) then
384
407
      InvalidateFileStateCache(TempFilename);
385
 
    Result:=true;
386
 
  except
387
408
  end;
388
409
end;
389
410
 
391
412
var i: integer;
392
413
  Dir: string;
393
414
begin
394
 
  DoDirSeparators(DirectoryName);
395
415
  DirectoryName:=AppendPathDelim(DirectoryName);
396
416
  i:=1;
397
417
  while i<=length(DirectoryName) do begin
398
 
    if DirectoryName[i]=PathDelim then begin
 
418
    if DirectoryName[i] in AllowDirectorySeparators then begin
399
419
      Dir:=copy(DirectoryName,1,i-1);
400
420
      if not DirPathExists(Dir) then begin
401
421
        Result:=CreateDirUTF8(Dir);
407
427
  Result:=true;
408
428
end;
409
429
 
410
 
function FileIsReadable(const AFilename: string): boolean;
411
 
begin
412
 
  {$IFDEF Windows}
413
 
  Result:=true;
414
 
  {$ELSE}
415
 
  Result:= BaseUnix.FpAccess(AFilename,BaseUnix.R_OK)=0;
416
 
  {$ENDIF}
417
 
end;
418
 
 
419
 
function FileIsWritable(const AFilename: string): boolean;
420
 
begin
421
 
  {$IFDEF Windows}
422
 
  Result:=((FileGetAttrUTF8(AFilename) and faReadOnly)=0);
423
 
  {$ELSE}
424
 
  Result:= BaseUnix.FpAccess(AFilename,BaseUnix.W_OK)=0;
425
 
  {$ENDIF}
426
 
end;
427
430
 
428
431
function FileIsText(const AFilename: string): boolean;
429
432
var
435
438
 
436
439
function FileIsText(const AFilename: string; out FileReadable: boolean): boolean;
437
440
var
438
 
  fs: TFileStream;
439
441
  Buf: string;
440
442
  Len: integer;
441
443
  NewLine: boolean;
442
444
  p: PChar;
443
445
  ZeroAllowed: Boolean;
 
446
  fHandle: THandle;
444
447
begin
445
448
  Result:=false;
446
449
  FileReadable:=true;
447
 
  try
448
 
    fs := TFileStream.Create(UTF8ToSys(AFilename), fmOpenRead or fmShareDenyNone);
 
450
  fHandle := FileOpenUtf8(AFileName, fmOpenRead or fmShareDenyNone);
 
451
  if (THandle(fHandle) <> feInvalidHandle)  then
 
452
  begin
449
453
    try
450
 
      // read the first 1024 bytes
451
454
      Len:=1024;
452
455
      SetLength(Buf,Len+1);
453
 
      Len:=fs.Read(Buf[1],Len);
 
456
      Len := FileRead(fHandle,Buf[1],Len);
 
457
 
454
458
      if Len>0 then begin
455
459
        Buf[Len+1]:=#0;
456
460
        p:=PChar(Buf);
488
492
      end else
489
493
        Result:=true;
490
494
    finally
491
 
      fs.Free;
492
 
    end;
493
 
  except
494
 
    on E: Exception do begin
495
 
      FileReadable:=false;
496
 
    end;
497
 
  end;
 
495
      FileClose(fHandle);
 
496
    end
 
497
  end
 
498
  else
 
499
    FileReadable := False;
498
500
end;
499
501
 
500
502
function FilenameIsTrimmed(const TheFilename: string): boolean;
506
508
function FilenameIsTrimmed(StartPos: PChar; NameLen: integer): boolean;
507
509
var
508
510
  i: Integer;
 
511
  c: Char;
509
512
begin
510
513
  Result:=false;
511
514
  if NameLen<=0 then begin
517
520
  // check trailing spaces
518
521
  if StartPos[NameLen-1]=' ' then exit;
519
522
  // check ./ at start
520
 
  if (StartPos[0]='.') and (StartPos[1]=PathDelim) then exit;
 
523
  if (StartPos[0]='.') and (StartPos[1] in AllowDirectorySeparators) then exit;
521
524
  i:=0;
522
525
  while i<NameLen do begin
523
 
    if StartPos[i]<>PathDelim then
 
526
    c:=StartPos[i];
 
527
    if not (c in AllowDirectorySeparators) then
524
528
      inc(i)
525
529
    else begin
 
530
      if c<>PathDelim then exit;
526
531
      inc(i);
527
532
      if i=NameLen then break;
528
533
 
529
534
      // check for double path delimiter
530
 
      if (StartPos[i]=PathDelim) then exit;
 
535
      if (StartPos[i] in AllowDirectorySeparators) then exit;
531
536
 
532
537
      if (StartPos[i]='.') and (i>0) then begin
533
538
        inc(i);
534
539
        // check /./ or /. at end
535
 
        if (StartPos[i]=PathDelim) or (i=NameLen) then exit;
 
540
        if (StartPos[i] in AllowDirectorySeparators) or (i=NameLen) then exit;
536
541
        if StartPos[i]='.' then begin
537
542
          inc(i);
538
543
          // check /../ or /.. at end
539
 
          if (StartPos[i]=PathDelim) or (i=NameLen) then exit;
 
544
          if (StartPos[i] in AllowDirectorySeparators) or (i=NameLen) then exit;
540
545
        end;
541
546
      end;
542
547
    end;
545
550
end;
546
551
 
547
552
function TrimFilename(const AFilename: string): string;
548
 
// trim double path delims, heading and trailing spaces
549
 
// and special dirs . and ..
550
 
var SrcPos, DestPos, l, DirStart: integer;
551
 
  c: char;
552
 
  MacroPos: LongInt;
 
553
//Trim leading and trailing spaces
 
554
//then call ResolveDots to trim double path delims and expand special dirs like .. and .
 
555
 
 
556
var
 
557
  Len, Start: Integer;
553
558
begin
554
 
  Result:=AFilename;
555
 
  if FilenameIsTrimmed(Result) then exit;
556
 
 
557
 
  l:=length(AFilename);
558
 
  SrcPos:=1;
559
 
  DestPos:=1;
560
 
 
561
 
  // skip trailing spaces
562
 
  while (l>=1) and (AFilename[l]=' ') do dec(l);
563
 
 
564
 
  // skip heading spaces
565
 
  while (SrcPos<=l) and (AFilename[SrcPos]=' ') do inc(SrcPos);
566
 
 
567
 
  // trim double path delimiters and special dirs . and ..
568
 
  while (SrcPos<=l) do begin
569
 
    c:=AFilename[SrcPos];
570
 
    // check for double path delims
571
 
    if (c=PathDelim) then begin
572
 
      inc(SrcPos);
573
 
      {$IFDEF Windows}
574
 
      if (DestPos>2)
575
 
      {$ELSE}
576
 
      if (DestPos>1)
577
 
      {$ENDIF}
578
 
      and (Result[DestPos-1]=PathDelim) then begin
579
 
        // skip second PathDelim
580
 
        continue;
581
 
      end;
582
 
      Result[DestPos]:=c;
583
 
      inc(DestPos);
584
 
      continue;
585
 
    end;
586
 
    // check for special dirs . and ..
587
 
    if (c='.') then begin
588
 
      if (SrcPos<l) then begin
589
 
        if (AFilename[SrcPos+1]=PathDelim)
590
 
        and ((DestPos=1) or (AFilename[SrcPos-1]=PathDelim)) then begin
591
 
          // special dir ./
592
 
          // -> skip
593
 
          inc(SrcPos,2);
594
 
          continue;
595
 
        end else if (AFilename[SrcPos+1]='.')
596
 
        and (SrcPos+1=l) or (AFilename[SrcPos+2]=PathDelim) then
597
 
        begin
598
 
          // special dir ..
599
 
          //  1. ..      -> copy
600
 
          //  2. /..     -> skip .., keep /
601
 
          //  3. C:..    -> copy
602
 
          //  4. C:\..   -> skip .., keep C:\
603
 
          //  5. \\..    -> skip .., keep \\
604
 
          //  6. xxx../..   -> copy
605
 
          //  7. xxxdir/..  -> trim dir and skip ..
606
 
          //  8. xxxdir/..  -> trim dir and skip ..
607
 
          if DestPos=1 then begin
608
 
            //  1. ..      -> copy
609
 
          end else if (DestPos=2) and (Result[1]=PathDelim) then begin
610
 
            //  2. /..     -> skip .., keep /
611
 
            inc(SrcPos,2);
612
 
            continue;
613
 
          {$IFDEF Windows}
614
 
          end else if (DestPos=3) and (Result[2]=':')
615
 
          and (Result[1] in ['a'..'z','A'..'Z']) then begin
616
 
            //  3. C:..    -> copy
617
 
          end else if (DestPos=4) and (Result[2]=':') and (Result[3]=PathDelim)
618
 
          and (Result[1] in ['a'..'z','A'..'Z']) then begin
619
 
            //  4. C:\..   -> skip .., keep C:\
620
 
            inc(SrcPos,2);
621
 
            continue;
622
 
          end else if (DestPos=3) and (Result[1]=PathDelim)
623
 
          and (Result[2]=PathDelim) then begin
624
 
            //  5. \\..    -> skip .., keep \\
625
 
            inc(SrcPos,2);
626
 
            continue;
627
 
          {$ENDIF}
628
 
          end else if (DestPos>1) and (Result[DestPos-1]=PathDelim) then begin
629
 
            if (DestPos>3)
630
 
            and (Result[DestPos-2]='.') and (Result[DestPos-3]='.')
631
 
            and ((DestPos=4) or (Result[DestPos-4]=PathDelim)) then begin
632
 
              //  6. ../..   -> copy
633
 
            end else begin
634
 
              //  7. xxxdir/..  -> trim dir and skip ..
635
 
              DirStart:=DestPos-2;
636
 
              while (DirStart>1) and (Result[DirStart-1]<>PathDelim) do
637
 
                dec(DirStart);
638
 
              MacroPos:=DirStart;
639
 
              while MacroPos<DestPos do begin
640
 
                if (Result[MacroPos]='$')
641
 
                and (Result[MacroPos+1] in ['(','a'..'z','A'..'Z']) then begin
642
 
                  // 8. directory contains a macro -> keep
643
 
                  break;
644
 
                end;
645
 
                inc(MacroPos);
646
 
              end;
647
 
              if MacroPos=DestPos then begin
648
 
                DestPos:=DirStart;
649
 
                inc(SrcPos,2);
650
 
                continue;
651
 
              end;
652
 
            end;
653
 
          end;
654
 
        end;
655
 
      end else begin
656
 
        // special dir . at end of filename
657
 
        if DestPos=1 then begin
658
 
          Result:='.';
659
 
          exit;
660
 
        end else begin
661
 
          // skip
662
 
          break;
663
 
        end;
664
 
      end;
665
 
    end;
666
 
    // copy directory
667
 
    repeat
668
 
      Result[DestPos]:=c;
669
 
      inc(DestPos);
670
 
      inc(SrcPos);
671
 
      if (SrcPos>l) then break;
672
 
      c:=AFilename[SrcPos];
673
 
      if c=PathDelim then break;
674
 
    until false;
 
559
  Result := AFileName;
 
560
  Len := Length(AFileName);
 
561
  if (Len = 0) or FilenameIsTrimmed(Result) then exit;
 
562
  if AFilename[1] = #32 then
 
563
  begin
 
564
    Start := 1;
 
565
    while (Start <= Len) and (AFilename[Start] = #32) do Inc(Start);
 
566
    System.Delete(Result,1,Start-1);
 
567
    Len := Length(AFileName);
675
568
  end;
676
 
  // trim result
677
 
  if DestPos<=length(AFilename) then
678
 
    SetLength(Result,DestPos-1);
 
569
  while (Len > 0) and (AFileName[Len] = #32) do Dec(Len);
 
570
  SetLength(Result, Len);
 
571
  Result := ResolveDots(Result);
 
572
end;
 
573
 
 
574
procedure ForcePathDelims(var FileName: string);
 
575
var
 
576
  i: Integer;
 
577
begin
 
578
  for i:=1 to length(FileName) do
 
579
    {$IFDEF Windows}
 
580
    if Filename[i]='/' then
 
581
      Filename[i]:='\';
 
582
    {$ELSE}
 
583
    if Filename[i]='\' then
 
584
      Filename[i]:='/';
 
585
    {$ENDIF}
 
586
end;
 
587
 
 
588
function GetForcedPathDelims(const FileName: string): String;
 
589
begin
 
590
  Result:=FileName;
 
591
  ForcePathDelims(Result);
679
592
end;
680
593
 
681
594
{------------------------------------------------------------------------------
683
596
 ------------------------------------------------------------------------------}
684
597
function CleanAndExpandFilename(const Filename: string): string;
685
598
begin
686
 
  Result:=ExpandFileNameUTF8(TrimFileName(SetDirSeparators(Filename)));
 
599
  Result:=ExpandFileNameUTF8(TrimFileName(Filename));
687
600
end;
688
601
 
689
602
{------------------------------------------------------------------------------
696
609
 
697
610
function TrimAndExpandFilename(const Filename: string; const BaseDir: string): string;
698
611
begin
699
 
  Result:=ChompPathDelim(TrimFilename(SetDirSeparators(Filename)));
 
612
  Result:=ChompPathDelim(TrimFilename(Filename));
700
613
  if Result='' then exit;
701
614
  Result:=TrimFilename(ExpandFileNameUTF8(Result,BaseDir));
702
615
end;
703
616
 
704
617
function TrimAndExpandDirectory(const Filename: string; const BaseDir: string): string;
705
618
begin
706
 
  Result:=TrimFilename(SetDirSeparators(Filename));
 
619
  Result:=TrimFilename(Filename);
707
620
  if Result='' then exit;
708
621
  Result:=TrimFilename(AppendPathDelim(ExpandFileNameUTF8(Result,BaseDir)));
709
622
end;
710
623
 
711
 
function CreateRelativePath(const Filename, BaseDirectory: string;
712
 
  UsePointDirectory: boolean): string;
713
 
var
714
 
  FileNameLength: Integer;
715
 
  BaseDirLen: Integer;
716
 
  SamePos: Integer;
717
 
  UpDirCount: Integer;
718
 
  BaseDirPos: Integer;
719
 
  ResultPos: Integer;
720
 
  i: Integer;
721
 
  FileNameRestLen: Integer;
722
 
  CmpBaseDirectory: String;
723
 
  CmpFilename: String;
724
 
  p: Integer;
725
 
  DirCount: Integer;
726
 
begin
727
 
  Result:=Filename;
728
 
  if (BaseDirectory='') or (Filename='') then exit;
729
 
 
730
 
  {$IFDEF Windows}
731
 
  // check for different windows file drives
732
 
  if (CompareText(ExtractFileDrive(Filename),
733
 
                  ExtractFileDrive(BaseDirectory))<>0)
734
 
  then
735
 
    exit;
736
 
  {$ENDIF}
737
 
  CmpBaseDirectory:=BaseDirectory;
738
 
  CmpFilename:=Filename;
739
 
  {$IFDEF darwin}
740
 
  CmpBaseDirectory:=GetDarwinSystemFilename(CmpBaseDirectory);
741
 
  CmpFilename:=GetDarwinSystemFilename(CmpFilename);
742
 
  {$ENDIF}
743
 
  {$IFDEF CaseInsensitiveFilenames}
744
 
  CmpBaseDirectory:=AnsiUpperCaseFileName(CmpBaseDirectory);
745
 
  CmpFilename:=AnsiUpperCaseFileName(CmpFilename);
746
 
  {$ENDIF}
747
 
 
748
 
  FileNameLength:=length(CmpFilename);
749
 
  while (FileNameLength>0) and (CmpFilename[FileNameLength]=PathDelim) do
750
 
    dec(FileNameLength);
751
 
  BaseDirLen:=length(CmpBaseDirectory);
752
 
  while (BaseDirLen>0) and (CmpBaseDirectory[BaseDirLen]=PathDelim) do
753
 
    dec(BaseDirLen);
754
 
  if BaseDirLen=0 then exit;
755
 
 
756
 
  //WriteLn('CreateRelativePath START ',copy(CmpBaseDirectory,1,BaseDirLen),' ',copy(CmpFilename,1,FileNameLength));
757
 
 
758
 
  // count shared directories
759
 
  p:=1;
760
 
  DirCount:=0;
761
 
  BaseDirPos:=p;
762
 
  while (p<=FileNameLength) and (BaseDirPos<=BaseDirLen)
763
 
  and (CmpFileName[p]=CmpBaseDirectory[BaseDirPos]) do
764
 
  begin
765
 
    if CmpFilename[p]=PathDelim then
766
 
    begin
767
 
      inc(DirCount);
768
 
      repeat
769
 
        inc(p);
770
 
      until (p>FileNameLength) or (CmpFilename[p]<>PathDelim);
771
 
      repeat
772
 
        inc(BaseDirPos);
773
 
      until (BaseDirPos>BaseDirLen) or (CmpBaseDirectory[BaseDirPos]<>PathDelim);
774
 
    end else begin
775
 
      inc(p);
776
 
      inc(BaseDirPos);
777
 
    end;
778
 
  end;
779
 
  UpDirCount:=0;
780
 
  if ((BaseDirPos>BaseDirLen) or (CmpBaseDirectory[BaseDirPos]=PathDelim))
781
 
  and ((p>FileNameLength) or (CmpFilename[p]=PathDelim)) then
782
 
  begin
783
 
    // for example File=/a BaseDir=/a/b
784
 
    inc(DirCount);
785
 
  end else begin
786
 
    // for example File=/aa BaseDir=/ab
787
 
    inc(UpDirCount);
788
 
  end;
789
 
  if DirCount=0 then exit;
790
 
  if FilenameIsAbsolute(BaseDirectory) and (DirCount=1) then exit;
791
 
 
792
 
  // calculate needed up directories
793
 
  while (BaseDirPos<=BaseDirLen) do begin
794
 
    if (CmpBaseDirectory[BaseDirPos]=PathDelim) then
795
 
    begin
796
 
      inc(UpDirCount);
797
 
      repeat
798
 
        inc(BaseDirPos);
799
 
      until (BaseDirPos>BaseDirLen) or (CmpBaseDirectory[BaseDirPos]<>PathDelim);
800
 
    end else
801
 
      inc(BaseDirPos);
802
 
  end;
803
 
 
804
 
  // create relative filename
805
 
  SamePos:=1;
806
 
  p:=0;
807
 
  FileNameLength:=length(Filename);
808
 
  while (SamePos<=FileNameLength) do begin
809
 
    if (Filename[SamePos]=PathDelim) then begin
810
 
      repeat
811
 
        inc(SamePos);
812
 
      until (SamePos>FileNameLength) or (Filename[SamePos]<>PathDelim);
813
 
      inc(p);
814
 
      if p>=DirCount then
815
 
        break;
816
 
    end else
817
 
      inc(SamePos);
818
 
  end;
819
 
  FileNameRestLen:=FileNameLength-SamePos+1;
820
 
  //writeln('DirCount=',DirCount,' UpDirCount=',UpDirCount,' FileNameRestLen=',FileNameRestLen,' SamePos=',SamePos);
821
 
  SetLength(Result,3*UpDirCount+FileNameRestLen);
822
 
  ResultPos:=1;
823
 
  for i:=1 to UpDirCount do begin
824
 
    Result[ResultPos]:='.';
825
 
    Result[ResultPos+1]:='.';
826
 
    Result[ResultPos+2]:=PathDelim;
827
 
    inc(ResultPos,3);
828
 
  end;
829
 
  if FileNameRestLen>0 then
830
 
    System.Move(Filename[SamePos],Result[ResultPos],FileNameRestLen);
831
 
 
832
 
  if UsePointDirectory and (Result='') and (Filename<>'') then
833
 
    Result:='.'; // Filename is the BaseDirectory
834
 
end;
 
624
 
835
625
 
836
626
{------------------------------------------------------------------------------
837
627
  function FileIsInPath(const Filename, Path: string): boolean;
855
645
 
856
646
function AppendPathDelim(const Path: string): string;
857
647
begin
858
 
  if (Path<>'') and (Path[length(Path)]<>PathDelim) then
 
648
  if (Path<>'') and not (Path[length(Path)] in AllowDirectorySeparators) then
859
649
    Result:=Path+PathDelim
860
650
  else
861
651
    Result:=Path;
870
660
 
871
661
  Result:=Path;
872
662
  Len:=length(Result);
873
 
  if (Result[1]=PathDelim) then begin
 
663
  if (Result[1] in AllowDirectorySeparators) then begin
874
664
    MinLen := 1;
875
665
    {$IFDEF HasUNCPaths}
876
 
    if (Len >= 2) and (Result[2]=PathDelim) then
 
666
    if (Len >= 2) and (Result[2] in AllowDirectorySeparators) then
877
667
      MinLen := 2; // keep UNC '\\', chomp 'a\' to 'a'
878
668
    {$ENDIF}
879
669
  end
881
671
    MinLen := 0;
882
672
    {$IFdef MSWindows}
883
673
    if (Len >= 3) and (Result[1] in ['a'..'z', 'A'..'Z'])  and
884
 
       (Result[2] = ':') and (Result[3]=PathDelim)
 
674
       (Result[2] = ':') and (Result[3] in AllowDirectorySeparators)
885
675
    then
886
676
      MinLen := 3;
887
677
    {$ENDIF}
888
678
  end;
889
679
 
890
 
  while (Len > MinLen) and (Result[Len]=PathDelim) do dec(Len);
 
680
  while (Len > MinLen) and (Result[Len] in AllowDirectorySeparators) do dec(Len);
891
681
  if Len<length(Result) then
892
682
    SetLength(Result,Len);
893
683
end;
987
777
      inc(EndPos);
988
778
    if StartPos<EndPos then begin
989
779
      // trim path and chomp PathDelim
990
 
      if (Result[EndPos-1]=PathDelim)
 
780
      if (Result[EndPos-1] in AllowDirectorySeparators)
991
781
      or (not FilenameIsTrimmed(@Result[StartPos],EndPos-StartPos)) then begin
992
782
        NewPath:=ChompPathDelim(
993
783
                           TrimFilename(copy(Result,StartPos,EndPos-StartPos)));
1027
817
  if SearchPath=nil then exit;
1028
818
  if (APath=nil) or (APathLen=0) then exit;
1029
819
  // ignore trailing PathDelim at end
1030
 
  while (APathLen>1) and (APath[APathLen-1]=PathDelim) do dec(APathLen);
 
820
  while (APathLen>1) and (APath[APathLen-1] in AllowDirectorySeparators) do dec(APathLen);
1031
821
 
1032
822
  {$IFDEF CaseInsensitiveFilenames}
1033
823
  UseQuickCompare:=false;
1053
843
      inc(NextStartPos);
1054
844
    EndPos:=NextStartPos;
1055
845
    // ignore trailing PathDelim at end
1056
 
    while (EndPos>StartPos+1) and (SearchPath[EndPos-1]=PathDelim) do
 
846
    while (EndPos>StartPos+1) and (SearchPath[EndPos-1] in AllowDirectorySeparators) do
1057
847
      dec(EndPos);
1058
848
    // compare current path
1059
849
    if UseQuickCompare then begin
1083
873
  end;
1084
874
end;
1085
875
 
1086
 
function FileExistsUTF8(const Filename: string): boolean;
1087
 
begin
1088
 
  Result:=SysUtils.FileExists(UTF8ToSys(Filename));
1089
 
end;
1090
 
 
1091
 
function FileAgeUTF8(const FileName: String): Longint;
1092
 
begin
1093
 
  Result:=SysUtils.FileAge(UTF8ToSys(Filename));
1094
 
end;
1095
 
 
1096
 
function DirectoryExistsUTF8(const Directory: string): Boolean;
1097
 
begin
1098
 
  Result:=SysUtils.DirectoryExists(UTF8ToSys(Directory));
1099
 
end;
1100
 
 
1101
 
function ExpandFileNameUTF8(const FileName: string; const BaseDir: string): string;
1102
 
{$IFDEF Unix}
1103
 
  {$DEFINE ExpandTilde}
1104
 
{$ENDIF}
1105
 
{$IFDEF Windows}
1106
 
  {$DEFINE UppercaseDrive}
1107
 
{$ENDIF}
1108
 
{$IFDEF ExpandTilde}
1109
 
var
1110
 
  HomeDir: String;
1111
 
{$ENDIF}
1112
 
begin
1113
 
  Result:=FileName;
1114
 
  if Result='' then exit('');
1115
 
  Result:=SetDirSeparators(Result);
1116
 
  if BaseDir='' then
1117
 
  begin
1118
 
    // use RTL function, which uses GetCurrentDir
1119
 
    Result:=SysToUTF8(SysUtils.ExpandFileName(UTF8ToSys(Result)));
1120
 
  end else begin
1121
 
    {$IFDEF ExpandTilde}
1122
 
    // expand ~
1123
 
    if (Result<>'') and (Result[1]='~') then
 
876
function FileSearchUTF8(const Name, DirList: String; ImplicitCurrentDir : Boolean = True): String;
 
877
Var
 
878
  I : longint;
 
879
  Temp : String;
 
880
 
 
881
begin
 
882
  Result:=Name;
 
883
  temp:=SetDirSeparators(DirList);
 
884
  // Start with checking the file in the current directory
 
885
  If ImplicitCurrentDir and (Result <> '') and FileExistsUTF8(Result) Then
 
886
    exit;
 
887
  while True do begin
 
888
    If Temp = '' then
 
889
      Break; // No more directories to search - fail
 
890
    I:=pos(PathSeparator,Temp);
 
891
    If I<>0 then
 
892
      begin
 
893
        Result:=Copy (Temp,1,i-1);
 
894
        system.Delete(Temp,1,I);
 
895
      end
 
896
    else
 
897
      begin
 
898
        Result:=Temp;
 
899
        Temp:='';
 
900
      end;
 
901
    If Result<>'' then
 
902
      Result:=AppendPathDelim(Result)+Name;
 
903
    If (Result <> '') and FileExistsUTF8(Result) Then
 
904
      exit;
 
905
  end;
 
906
  Result:='';
 
907
end;
 
908
 
 
909
function FileIsReadOnlyUTF8(const FileName: String): Boolean;
 
910
begin
 
911
  Result:=FileGetAttrUTF8(FileName) and faReadOnly > 0;
 
912
end;
 
913
 
 
914
 
 
915
 
 
916
function GetTempFileNameUTF8(const Dir, Prefix: String): String;
 
917
var
 
918
  I: Integer;
 
919
  Start: String;
 
920
begin
 
921
  if Assigned(OnGetTempFile) then
 
922
    Result:=OnGetTempFile(Dir,Prefix)
 
923
  else
 
924
  begin
 
925
    if (Dir='') then
 
926
      Start:=GetTempDir
 
927
    else
 
928
      Start:=IncludeTrailingPathDelimiter(Dir);
 
929
    if (Prefix='') then
 
930
      Start:=Start+'TMP'
 
931
    else
 
932
      Start:=Start+Prefix;
 
933
    I:=0;
 
934
    repeat
 
935
      Result:=Format('%s%.5d.tmp',[Start,I]);
 
936
      Inc(I);
 
937
    until not FileExistsUTF8(Result);
 
938
  end;
 
939
end;
 
940
 
 
941
function ForceDirectoriesUTF8(const Dir: string): Boolean;
 
942
var
 
943
  E: EInOutError;
 
944
  ADrv : String;
 
945
 
 
946
  function DoForceDirectories(Const Dir: string): Boolean;
 
947
  var
 
948
    ADir : String;
 
949
    APath: String;
 
950
  begin
 
951
    Result:=True;
 
952
    ADir:=ExcludeTrailingPathDelimiter(Dir);
 
953
    if (ADir='') then Exit;
 
954
    if Not DirectoryExistsUTF8(ADir) then
 
955
      begin
 
956
        APath := ExtractFilePath(ADir);
 
957
        //this can happen on Windows if user specifies Dir like \user\name/test/
 
958
        //and would, if not checked for, cause an infinite recusrsion and a stack overflow
 
959
        if (APath = ADir) then
 
960
          Result := False
 
961
        else
 
962
          Result:=DoForceDirectories(APath);
 
963
        if Result then
 
964
          Result := CreateDirUTF8(ADir);
 
965
      end;
 
966
  end;
 
967
 
 
968
  function IsUncDrive(const Drv: String): Boolean;
 
969
  begin
 
970
    Result := (Length(Drv) > 2) and (Drv[1] in AllowDirectorySeparators) and (Drv[2] in AllowDirectorySeparators);
 
971
  end;
 
972
 
 
973
begin
 
974
  Result := False;
 
975
  ADrv := ExtractFileDrive(Dir);
 
976
  if (ADrv<>'') and (not DirectoryExistsUTF8(ADrv))
 
977
  {$IFNDEF FORCEDIR_NO_UNC_SUPPORT} and (not IsUncDrive(ADrv)){$ENDIF} then Exit;
 
978
  if Dir='' then
1124
979
    begin
1125
 
      {$Hint use GetEnvironmentVariableUTF8}
1126
 
      HomeDir := TrimAndExpandDirectory(GetEnvironmentVariable('HOME'));
1127
 
      Result := HomeDir+copy(Result,2,length(Result));
 
980
      E:=EInOutError.Create(SCannotCreateEmptyDir);
 
981
      E.ErrorCode:=3;
 
982
      Raise E;
1128
983
    end;
1129
 
    {$ENDIF}
1130
 
    // trim
1131
 
    Result := TrimFilename(Result);
1132
 
    {$IFDEF UppercaseDrive}
1133
 
    if (Length(Result)>=2) and (Result[1] in ['a'..'z']) and (Result[2]=':') then
1134
 
      Result[1]:=chr(ord(Result[1])+ord('A')-ord('a'));
1135
 
    {$ENDIF}
1136
 
    // ToDo: expand C:a
1137
 
 
1138
 
    // make absolute
1139
 
    if not FilenameIsAbsolute(Result) then
1140
 
      Result := TrimAndExpandDirectory(BaseDir) + Result;
1141
 
  end;
1142
 
end;
1143
 
 
1144
 
function FindFirstUTF8(const Path: string; Attr: Longint; out Rslt: TSearchRec
1145
 
  ): Longint;
1146
 
begin
1147
 
  Result:=SysUtils.FindFirst(UTF8ToSys(Path),Attr,Rslt);
1148
 
  Rslt.Name:=SysToUTF8(Rslt.Name);
1149
 
end;
1150
 
 
1151
 
function FindNextUTF8(var Rslt: TSearchRec): Longint;
1152
 
begin
1153
 
  Rslt.Name:=UTF8ToSys(Rslt.Name);
1154
 
  Result:=SysUtils.FindNext(Rslt);
1155
 
  Rslt.Name:=SysToUTF8(Rslt.Name);
1156
 
end;
1157
 
 
1158
 
procedure FindCloseUTF8(var F: TSearchrec);
1159
 
begin
1160
 
  SysUtils.FindClose(F);
1161
 
end;
1162
 
 
1163
 
function FileSetDateUTF8(const FileName: String; Age: Longint): Longint;
1164
 
begin
1165
 
  Result:=SysUtils.FileSetDate(UTF8ToSys(Filename),Age);
1166
 
  InvalidateFileStateCache(Filename);
1167
 
end;
1168
 
 
1169
 
function FileGetAttrUTF8(const FileName: String): Longint;
1170
 
begin
1171
 
  Result:=SysUtils.FileGetAttr(UTF8ToSys(Filename));
1172
 
end;
1173
 
 
1174
 
function FileSetAttrUTF8(const Filename: String; Attr: longint): Longint;
1175
 
begin
1176
 
  Result:=SysUtils.FileSetAttr(UTF8ToSys(Filename),Attr);
1177
 
  InvalidateFileStateCache(Filename);
1178
 
end;
1179
 
 
1180
 
function DeleteFileUTF8(const FileName: String): Boolean;
1181
 
begin
1182
 
  Result:=SysUtils.DeleteFile(UTF8ToSys(Filename));
1183
 
  if Result then
1184
 
    InvalidateFileStateCache;
1185
 
end;
1186
 
 
1187
 
function RenameFileUTF8(const OldName, NewName: String): Boolean;
1188
 
begin
1189
 
  Result:=SysUtils.RenameFile(UTF8ToSys(OldName),UTF8ToSys(NewName));
1190
 
  if Result then
1191
 
    InvalidateFileStateCache;
1192
 
end;
1193
 
 
1194
 
function FileSearchUTF8(const Name, DirList: String): String;
1195
 
begin
1196
 
  Result:=SysToUTF8(SysUtils.FileSearch(UTF8ToSys(Name),UTF8ToSys(DirList)));
1197
 
end;
1198
 
 
1199
 
function FileIsReadOnlyUTF8(const FileName: String): Boolean;
1200
 
begin
1201
 
  Result:=SysUtils.FileIsReadOnly(UTF8ToSys(Filename));
1202
 
end;
1203
 
 
1204
 
function GetCurrentDirUTF8: String;
1205
 
begin
1206
 
  Result:=SysToUTF8(SysUtils.GetCurrentDir);
1207
 
end;
1208
 
 
1209
 
function SetCurrentDirUTF8(const NewDir: String): Boolean;
1210
 
begin
1211
 
  Result:=SysUtils.SetCurrentDir(UTF8ToSys(NewDir));
1212
 
end;
1213
 
 
1214
 
function CreateDirUTF8(const NewDir: String): Boolean;
1215
 
begin
1216
 
  Result:=SysUtils.CreateDir(UTF8ToSys(NewDir));
1217
 
end;
1218
 
 
1219
 
function RemoveDirUTF8(const Dir: String): Boolean;
1220
 
begin
1221
 
  Result:=SysUtils.RemoveDir(UTF8ToSys(Dir));
1222
 
end;
1223
 
 
1224
 
function ForceDirectoriesUTF8(const Dir: string): Boolean;
1225
 
begin
1226
 
  Result:=SysUtils.ForceDirectories(UTF8ToSys(Dir));
1227
 
end;
 
984
  Result := DoForceDirectories(GetForcedPathDelims(Dir));
 
985
end;
 
986
 
1228
987
 
1229
988
procedure InvalidateFileStateCache(const Filename: string);
1230
989
begin
1232
991
    OnInvalidateFileStateCache(Filename);
1233
992
end;
1234
993
 
1235
 
function IsUNCPath(const Path: String): Boolean;
1236
 
begin
1237
 
  {$IFDEF Windows}
1238
 
  Result := (Length(Path) > 2) and (Path[1] = PathDelim) and (Path[2] = PathDelim);
1239
 
  {$ELSE}
1240
 
  Result := false;
1241
 
  {$ENDIF}
1242
 
end;
1243
 
 
1244
 
function ExtractUNCVolume(const Path: String): String;
1245
 
{$IFDEF Windows}
 
994
procedure SplitCmdLineParams(const Params: string; ParamList: TStrings;
 
995
                             ReadBackslash: boolean = false);
 
996
// split spaces, quotes are parsed as single parameter
 
997
// if ReadBackslash=true then \" is replaced to " and not treated as quote
 
998
// #0 is always end
 
999
type
 
1000
  TMode = (mNormal,mApostrophe,mQuote);
1246
1001
var
1247
 
  I, Len: Integer;
1248
 
 
1249
 
  // the next function reuses Len variable
1250
 
  function NextPathDelim(const Start: Integer): Integer;// inline;
1251
 
  begin
1252
 
    Result := Start;
1253
 
    while (Result <= Len) and (Path[Result] <> PathDelim) do
1254
 
      inc(Result);
1255
 
  end;
1256
 
 
 
1002
  p: Integer;
 
1003
  Mode: TMode;
 
1004
  Param: String;
1257
1005
begin
1258
 
  if not IsUNCPath(Path) then
1259
 
    Exit('');
1260
 
  I := 3;
1261
 
  Len := Length(Path);
1262
 
  if Path[I] = '?' then
 
1006
  p:=1;
 
1007
  while p<=length(Params) do
1263
1008
  begin
1264
 
    // Long UNC path form like:
1265
 
    // \\?\UNC\ComputerName\SharedFolder\Resource or
1266
 
    // \\?\C:\Directory
1267
 
    inc(I);
1268
 
    if Path[I] <> PathDelim then
1269
 
      Exit('');
1270
 
    if UpperCase(Copy(Path, I + 1, 3)) = 'UNC' then
 
1009
    // skip whitespace
 
1010
    while (p<=length(Params)) and (Params[p] in [' ',#9,#10,#13]) do inc(p);
 
1011
    if (p>length(Params)) or (Params[p]=#0) then
 
1012
      break;
 
1013
    //writeln('SplitCmdLineParams After Space p=',p,'=[',Params[p],']');
 
1014
    // read param
 
1015
    Param:='';
 
1016
    Mode:=mNormal;
 
1017
    while p<=length(Params) do
1271
1018
    begin
1272
 
      inc(I, 4);
1273
 
      if I < Len then
1274
 
        I := NextPathDelim(I + 1);
1275
 
      if I < Len then
1276
 
        I := NextPathDelim(I + 1);
 
1019
      case Params[p] of
 
1020
      #0:
 
1021
        break;
 
1022
      '\':
 
1023
        begin
 
1024
          inc(p);
 
1025
          if ReadBackslash then
 
1026
            begin
 
1027
            // treat next character as normal character
 
1028
            if (p>length(Params)) or (Params[p]=#0) then
 
1029
              break;
 
1030
            if ord(Params[p])<128 then
 
1031
            begin
 
1032
              Param+=Params[p];
 
1033
              inc(p);
 
1034
            end else begin
 
1035
              // next character is already a normal character
 
1036
            end;
 
1037
          end else begin
 
1038
            // treat backslash as normal character
 
1039
            Param+='\';
 
1040
          end;
 
1041
        end;
 
1042
      '''':
 
1043
        begin
 
1044
          inc(p);
 
1045
          case Mode of
 
1046
          mNormal:
 
1047
            Mode:=mApostrophe;
 
1048
          mApostrophe:
 
1049
            Mode:=mNormal;
 
1050
          mQuote:
 
1051
            Param+='''';
 
1052
          end;
 
1053
        end;
 
1054
      '"':
 
1055
        begin
 
1056
          inc(p);
 
1057
          case Mode of
 
1058
          mNormal:
 
1059
            Mode:=mQuote;
 
1060
          mApostrophe:
 
1061
            Param+='"';
 
1062
          mQuote:
 
1063
            Mode:=mNormal;
 
1064
          end;
 
1065
        end;
 
1066
      ' ',#9,#10,#13:
 
1067
        begin
 
1068
          if Mode=mNormal then break;
 
1069
          Param+=Params[p];
 
1070
          inc(p);
 
1071
        end;
 
1072
      else
 
1073
        Param+=Params[p];
 
1074
        inc(p);
 
1075
      end;
1277
1076
    end;
1278
 
  end
1279
 
  else
 
1077
    //writeln('SplitCmdLineParams Param=#'+Param+'#');
 
1078
    ParamList.Add(Param);
 
1079
  end;
 
1080
end;
 
1081
 
 
1082
function StrToCmdLineParam(const Param: string): string;
 
1083
{ <empty> -> ''
 
1084
  word -> word
 
1085
  word1 word2 -> 'word1 word2'
 
1086
  word's -> "word's"
 
1087
  a" -> 'a"'
 
1088
  "a" -> '"a"'
 
1089
  'a' -> "'a'"
 
1090
  #0 character -> cut the rest
 
1091
}
 
1092
const
 
1093
  NoQuot = ' ';
 
1094
  AnyQuot = '*';
 
1095
var
 
1096
  Quot: Char;
 
1097
  p: PChar;
 
1098
  i: Integer;
 
1099
begin
 
1100
  Result:=Param;
 
1101
  if Result='' then
 
1102
    Result:=''''''
 
1103
  else begin
 
1104
    p:=PChar(Result);
 
1105
    Quot:=NoQuot;
 
1106
    repeat
 
1107
      case p^ of
 
1108
      #0:
 
1109
        begin
 
1110
          i:=p-PChar(Result);
 
1111
          if i<length(Result) then
 
1112
            Delete(Result,i+1,length(Result));
 
1113
          case Quot of
 
1114
          AnyQuot: Result:=''''+Result+'''';
 
1115
          '''': Result+='''';
 
1116
          '"':  Result+='"';
 
1117
          end;
 
1118
          break;
 
1119
        end;
 
1120
      ' ',#9,#10,#13:
 
1121
        begin
 
1122
          if Quot=NoQuot then
 
1123
            Quot:=AnyQuot;
 
1124
          inc(p);
 
1125
        end;
 
1126
      '''':
 
1127
        begin
 
1128
          case Quot of
 
1129
          NoQuot,AnyQuot:
 
1130
            begin
 
1131
              // need "
 
1132
              Quot:='"';
 
1133
              i:=p-PChar(Result);
 
1134
              System.Insert('"',Result,1);
 
1135
              p:=PChar(Result)+i+1;
 
1136
            end;
 
1137
          '"':
 
1138
            inc(p);
 
1139
          '''':
 
1140
            begin
 
1141
              // ' within a '
 
1142
              // => end ', start "
 
1143
              i:=p-PChar(Result)+1;
 
1144
              System.Insert('''"',Result,i);
 
1145
              p:=PChar(Result)+i+1;
 
1146
              Quot:='"';
 
1147
            end;
 
1148
          end;
 
1149
        end;
 
1150
      '"':
 
1151
        begin
 
1152
          case Quot of
 
1153
          NoQuot,AnyQuot:
 
1154
            begin
 
1155
              // need '
 
1156
              Quot:='''';
 
1157
              i:=p-PChar(Result);
 
1158
              System.Insert('''',Result,1);
 
1159
              p:=PChar(Result)+i+1;
 
1160
            end;
 
1161
          '''':
 
1162
            inc(p);
 
1163
          '"':
 
1164
            begin
 
1165
              // " within a "
 
1166
              // => end ", start '
 
1167
              i:=p-PChar(Result)+1;
 
1168
              System.Insert('"''',Result,i);
 
1169
              p:=PChar(Result)+i+1;
 
1170
              Quot:='''';
 
1171
            end;
 
1172
          end;
 
1173
        end;
 
1174
      else
 
1175
        inc(p);
 
1176
      end;
 
1177
    until false;
 
1178
  end;
 
1179
end;
 
1180
 
 
1181
function MergeCmdLineParams(ParamList: TStrings): string;
 
1182
var
 
1183
  i: Integer;
 
1184
begin
 
1185
  Result:='';
 
1186
  if ParamList=nil then exit;
 
1187
  for i:=0 to ParamList.Count-1 do
1280
1188
  begin
1281
 
    I := NextPathDelim(I);
1282
 
    if I < Len then
1283
 
      I := NextPathDelim(I + 1);
 
1189
    if i>0 then Result+=' ';
 
1190
    Result+=StrToCmdLineParam(ParamList[i]);
1284
1191
  end;
1285
 
  Result := Copy(Path, 1, I);
1286
1192
end;
1287
 
{$ELSE}
 
1193
 
 
1194
{
 
1195
  Returns
 
1196
  - DriveLetter + : + PathDelim on Windows (if present) or
 
1197
  - UNC Share on Windows if present or
 
1198
  - PathDelim if FileName starts with PathDelim on Unix or Wince or
 
1199
  - Empty string of non eof the above applies
 
1200
}
 
1201
function ExtractFileRoot(FileName: String): String;
 
1202
var
 
1203
  Len: Integer;
1288
1204
begin
1289
1205
  Result := '';
 
1206
  Len := Length(FileName);
 
1207
  if (Len > 0) then
 
1208
  begin
 
1209
    if IsUncPath(FileName) then
 
1210
    begin
 
1211
      Result := ExtractUNCVolume(FileName);
 
1212
      // is it like \\?\C:\Directory?  then also include the "C:\" part
 
1213
      if (Result = '\\?\') and (Length(FileName) > 6) and
 
1214
         (FileName[5] in ['a'..'z','A'..'Z']) and (FileName[6] = ':') and (FileName[7] in AllowDirectorySeparators)
 
1215
      then
 
1216
        Result := Copy(FileName, 1, 7);
 
1217
    end
 
1218
    else
 
1219
    begin
 
1220
      {$if defined(unix) or defined(wince)}
 
1221
      if (FileName[1] = PathDelim) then Result := PathDelim;
 
1222
      {$else}
 
1223
      if (Len > 2) and (FileName[1] in ['a'..'z','A'..'Z']) and (FileName[2] = ':') and (FileName[3] in AllowDirectorySeparators) then
 
1224
        Result := UpperCase(Copy(FileName,1,3));
 
1225
      {$endif}
 
1226
    end;
 
1227
  end;
1290
1228
end;
1291
 
{$ENDIF}
 
1229
 
 
1230
initialization
 
1231
  InitLazFileUtils;
 
1232
 
 
1233
finalization
 
1234
  FinalizeLazFileUtils;
 
1235
 
 
1236
end.
1292
1237
 
1293
1238
end.
1294
1239