paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 22:29:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

* rawbytestring/unicodestring versions of findfirst/findnext/findclose

Browse Source 
o these routines are now generic wrappers in filutil.inc, and call
     the platform-dependent internalfindfirst/next/close routines
   o on unix, the fnmatch routine got proper support for UTF-8 matching
     (e.g., it won't match a partial UTF-8 code point to a "?" wildcard)
   o for NativeNT, a similar (untested) UTF-16 version has been added
  + test for the above
  * rawbytestring/unicodestring versions of fileage

git-svn-id: branches/cpstrrtl@25302 -
This commit is contained in:
Jonas Maebe 2013-08-19 22:04:25 +00:00
parent df97cd65d9
commit af3f12f60c
24 changed files with 1209 additions and 437 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -12117,6 +12117,7 @@ tests/test/units/sysutils/texec2.pp svneol=native#text/plain
tests/test/units/sysutils/texpfncase.pp svneol=native#text/plain
tests/test/units/sysutils/textractquote.pp svneol=native#text/plain
tests/test/units/sysutils/tfexpand2.pp svneol=native#text/plain
tests/test/units/sysutils/tffirst.pp svneol=native#text/plain
tests/test/units/sysutils/tfile1.pp svneol=native#text/plain
tests/test/units/sysutils/tfile2.pp svneol=native#text/plain
tests/test/units/sysutils/tfilename.pp svneol=native#text/plain

27
rtl/amiga/sysutils.pp
View File

@ -262,9 +262,9 @@ end;
(****** end of non portable routines ******)
function FileAge (const FileName : String): Longint;
function FileAge (const FileName : RawByteString): Longint;
var
tmpName: String;
tmpName: RawByteString;
tmpLock: Longint;
tmpFIB : PFileInfoBlock;
tmpDateTime: TDateTime;
@ -272,7 +272,7 @@ var
begin
validFile:=false;
tmpName := PathConv(FileName);
tmpName := PathConv(ToSingleByteFileSystemEncodedFileName(FileName));
tmpLock := dosLock(tmpName, SHARED_LOCK);
if (tmpLock <> 0) then begin
@ -311,15 +311,15 @@ begin
end;
function FindFirst(const Path: String; Attr : Longint; out Rslt: TSearchRec): Longint;
Function InternalFindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name: RawByteString) : Longint;
var
tmpStr: array[0..255] of Char;
tmpStr: RawByteString;
Anchor: PAnchorPath;
tmpDateTime: TDateTime;
validDate: boolean;
begin
result:=-1; { We emulate Linux/Unix behaviour, and return -1 on errors. }
tmpStr:=PathConv(path)+#0;
tmpStr:=PathConv(ToSingleByteEncodedFileName(path));
{ $1e = faHidden or faSysFile or faVolumeID or faDirectory }
Rslt.ExcludeAttr := (not Attr) and ($1e);
@ -328,11 +328,12 @@ begin
new(Anchor);
FillChar(Anchor^,sizeof(TAnchorPath),#0);
if MatchFirst(@tmpStr,Anchor)<>0 then exit;
if MatchFirst(pchar(tmpStr),Anchor)<>0 then exit;
Rslt.FindHandle := longint(Anchor);
with Anchor^.ap_Info do begin
Rslt.Name := StrPas(fib_FileName);
Name := fib_FileName;
SetCodePage(Name,DefaultFileSystemCodePage,false);
Rslt.Size := fib_Size;
Rslt.Time := DateTimeToFileDate(AmigaFileDateToDateTime(fib_Date,validDate));
@ -350,7 +351,7 @@ begin
end;
function FindNext (var Rslt : TSearchRec): Longint;
Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : RawByteString) : Longint;
var
Anchor: PAnchorPath;
validDate: boolean;
@ -362,7 +363,8 @@ begin
if MatchNext(Anchor) <> 0 then exit;
with Anchor^.ap_Info do begin
Rslt.Name := StrPas(fib_FileName);
Name := fib_FileName;
SetCodePage(Name,DefaultFileSystemCodePage,false);
Rslt.Size := fib_Size;
Rslt.Time := DateTimeToFileDate(AmigaFileDateToDateTime(fib_Date,validDate));
if not validDate then exit;
@ -378,14 +380,15 @@ begin
end;
procedure FindClose(var f: TSearchRec);
Procedure InternalFindClose(var Handle: THandle);
var
Anchor: PAnchorPath;
begin
Anchor:=PAnchorPath(f.FindHandle);
Anchor:=PAnchorPath(Handle);
if not assigned(Anchor) then exit;
MatchEnd(Anchor);
Dispose(Anchor);
Handle:=THandle(nil);
end;

8
rtl/embedded/sysutils.pp
View File

@ -121,7 +121,7 @@ begin
end;
Function FileAge (Const FileName : String): Longint;
Function FileAge (Const FileName : RawByteString): Longint;
begin
result := -1;
end;
@ -133,19 +133,19 @@ Begin
end;
Function FindFirst (Const Path : String; Attr : Longint; Out Rslt : TSearchRec) : Longint;
Function InternalFindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name: RawByteString) : Longint;
begin
result := -1;
end;
Function FindNext (Var Rslt : TSearchRec) : Longint;
Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : RawByteString) : Longint;
begin
result := -1;
end;
Procedure FindClose (Var F : TSearchrec);
Procedure InternalFindClose(var Handle: THandle);
begin
end;

36
rtl/emx/sysutils.pp
View File

@ -643,7 +643,7 @@ asm
end {['eax', 'ebx', 'ecx', 'edx']};
function FileAge (const FileName: string): longint;
function FileAge (const FileName: RawByteString): longint;
var Handle: longint;
begin
Handle := FileOpen (FileName, 0);
@ -679,9 +679,10 @@ type
end;
PSearchRec = ^SearchRec;
function FindFirst (const Path: string; Attr: longint; out Rslt: TSearchRec): longint;
Function InternalFindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name: RawByteString) : Longint;
var
SystemEncodedPath: RawByteString;
SR: PSearchRec;
FStat: PFileFindBuf3L;
Count: cardinal;
@ -690,14 +691,15 @@ var
begin
if os_mode = osOS2 then
begin
SystemEncodedPath:=ToSingleByteEncodedFileName(Path);
New (FStat);
Rslt.FindHandle := THandle ($FFFFFFFF);
Count := 1;
if FSApi64 then
Err := DosFindFirst (PChar (Path), Rslt.FindHandle,
Err := DosFindFirst (PChar (SystemEncodedPath), Rslt.FindHandle,
Attr and FindResvdMask, FStat, SizeOf (FStat^), Count, ilStandardL)
else
Err := DosFindFirst (PChar (Path), Rslt.FindHandle,
Err := DosFindFirst (PChar (SystemEncodedPath), Rslt.FindHandle,
Attr and FindResvdMask, FStat, SizeOf (FStat^), Count, ilStandard);
if (Err = 0) and (Count = 0) then
Err := 18;
@ -710,15 +712,16 @@ begin
if FSApi64 then
begin
Rslt.Size := FStat^.FileSize;
Rslt.Name := FStat^.Name;
Name := FStat^.Name;
Rslt.Attr := FStat^.AttrFile;
end
else
begin
Rslt.Size := PFileFindBuf3 (FStat)^.FileSize;
Rslt.Name := PFileFindBuf3 (FStat)^.Name;
Name := PFileFindBuf3 (FStat)^.Name;
Rslt.Attr := PFileFindBuf3 (FStat)^.AttrFile;
end;
SetCodePage(Name, DefaultFileSystemCodePage, false);
end
else
FindClose (Rslt);
@ -738,14 +741,15 @@ begin
Rslt.Size := cardinal (SR^.Size);
Rslt.Attr := SR^.Attr;
Rslt.ExcludeAttr := 0;
Rslt.Name := SR^.Name;
Name := SR^.Name;
SetCodePage(Name, DefaultFileSystemCodePage, false);
end;
DOS.DosError := Err;
end;
end;
function FindNext (var Rslt: TSearchRec): longint;
Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : RawByteString) : Longint;
var
SR: PSearchRec;
@ -770,15 +774,16 @@ begin
if FSApi64 then
begin
Rslt.Size := FStat^.FileSize;
Rslt.Name := FStat^.Name;
Name := FStat^.Name;
Rslt.Attr := FStat^.AttrFile;
end
else
begin
Rslt.Size := PFileFindBuf3 (FStat)^.FileSize;
Rslt.Name := PFileFindBuf3 (FStat)^.Name;
Name := PFileFindBuf3 (FStat)^.Name;
Rslt.Attr := PFileFindBuf3 (FStat)^.AttrFile;
end;
SetCodePage(Name, DefaultFileSystemCodePage, false);
end;
Dispose (FStat);
end
@ -796,29 +801,30 @@ begin
Rslt.Size := cardinal (SR^.Size);
Rslt.Attr := SR^.Attr;
Rslt.ExcludeAttr := 0;
Rslt.Name := SR^.Name;
Name := SR^.Name;
SetCodePage(Name, DefaultFileSystemCodePage, false);
end;
end;
end;
end;
procedure FindClose (var F: TSearchrec);
Procedure InternalFindClose(var Handle: THandle);
var SR: PSearchRec;
begin
if os_mode = osOS2 then
begin
DosFindClose (F.FindHandle);
DosFindClose (Handle);
end
else
begin
SR := PSearchRec (F.FindHandle);
SR := PSearchRec (Handle);
DOS.FindClose (SR^);
FreeMem (SR, SizeOf (SearchRec));
end;
F.FindHandle := 0;
Handle := 0;
end;

8
rtl/gba/sysutils.pp
View File

@ -138,7 +138,7 @@ end;
(****** end of non portable routines ******)
Function FileAge (Const FileName : String): Longint;
Function FileAge (Const FileName : RawByteString): Longint;
begin
result := -1;
end;
@ -151,18 +151,18 @@ end;
Function FindFirst (Const Path : String; Attr : Longint; Out Rslt : TSearchRec) : Longint;
Function InternalFindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name: RawByteString) : Longint;
begin
result := -1;
end;
Function FindNext (Var Rslt : TSearchRec) : Longint;
Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : RawByteString) : Longint;
begin
result := -1;
end;
Procedure FindClose (Var F : TSearchrec);
Procedure InternalFindClose(var Handle: THandle);
begin
end;

20
rtl/go32v2/sysutils.pp
View File

@ -282,7 +282,7 @@ begin
end;
Function FileAge (Const FileName : String): Longint;
Function FileAge (Const FileName : RawByteString): Longint;
var Handle: longint;
begin
Handle := FileOpen(FileName, 0);
@ -354,7 +354,7 @@ begin
end;
Function FindFirst (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;
Function InternalFindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name: RawByteString) : Longint;
Var Sr : PSearchrec;
@ -362,6 +362,8 @@ begin
//!! Sr := New(PSearchRec);
getmem(sr,sizeof(searchrec));
Rslt.FindHandle := longint(Sr);
{ no use in converting to defaultfilesystemcodepage, since the Dos shortstring
interface is called here }
DOS.FindFirst(Path, Attr, Sr^);
result := -DosError;
if result = 0 then
@ -370,12 +372,13 @@ begin
Rslt.Size := Sr^.Size;
Rslt.Attr := Sr^.Attr;
Rslt.ExcludeAttr := 0;
Rslt.Name := Sr^.Name;
Name := Sr^.Name;
SetCodePage(Name,DefaultFileSystemCodePage,False);
end ;
end;
Function FindNext (Var Rslt : TSearchRec) : Longint;
Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : RawByteString) : Longint;
var
Sr: PSearchRec;
begin
@ -390,17 +393,18 @@ begin
Rslt.Size := Sr^.Size;
Rslt.Attr := Sr^.Attr;
Rslt.ExcludeAttr := 0;
Rslt.Name := Sr^.Name;
Name := Sr^.Name;
SetCodePage(Name,DefaultFileSystemCodePage,False);
end;
end;
end;
Procedure FindClose (Var F : TSearchrec);
Procedure InternalFindClose(var Handle: THandle);
var
Sr: PSearchRec;
begin
Sr := PSearchRec(F.FindHandle);
Sr := PSearchRec(Handle);
if Sr <> nil then
begin
//!! Dispose(Sr);
@ -408,7 +412,7 @@ begin
DOS.FindClose(SR^);
freemem(sr,sizeof(searchrec));
end;
F.FindHandle := 0;
Handle := 0;
end;

24
rtl/macos/sysutils.pp
View File

@ -185,7 +185,7 @@ begin
*)
end;
Function FileAge (Const FileName : String): Longint;
Function FileAge (Const FileName : RawByteString): Longint;
(*
Var Info : Stat;
@ -295,7 +295,7 @@ end;
*)
procedure DoFind (var F: TSearchRec; firstTime: Boolean);
procedure DoFind (var F: TSearchRec; var retname: RawByteString; firstTime: Boolean);
var
err: OSErr;
@ -329,7 +329,8 @@ begin
attr := GetFileAttrFromPB(Rslt.paramBlock);
if ((Attr and not(searchAttr)) = 0) then
begin
name := s;
retname := s;
SetCodePage(retname, DefaultFileSystemCodePage, false);
UpperString(s, true);
if FNMatch(Rslt.searchFSSpec.name, s) then
@ -345,13 +346,11 @@ begin
end;
Function FindFirst (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;
Function InternalFindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name: RawByteString) : Longint;
var
s: Str255;
begin
fillchar(Rslt, sizeof(Rslt), 0);
if path = '' then
begin
Result := 3;
@ -361,10 +360,12 @@ begin
{We always also search for readonly and archive, regardless of Attr.}
Rslt.searchAttr := (Attr or (archive or readonly));
{ TODO: convert PathArgToFSSpec (and the routines it calls) to rawbytestring }
Result := PathArgToFSSpec(path, Rslt.searchFSSpec);
with Rslt do
if (Result = 0) or (Result = 2) then
begin
{ FIXME: SearchSpec is a shortstring -> ignores encoding }
SearchSpec := path;
NamePos := Length(path) - Length(searchFSSpec.name);
@ -378,6 +379,7 @@ begin
if ((Attr and not(searchAttr)) = 0) then
begin
name := searchFSSpec.name;
SetCodePage(name, DefaultFileSystemCodePage, false);
size := GetFileSizeFromPB(paramBlock);
time := MacTimeToDosPackedTime(paramBlock.ioFlMdDat);
end
@ -395,23 +397,23 @@ begin
UpperString(s, true);
Rslt.searchFSSpec.name := s;
DoFind(Rslt, true);
DoFind(Rslt, name, true);
end;
end;
end;
Function FindNext (Var Rslt : TSearchRec) : Longint;
Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : RawByteString) : Longint;
begin
if F.exactMatch then
Result := 18
else
Result:=DoFind (Rslt);
Result:=DoFind (Rslt, Name, false);
end;
Procedure FindClose (Var F : TSearchrec);
Procedure InternalFindClose (var Handle: THandle; var FindData: TFindData);
(*
Var
@ -420,7 +422,7 @@ Var
begin
(* TODO fix
GlobSearchRec:=PGlobSearchRec(F.FindHandle);
GlobSearchRec:=PGlobSearchRec(Handle);
GlobFree (GlobSearchRec^.GlobHandle);
Dispose(GlobSearchRec);
*)

27
rtl/morphos/sysutils.pp
View File

@ -333,9 +333,9 @@ end;
(****** end of non portable routines ******)
function FileAge (const FileName : String): Longint;
function FileAge (const FileName : RawByteString): Longint;
var
tmpName: String;
tmpName: RawByteString;
tmpLock: Longint;
tmpFIB : PFileInfoBlock;
tmpDateTime: TDateTime;
@ -343,7 +343,7 @@ var
begin
validFile:=false;
tmpName := PathConv(FileName);
tmpName := PathConv(ToSingleByteFileSystemEncodedFileName(FileName));
tmpLock := dosLock(tmpName, SHARED_LOCK);
if (tmpLock <> 0) then begin
@ -382,15 +382,15 @@ begin
end;
function FindFirst(const Path: String; Attr : Longint; out Rslt: TSearchRec): Longint;
Function InternalFindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name: RawByteString) : Longint;
var
tmpStr: array[0..255] of Char;
tmpStr: RawByteString;
Anchor: PAnchorPath;
tmpDateTime: TDateTime;
validDate: boolean;
begin
result:=-1; { We emulate Linux/Unix behaviour, and return -1 on errors. }
tmpStr:=PathConv(path)+#0;
tmpStr:=PathConv(ToSingleByteFileSystemEncodedFileName(Path));
{ $1e = faHidden or faSysFile or faVolumeID or faDirectory }
Rslt.ExcludeAttr := (not Attr) and ($1e);
@ -399,11 +399,12 @@ begin
new(Anchor);
FillChar(Anchor^,sizeof(TAnchorPath),#0);
if MatchFirst(@tmpStr,Anchor)<>0 then exit;
if MatchFirst(pchar(tmpStr),Anchor)<>0 then exit;
Rslt.FindHandle := longint(Anchor);
with Anchor^.ap_Info do begin
Rslt.Name := StrPas(fib_FileName);
Name := fib_FileName;
SetCodePage(Name,DefaultFileSystemCodePage,False);
Rslt.Size := fib_Size;
Rslt.Time := DateTimeToFileDate(AmigaFileDateToDateTime(fib_Date,validDate));
@ -421,7 +422,7 @@ begin
end;
function FindNext (var Rslt : TSearchRec): Longint;
Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : RawByteString) : Longint;
var
Anchor: PAnchorPath;
validDate: boolean;
@ -433,7 +434,8 @@ begin
if MatchNext(Anchor) <> 0 then exit;
with Anchor^.ap_Info do begin
Rslt.Name := StrPas(fib_FileName);
Name := fib_FileName;
SetCodePage(Name,DefaultFileSystemCodePage,False);
Rslt.Size := fib_Size;
Rslt.Time := DateTimeToFileDate(AmigaFileDateToDateTime(fib_Date,validDate));
if not validDate then exit;
@ -449,14 +451,15 @@ begin
end;
procedure FindClose(var f: TSearchRec);
Procedure InternalFindClose(var Handle: THandle);
var
Anchor: PAnchorPath;
begin
Anchor:=PAnchorPath(f.FindHandle);
Anchor:=PAnchorPath(Handle);
if not assigned(Anchor) then exit;
MatchEnd(Anchor);
Dispose(Anchor);
Handle:=THandle(nil);
end;

16
rtl/msdos/sysutils.pp
View File

@ -276,7 +276,7 @@ begin
end;
Function FileAge (Const FileName : String): Longint;
Function FileAge (Const FileName : RawByteString): Longint;
var Handle: longint;
begin
Handle := FileOpen(FileName, 0);
@ -346,7 +346,7 @@ begin
end;
Function FindFirst (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;
Function InternalFindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name: RawByteString) : Longint;
Var Sr : PSearchrec;
@ -362,12 +362,12 @@ begin
Rslt.Size := Sr^.Size;
Rslt.Attr := Sr^.Attr;
Rslt.ExcludeAttr := 0;
Rslt.Name := Sr^.Name;
Name := Sr^.Name;
end ;
end;
Function FindNext (Var Rslt : TSearchRec) : Longint;
Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : RawByteString) : Longint;
var
Sr: PSearchRec;
begin
@ -382,17 +382,17 @@ begin
Rslt.Size := Sr^.Size;
Rslt.Attr := Sr^.Attr;
Rslt.ExcludeAttr := 0;
Rslt.Name := Sr^.Name;
Name := Sr^.Name;
end;
end;
end;
Procedure FindClose (Var F : TSearchrec);
Procedure InternalFindClose(var Handle: THandle);
var
Sr: PSearchRec;
begin
Sr := PSearchRec(F.FindHandle);
Sr := PSearchRec(Handle);
if Sr <> nil then
begin
//!! Dispose(Sr);
@ -400,7 +400,7 @@ begin
DOS.FindClose(SR^);
freemem(sr,sizeof(searchrec));
end;
F.FindHandle := 0;
Handle := 0;
end;

298
rtl/nativent/sysutils.pp
View File

@ -30,7 +30,7 @@ uses
type
TNativeNTFindData = record
SearchSpec: String;
SearchSpec: UnicodeString;
NamePos: LongInt;
Handle: THandle;
IsDirObj: Boolean;
@ -311,7 +311,7 @@ begin
aNtTime.QuadPart := local.QuadPart + bias.QuadPart;
end;
function FileAge(const FileName: String): Longint;
function FileAge(const FileName: UnicodeString): Longint;
begin
{ TODO }
Result := -1;
@ -370,80 +370,193 @@ begin
FreeNtStr(ntstr);
end;
{ copied from rtl/unix/sysutils.pp }
Function FNMatch(const Pattern,Name:string):Boolean;
{ copied from rtl/unix/sysutils.pp and adapted to UTF-16 }
Function FNMatch(const Pattern,Name:UnicodeString):Boolean;
Var
LenPat,LenName : longint;
function NameUtf16CodePointLen(index: longint): longint;
begin
{ see https://en.wikipedia.org/wiki/UTF-16#Description for details }
Result:=1;
{ valid surrogate pair? }
if (Name[index]>=#$D800) and
(Name[index]<=#$DBFF) then
begin
if (index+1<=LenName) and
(Name[index+1]>=#$DC00) and
(Name[index+1]<=#$DFFF) then
inc(Result)
else
exit;
end;
{ combining diacritics?
1) U+0300 - U+036F
2) U+1DC0 - U+1DFF
3) U+20D0 - U+20FF
4) U+FE20 - U+FE2F
}
while (index+Result+1<=LenName) and
((word(ord(Name[index+Result+1])-$0300) <= word($036F-$0300)) or
(word(ord(Name[index+Result+1])-$1DC0) <= word($1DFF-$1DC0)) or
(word(ord(Name[index+Result+1])-$20D0) <= word($20FF-$20D0)) or
(word(ord(Name[index+Result+1])-$FE20) <= word($FE2F-$FE20))) do
begin
inc(Result)
end;
end;
procedure GoToLastByteOfUtf16CodePoint(var j: longint);
begin
{ Take one less, because we have to stop at the last word of the sequence.
}
inc(j,NameUtf16CodePointLen(j)-1);
end;
{ input:
i: current position in pattern (start of utf-16 code point)
j: current position in name (start of utf-16 code point)
update_i_j: should i and j be changed by the routine or not
output:
i: if update_i_j, then position of last matching part of code point in
pattern, or first non-matching code point in pattern. Otherwise the
same value as on input.
j: if update_i_j, then position of last matching part of code point in
name, or first non-matching code point in name. Otherwise the
same value as on input.
result: true if match, false if no match
}
function CompareUtf16CodePoint(var i,j: longint; update_i_j: boolean): Boolean;
var
words,
new_i,
new_j: longint;
begin
words:=NameUtf16CodePointLen(j);
new_i:=i;
new_j:=j;
{ ensure that a part of an UTF-8 codepoint isn't interpreted
as '*' or '?' }
repeat
dec(words);
Result:=
(new_j<=LenName) and
(new_i<=LenPat) and
(Pattern[new_i]=Name[new_j]);
inc(new_i);
inc(new_j);
until not(Result) or
(words=0);
if update_i_j then
begin
i:=new_i;
j:=new_j;
end;
end;
Function DoFNMatch(i,j:longint):Boolean;
Var
Found : boolean;
Begin
Found:=true;
While Found and (i<=LenPat) Do
Begin
Case Pattern[i] of
'?' : Found:=(j<=LenName);
'*' : Begin
{find the next character in pattern, different of ? and *}
while Found do
begin
inc(i);
if i>LenPat then Break;
case Pattern[i] of
'*' : ;
'?' : begin
if j>LenName then begin DoFNMatch:=false; Exit; end;
Found:=true;
While Found and (i<=LenPat) Do
Begin
Case Pattern[i] of
'?' :
begin
Found:=(j<=LenName);
GoToLastByteOfUtf16CodePoint(j);
end;
'*' : Begin
{find the next character in pattern, different of ? and *}
while Found do
begin
inc(i);
if i>LenPat then
Break;
case Pattern[i] of
'*' : ;
'?' : begin
if j>LenName then
begin
DoFNMatch:=false;
Exit;
end;
GoToLastByteOfUtf16CodePoint(j);
inc(j);
end;
else
Found:=false;
end;
end;
Assert((i>LenPat) or ( (Pattern[i]<>'*') and (Pattern[i]<>'?') ));
{ Now, find in name the character which i points to, if the * or
? wasn't the last character in the pattern, else, use up all
the chars in name }
Found:=false;
if (i<=LenPat) then
begin
repeat
{find a letter (not only first !) which maches pattern[i]}
while (j<=LenName) and
((name[j]<>pattern[i]) or
not CompareUtf16CodePoint(i,j,false)) do
begin
GoToLastByteOfUtf16CodePoint(j);
inc(j);
end;
if (j<LenName) then
begin
{ while positions i/j have already been checked, we have to
ensure that we don't split a code point }
if DoFnMatch(i,j) then
begin
i:=LenPat;
j:=LenName;{we can stop}
Found:=true;
Break;
end
{ We didn't find one, need to look further }
else
begin
GoToLastByteOfUtf16CodePoint(j);
inc(j);
end;
end
else if j=LenName then
begin
Found:=true;
Break;
end;
{ This 'until' condition must be j>LenName, not j>=LenName.
That's because when we 'need to look further' and
j = LenName then loop must not terminate. }
until (j>LenName);
end
else
Found:=false;
end;
end;
Assert((i>LenPat) or ( (Pattern[i]<>'*') and (Pattern[i]<>'?') ));
{Now, find in name the character which i points to, if the * or ?
wasn't the last character in the pattern, else, use up all the
chars in name}
Found:=false;
if (i<=LenPat) then
begin
repeat
{find a letter (not only first !) which maches pattern[i]}
while (j<=LenName) and (name[j]<>pattern[i]) do
inc (j);
if (j<LenName) then
begin
if DoFnMatch(i+1,j+1) then
begin
i:=LenPat;
j:=LenName;{we can stop}
Found:=true;
Break;
end else
inc(j);{We didn't find one, need to look further}
end else
if j=LenName then
begin
j:=LenName;{we can stop}
Found:=true;
Break;
end;
{ This 'until' condition must be j>LenName, not j>=LenName.
That's because when we 'need to look further' and
j = LenName then loop must not terminate. }
until (j>LenName);
end else
begin
j:=LenName;{we can stop}
Found:=true;
end;
end;
else {not a wildcard character in pattern}
Found:=(j<=LenName) and (pattern[i]=name[j]);
#$D800..#$DBFF:
begin
{ ensure that a part of an UTF-16 codepoint isn't matched with
'*' or '?' }
Found:=CompareUtf16CodePoint(i,j,true);
{ at this point, either Found is false (and we'll stop), or
both pattern[i] and name[j] are the end of the current code
point and equal }
end
else {not a wildcard character in pattern}
Found:=(j<=LenName) and (pattern[i]=name[j]);
end;
inc(i);
inc(j);
end;
inc(i);
inc(j);
end;
DoFnMatch:=Found and (j>LenName);
DoFnMatch:=Found and (j>LenName);
end;
Begin {start FNMatch}
@ -453,7 +566,7 @@ Begin {start FNMatch}
End;
function FindGetFileInfo(const s: String; var f: TSearchRec): Boolean;
function FindGetFileInfo(const s: UnicodeString; var f: TAbstractSearchRec; var Name: UnicodeString): Boolean;
var
ntstr: UNICODE_STRING;
objattr: OBJECT_ATTRIBUTES;
@ -461,14 +574,13 @@ var
h: THandle;
iostatus: IO_STATUS_BLOCK;
attr: LongInt;
filename: String;
filename: UnicodeString;
isfileobj: Boolean;
buf: array of Byte;
objinfo: OBJECT_BASIC_INFORMATION;
fileinfo: FILE_BASIC_INFORMATION;
time: LongInt;
begin
AnsiStrToNtStr(s, ntstr);
UnicodeStrToNtStr(s, ntstr);
InitializeObjectAttributes(objattr, @ntstr, 0, 0, Nil);
filename := ExtractFileName(s);
@ -551,7 +663,7 @@ begin
end;
if (attr and not f.FindData.SearchAttr) = 0 then begin
f.Name := filename;
Name := filename;
f.Attr := attr;
f.Size := 0;
{$ifndef FPUNONE}
@ -570,21 +682,24 @@ begin
end;
procedure FindClose(var F: TSearchrec);
Procedure InternalFindClose (var Handle: THandle; var FindData: TFindData);
begin
if f.FindData.Handle <> 0 then
NtClose(f.FindData.Handle);
if FindData.Handle <> 0 then
begin
NtClose(FindData.Handle);
FindData.Handle:=0;
end;
end;
function FindNext(var Rslt: TSearchRec): LongInt;
Function InternalFindNext (Var Rslt : TAbstractSearchRec; var Name: UnicodeString) : Longint;
{
re-opens dir if not already in array and calls FindGetFileInfo
}
Var
DirName : String;
DirName : UnicodeString;
FName,
SName : string;
SName : UnicodeString;
Found,
Finished : boolean;
ntstr: UNICODE_STRING;
@ -596,7 +711,7 @@ Var
dirinfo: POBJECT_DIRECTORY_INFORMATION;
filedirinfo: PFILE_DIRECTORY_INFORMATION;
pc: PChar;
name: AnsiString;
filename: UnicodeString;
iostatus: IO_STATUS_BLOCK;
begin
{ TODO : relative directories }
@ -612,13 +727,13 @@ begin
if Rslt.FindData.Handle = 0 then begin
if Rslt.FindData.NamePos > 1 then
name := Copy(Rslt.FindData.SearchSpec, 1, Rslt.FindData.NamePos - 1)
filename := Copy(Rslt.FindData.SearchSpec, 1, Rslt.FindData.NamePos - 1)
else
if Rslt.FindData.NamePos = 1 then
name := Copy(Rslt.FindData.SearchSpec, 1, 1)
filename := Copy(Rslt.FindData.SearchSpec, 1, 1)
else
name := Rslt.FindData.SearchSpec;
AnsiStrToNtStr(name, ntstr);
filename := Rslt.FindData.SearchSpec;
UnicodeStrToNtStr(filename, ntstr);
InitializeObjectAttributes(objattr, @ntstr, 0, 0, Nil);
res := NtOpenDirectoryObject(@Rslt.FindData.Handle,
@ -670,14 +785,7 @@ begin
Rslt.FindData.LastRes := res;
if dirinfo^.Name.Length > 0 then begin
SetLength(FName, dirinfo^.Name.Length div 2);
pc := PChar(FName);
for i := 0 to dirinfo^.Name.Length div 2 - 1 do begin
if dirinfo^.Name.Buffer[i] < #256 then
pc^ := AnsiChar(Byte(dirinfo^.Name.Buffer[i]))
else
pc^ := '?';
pc := pc + 1;
end;
move(dirinfo^.Name.Buffer[0],FName[1],dirinfo^.Name.Length div 2);
{$ifdef debug_findnext}
Write(FName, ' (');
for i := 0 to dirinfo^.TypeName.Length div 2 - 1 do
@ -691,21 +799,14 @@ begin
FName := '';
end else begin
SetLength(FName, filedirinfo^.FileNameLength div 2);
pc := PChar(FName);
for i := 0 to filedirinfo^.FileNameLength div 2 - 1 do begin
if filedirinfo^.FileName[i] < #256 then
pc^ := AnsiChar(Byte(filedirinfo^.FileName[i]))
else
pc^ := '?';
pc := pc + 1;
end;
move(filedirinfo^.FileName[0],FName[1],filedirinfo^.FileNameLength div 2);
end;
if FName = '' then
Finished := True
else begin
if FNMatch(SName, FName) then begin
Found := FindGetFileInfo(Copy(Rslt.FindData.SearchSpec, 1,
Rslt.FindData.NamePos) + FName, Rslt);
Rslt.FindData.NamePos) + FName, Rslt, Name);
if Found then begin
Result := 0;
Exit;
@ -716,19 +817,18 @@ begin
end;
function FindFirst(const Path: String; Attr: Longint; out Rslt: TSearchRec): Longint;
Function InternalFindFirst (Const Path : UnicodeString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name : UnicodeString) : Longint;
{
opens dir and calls FindNext if needed.
}
Begin
Result := -1;
FillChar(Rslt, SizeOf(Rslt), 0);
if Path = '' then
Exit;
Rslt.FindData.SearchAttr := Attr;
{Wildcards?}
if (Pos('?', Path) = 0) and (Pos('*', Path) = 0) then begin
if FindGetFileInfo(Path, Rslt) then
if FindGetFileInfo(Path, Rslt, Name) then
Result := 0;
end else begin
{Create Info}
@ -738,10 +838,10 @@ Begin
and (Rslt.FindData.SearchSpec[Rslt.FindData.NamePos] <> DirectorySeparator)
do
Dec(Rslt.FindData.NamePos);
Result := FindNext(Rslt);
Result := InternalFindNext(Rslt,Name);
end;
if Result <> 0 then
FindClose(Rslt);
InternalFindClose(Rslt.FindHandle,Rslt.FindData);
end;

12
rtl/nds/sysutils.pp
View File

@ -162,11 +162,13 @@ end;
(****** end of non portable routines ******)
Function FileAge (Const FileName : String): Longint;
Function FileAge (Const FileName : RawByteString): Longint;
var
info: Stat;
SystemFileName: RawByteString;
begin
if (_stat(pchar(FileName), Info) < 0) or S_ISDIR(info.st_mode) then
SystemFileName:=ToSingleByteFileSystemEncodedFileName(FileName);
if (_stat(pchar(SystemFileName), Info) < 0) or S_ISDIR(info.st_mode) then
exit(-1)
else
Result := (info.st_mtime);
@ -183,18 +185,18 @@ end;
Function FindFirst (Const Path : String; Attr : Longint; Out Rslt : TSearchRec) : Longint;
Function InternalFindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name: RawByteString) : Longint;
begin
result := -1;
end;
Function FindNext (Var Rslt : TSearchRec) : Longint;
Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : RawByteString) : Longint;
begin
result := -1;
end;
Procedure FindClose (Var F : TSearchrec);
Procedure InternalFindClose(var Handle: Pointer);
begin
end;

24
rtl/netware/sysutils.pp
View File

@ -223,7 +223,7 @@ end;
PROCEDURE find_setfields (VAR f : TsearchRec);
PROCEDURE find_setfields (VAR f : TsearchRec; VAR Name : RawByteString);
VAR T : Dos.DateTime;
BEGIN
WITH F DO
@ -235,21 +235,25 @@ BEGIN
UnpackTime(FindData.EntryP^.d_time + (LONGINT (FindData.EntryP^.d_date) SHL 16), T);
time := DateTimeToFileDate(EncodeDate(T.Year,T.Month,T.day)+EncodeTime(T.Hour,T.Min,T.Sec,0));
size := FindData.EntryP^.d_size;
name := strpas (FindData.EntryP^.d_nameDOS);
name := FindData.EntryP^.d_nameDOS;
SetCodePage(name, DefaultFileSystemCodePage, false);
END ELSE
BEGIN
FillChar (f,SIZEOF(f),0);
name := '';
END;
END;
END;
Function FindFirst (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;
Function InternalFindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name: RawByteString) : Longint;
var
SystemEncodedPath: RawByteString;
begin
IF path = '' then
exit (18);
Rslt.FindData.DirP := _opendir (pchar(Path));
SystemEncodedPath := ToSingleByteEncodedFileName (Path);
Rslt.FindData.DirP := _opendir (pchar(SystemEncodedPath));
IF Rslt.FindData.DirP = NIL THEN
exit (18);
IF attr <> faAnyFile THEN
@ -263,13 +267,13 @@ begin
result := 18;
end else
begin
find_setfields (Rslt);
find_setfields (Rslt,Name);
result := 0;
end;
end;
Function FindNext (Var Rslt : TSearchRec) : Longint;
Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : RawByteString) : Longint;
begin
IF Rslt.FindData.Magic <> $AD01 THEN
@ -277,14 +281,14 @@ begin
Rslt.FindData.EntryP := _readdir (Rslt.FindData.DirP);
IF Rslt.FindData.EntryP = NIL THEN
exit (18);
find_setfields (Rslt);
find_setfields (Rslt,Name);
result := 0;
end;
Procedure FindClose (Var F : TSearchrec);
Procedure InternalFindClose (var Handle: THandle; var FindData: TFindData);
begin
IF F.FindData.Magic = $AD01 THEN
IF FindData.Magic = $AD01 THEN
BEGIN
IF F.FindData.DirP <> NIL THEN
_closedir (F.FindData.DirP);

45
rtl/netwlibc/sysutils.pp
View File

@ -30,8 +30,8 @@ TYPE
DirP : Pdirent; { used for opendir }
EntryP: Pdirent; { and readdir }
Magic : longint; { to avoid abends with uninitialized TSearchRec }
_mask : string; { search mask i.e. *.* }
_dir : string; { directory where to search }
_mask : RawByteString; { search mask i.e. *.* }
_dir : RawByteString; { directory where to search }
_attr : longint; { specified attribute }
fname : string; { full pathname of found file }
END;
@ -199,11 +199,13 @@ begin
FileUnlock := -1;
end;
Function FileAge (Const FileName : String): Longint;
Function FileAge (Const FileName : RawByteString): Longint;
var Info : TStat;
TM : TTM;
SystemFileName: RawByteString;
begin
If Fpstat (pchar(FileName),Info) <> 0 then
SystemFileName:=ToSingleByteFileSystemEncodedFileName(FileName);
If Fpstat (pchar(SystemFileName),Info) <> 0 then
exit(-1)
else
begin
@ -233,10 +235,10 @@ end;
{returns true if attributes match}
function find_setfields (var f : TsearchRec; var AttrsOk : boolean) : longint;
function find_setfields (var f : TsearchRec; var AttrsOk : boolean; var Name : RawByteString) : longint;
var
StatBuf : TStat;
fname : string;
fname : RawByteString;
begin
result := 0;
with F do
@ -245,7 +247,8 @@ begin
begin
attr := (Pdirent(FindData.EntryP)^.d_mode shr 16) and $ffff;
size := Pdirent(FindData.EntryP)^.d_size;
name := strpas (Pdirent(FindData.EntryP)^.d_name);
name := Pdirent(FindData.EntryP)^.d_name;
SetCodePage(name, DefaultFileSystemCodePage, False);
fname := FindData._dir + name;
if Fpstat (pchar(fname),StatBuf) = 0 then
time := UnixToWinAge (StatBuf.st_mtim.tv_sec)
@ -261,14 +264,15 @@ begin
AttrsOk := true;
end else
begin
FillChar (f,sizeof(f),0);
name :='';
result := 18;
end;
end;
end;
function findfirst(const path : string;attr : longint; out Rslt : TsearchRec) : longint;
Function InternalFindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name: RawByteString) : Longint;
var
SystemEncodedPath: RawByteString;
path0 : string;
p : longint;
begin
@ -277,17 +281,18 @@ begin
result := 18;
exit;
end;
SystemEncodedPath := ToSingleByteEncodedFileName(Path);
Rslt.FindData._attr := attr;
p := length (path);
while (p > 0) and (not (path[p] in AllowDirectorySeparators)) do
p := length (SystemEncodedPath);
while (p > 0) and (not (SystemEncodedPath[p] in AllowDirectorySeparators)) do
dec (p);
if p > 0 then
begin
Rslt.FindData._mask := copy (path,p+1,255);
Rslt.FindData._dir := copy (path,1,p);
Rslt.FindData._mask := copy (SystemEncodedPath,p+1,high (longint));
Rslt.FindData._dir := copy (SystemEncodedPath,1,p);
end else
begin
Rslt.FindData._mask := path;
Rslt.FindData._mask := SystemEncodedPath;
Rslt.FindData._dir := GetCurrentDir;
if (Rslt.FindData._dir[length(Rslt.FindData._dir)] <> '/') and
(Rslt.FindData._dir[length(Rslt.FindData._dir)] <> '\') then
@ -306,7 +311,7 @@ begin
end;
function findnext(var Rslt : TsearchRec) : longint;
Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : RawByteString) : Longint;
var attrsOk : boolean;
begin
if Rslt.FindData.Magic <> $AD02 then
@ -320,7 +325,7 @@ begin
if Rslt.FindData.EntryP = nil then
result := 18
else
result := find_setfields (Rslt,attrsOk);
result := find_setfields (Rslt,attrsOk,Name);
if (result = 0) and (attrsOk) then
begin
if Rslt.FindData._mask = #0 then exit;
@ -331,12 +336,12 @@ begin
end;
Procedure FindClose(Var f: TSearchRec);
Procedure InternalFindClose (var Handle: THandle; var FindData: TFindData);
begin
if F.FindData.Magic <> $AD02 then exit;
if FindData.Magic <> $AD02 then exit;
doserror:=0;
closedir (Pdirent(f.FindData.DirP));
FillChar (f,sizeof(f),0);
closedir (Pdirent(FindData.DirP));
FillChar (FindData,sizeof(FindData),0);
end;

193
rtl/objpas/sysutils/filutil.inc
View File

@ -40,6 +40,12 @@ begin
end;
Function FileAge (Const FileName : UnicodeString): Longint;
begin
Result:=FileAge(ToSingleByteFileSystemEncodedFileName(FileName));
end;
Function FileExists (Const FileName : UnicodeString) : Boolean;
begin
Result:=FileExists(ToSingleByteFileSystemEncodedFileName(FileName));
@ -93,6 +99,32 @@ end;
{$endif}
function FileAge(const FileName: RawByteString; out FileDateTime: TDateTime; FollowLink: Boolean = True): Boolean;
Var
Info : TRawByteSearchRec;
A : Integer;
begin
for A:=1 to Length(FileName) do
if CharInSet(FileName[A],['?','*']) then
Exit(False);
A:=0;
if not FollowLink then
A:=A or faSymLink;
Result:=FindFirst(FileName,A,Info)=0;
if Result then
begin
FileDateTime:=FileDatetoDateTime(Info.Time);
FindClose(Info);
end;
end;
Function FileAge(const FileName: UnicodeString; out FileDateTime: TDateTime; FollowLink: Boolean = True): Boolean;
begin
Result:=FileAge(ToSingleByteFileSystemEncodedFileName(FileName),FileDateTime,FollowLink);
end;
Function FileSearch (Const Name, DirList : UnicodeString; Options : TFileSearchoptions = [sfoImplicitCurrentDir]) : UnicodeString;
begin
Result:=UnicodeString(FileSearch(ToSingleByteFileSystemEncodedFileName(Name),
@ -205,6 +237,12 @@ begin
end;
Function FileAge (Const FileName : RawByteString): Longint;
begin
Result:=FileAge(UnicodeString(FileName));
end;
Function FileExists (Const FileName : RawByteString) : Boolean;
begin
Result:=FileExists(UnicodeString(FileName));
@ -255,6 +293,33 @@ end;
{$endif}
function FileAge(const FileName: UnicodeString; out FileDateTime: TDateTime; FollowLink: Boolean = True): Boolean;
Var
Info : TUnicodeSearchRec;
A : Integer;
begin
for A:=1 to Length(FileName) do
if CharInSet(FileName[A],['?','*']) then
Exit(False);
A:=0;
if not FollowLink then
A:=A or faSymLink;
Result:=FindFirst(FileName,A,Info)=0;
if Result then
begin
FileDateTime:=FileDatetoDateTime(Info.Time);
FindClose(Info);
end;
end;
Function FileAge(const FileName: RawbyteString; out FileDateTime: TDateTime; FollowLink: Boolean = True): Boolean;
begin
Result:=FileAge(UnicodeString(FileName),FileDateTime,FollowLink);
end;
Function FileSearch (Const Name, DirList : UnicodeString; Options : TFileSearchoptions = [sfoImplicitCurrentDir]) : UnicodeString;
Var
I : longint;
@ -349,3 +414,131 @@ begin
Result:=textrec(f).handle;
end;
{ FindFirst/FindNext. In order to avoid having to duplicate most code in th
OS-specific implementations, we let those implementations fill in all
fields of TRawbyte/UnicodeSearchRec, except for the name. That field is
filled in by the OS-indepedent wrappers, which also takes care of setting
the appropriate code page if applicable.
}
type
TAbstractSearchRec = Record
Time : Longint;
Size : Int64;
Attr : Longint;
{ this will be assigned by the generic code; it is actually either a
rawbytestring or unicodestring}
Name_do_not_touch : pointer;
ExcludeAttr : Longint;
{$ifdef unix}
FindHandle : Pointer;
Mode : TMode;
{$else unix}
FindHandle : THandle;
{$endif unix}
{$ifdef USEFINDDATA}
FindData : TFindData;
{$endif}
end;
{$ifdef SYSUTILS_HAS_ANSISTR_FILEUTIL_IMPL}
Function InternalFindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name: RawByteString) : Longint; forward;
Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : RawByteString) : Longint; forward;
{$endif SYSUTILS_HAS_ANSISTR_FILEUTIL_IMPL}
{$ifdef SYSUTILS_HAS_UNICODESTR_FILEUTIL_IMPL}
Function InternalFindFirst (Const Path : UnicodeString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name: UnicodeString) : Longint; forward;
Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : UnicodeString) : Longint; forward;
{$endif SYSUTILS_HAS_UNICODESTR_FILEUTIL_IMPL}
procedure InternalFindClose(var Handle: {$ifdef unix}Pointer{$else}THandle{$endif}{$ifdef USEFINDDATA};var FindData: TFindData{$endif}); forward;
{$ifndef SYSUTILS_HAS_ANSISTR_FILEUTIL_IMPL}
Function FindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TRawByteSearchRec) : Longint;
var
Name: UnicodeString;
begin
Result:=InternalFindFirst(UnicodeString(Path),Attr,TAbstractSearchRec(Rslt),Name);
if Result=0 then
widestringmanager.Unicode2AnsiMoveProc(PUnicodeChar(Name),Rslt.Name,DefaultRTLFileSystemCodePage,length(Name));
end;
Function FindNext (Var Rslt : TRawByteSearchRec) : Longint;
var
Name: UnicodeString;
begin
Result:=InternalFindNext(TAbstractSearchRec(Rslt),Name);
if Result=0 then
widestringmanager.Unicode2AnsiMoveProc(PUnicodeChar(Name),Rslt.Name,DefaultRTLFileSystemCodePage,length(Name));
end;
{$else not SYSUTILS_HAS_ANSISTR_FILEUTIL_IMPL}
Function FindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TRawByteSearchRec) : Longint;
begin
Result:=InternalFindFirst(Path,Attr,TAbstractSearchRec(Rslt),Rslt.Name);
if Result=0 then
SetCodePage(Rslt.Name,DefaultRTLFileSystemCodePage);
end;
Function FindNext (Var Rslt : TRawByteSearchRec) : Longint;
begin
Result:=InternalFindNext(TAbstractSearchRec(Rslt),Rslt.Name);
if Result=0 then
SetCodePage(Rslt.Name,DefaultRTLFileSystemCodePage);
end;
{$endif not SYSUTILS_HAS_ANSISTR_FILEUTIL_IMPL}
{$ifndef SYSUTILS_HAS_UNICODESTR_FILEUTIL_IMPL}
Function FindFirst (Const Path : UnicodeString; Attr : Longint; out Rslt : TUnicodeSearchRec) : Longint;
var
Name: RawByteString;
begin
Result:=InternalFindFirst(ToSingleByteFileSystemEncodedFileName(Path),Attr,TAbstractSearchRec(Rslt),Name);
if Result=0 then
Rslt.Name:=UnicodeString(Name);
end;
Function FindNext (Var Rslt : TUnicodeSearchRec) : Longint;
var
Name: RawByteString;
begin
Result:=InternalFindNext(TAbstractSearchRec(Rslt),Name);
if Result=0 then
Rslt.Name:=UnicodeString(Name);
end;
{$else not SYSUTILS_HAS_UNICODESTR_FILEUTIL_IMPL}
Function FindFirst (Const Path : UnicodeString; Attr : Longint; out Rslt : TUnicodeSearchRec) : Longint;
begin
Result:=InternalFindFirst(Path,Attr,TAbstractSearchRec(Rslt),Rslt.Name);
end;
Function FindNext (Var Rslt : TUnicodeSearchRec) : Longint;
begin
Result:=InternalFindNext(TAbstractSearchRec(Rslt),Rslt.Name);
end;
{$endif not SYSUTILS_HAS_UNICODESTR_FILEUTIL_IMPL}
Procedure FindClose(Var f: TRawByteSearchRec);
begin
InternalFindClose(f.FindHandle{$ifdef USEFINDDATA},f.FindData{$endif});
end;
Procedure FindClose(Var f: TUnicodeSearchRec);
begin
InternalFindClose(f.FindHandle{$ifdef USEFINDDATA},f.FindData{$endif});
end;

90
rtl/objpas/sysutils/filutilh.inc
View File

@ -14,11 +14,36 @@
**********************************************************************}
Type
TSearchRec = Record
// Some operating systems need extra find data.
{$if defined(Win32) or defined(WinCE) or defined(Win64)}
{$define USEFINDDATA}
TFindData = TWin32FindDataW;
{$endif}
{$ifdef netware_clib}
TFindData = TNetwareFindData;
{$define USEFINDDATA}
{$endif}
{$ifdef netware_libc}
TFindData = TNetwareLibcFindData;
{$define USEFINDDATA}
{$endif}
{$ifdef MacOS}
TFindData = TMacOSFindData;
{$define USEFINDDATA}
{$endif}
{$ifdef nativent}
TFindData = TNativeNTFindData;
{$define USEFINDDATA}
{$endif}
// The actual unicode search record
TUnicodeSearchRec = Record
Time : Longint;
Size : Int64;
Attr : Longint;
Name : TFileName;
Name : UnicodeString;
ExcludeAttr : Longint;
{$ifdef unix}
FindHandle : Pointer;
@ -26,23 +51,34 @@ Type
{$else unix}
FindHandle : THandle;
{$endif unix}
{$if defined(Win32) or defined(WinCE) or defined(Win64)}
FindData : TWin32FindData;
{$endif}
{$ifdef netware_clib}
FindData : TNetwareFindData;
{$endif}
{$ifdef netware_libc}
FindData : TNetwareLibcFindData;
{$endif}
{$ifdef MacOS}
FindData : TMacOSFindData;
{$endif}
{$ifdef nativent}
FindData : TNativeNTFindData;
{$ifdef USEFINDDATA}
FindData : TFindData;
{$endif}
end;
TRawbyteSearchRec = Record
Time : Longint;
Size : Int64;
Attr : Longint;
Name : RawByteString;
ExcludeAttr : Longint;
{$ifdef unix}
FindHandle : Pointer;
Mode : TMode;
{$else unix}
FindHandle : THandle;
{$endif unix}
{$IFDEF USEFINDDATA}
FindData : TFindData;
{$ENDIF}
end;
{$IFDEF FPC_UNICODE_RTL}
TSearchRec = TUnicodeSearchRec;
{$ELSE}
TSearchRec = TRawbyteSearchRec;
{$ENDIF}
Const
{ File attributes }
faReadOnly = $00000001;
@ -81,6 +117,9 @@ Function FileOpen (Const FileName : unicodestring; Mode : Integer) : THandle;
Function FileCreate (Const FileName : UnicodeString) : THandle;
Function FileCreate (Const FileName : UnicodeString; Rights : Integer) : THandle;
Function FileCreate (Const FileName : UnicodeString; ShareMode : Integer; Rights : Integer) : THandle;
{$IFNDEF FPUNONE}
Function FileAge (Const FileName : UnicodeString): Longint;
{$ENDIF}
Function FileExists (Const FileName : UnicodeString) : Boolean;
Function DirectoryExists (Const Directory : UnicodeString) : Boolean;
Function FileSetDate (Const FileName : UnicodeString;Age : Longint) : Longint;
@ -88,10 +127,14 @@ Function FileGetAttr (Const FileName : UnicodeString) : Longint;
Function FileSetAttr (Const Filename : UnicodeString; Attr: longint) : Longint;
Function DeleteFile (Const FileName : UnicodeString) : Boolean;
Function RenameFile (Const OldName, NewName : UnicodeString) : Boolean;
Function FindFirst (Const Path : UnicodeString; Attr : Longint; out Rslt : TUnicodeSearchRec) : Longint;
Function FindNext (Var Rslt : TUnicodeSearchRec) : Longint;
Procedure FindClose (Var F : TUnicodeSearchrec);
Function FileSearch (Const Name, DirList : UnicodeString; Options : TFileSearchoptions = [sfoImplicitCurrentDir]) : UnicodeString;
Function FileSearch (Const Name, DirList : UnicodeString; ImplicitCurrentDir : Boolean) : UnicodeString;
Function ExeSearch (Const Name : UnicodeString; Const DirList : UnicodeString = '') : UnicodeString;
Function FileIsReadOnly(const FileName : UnicodeString): Boolean;
function FileAge(const FileName: UnicodeString; out FileDateTime: TDateTime; FollowLink: Boolean = True): Boolean;
Function FileOpen (Const FileName : RawByteString; Mode : Integer) : THandle;
Function FileCreate (Const FileName : RawByteString) : THandle;
@ -104,9 +147,15 @@ Function FileGetAttr (Const FileName : RawByteString) : Longint;
Function FileSetAttr (Const Filename : RawByteString; Attr: longint) : Longint;
Function DeleteFile (Const FileName : RawByteString) : Boolean;
Function RenameFile (Const OldName, NewName : RawByteString) : Boolean;
Function FindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TRawByteSearchRec) : Longint;
Function FileSearch (Const Name, DirList : RawByteString; Options : TFileSearchoptions = [sfoImplicitCurrentDir]) : RawByteString;
Function FileSearch (Const Name, DirList : RawByteString; ImplicitCurrentDir : Boolean) : RawByteString;
Function ExeSearch (Const Name : RawByteString; Const DirList : RawByteString = '') : RawByteString;
Function FileIsReadOnly(const FileName: RawByteString): Boolean;
function FileAge(const FileName: RawByteString; out FileDateTime: TDateTime; FollowLink: Boolean = True): Boolean;
{$ifndef FPUNONE}
Function FileAge (Const FileName : RawByteString): Longint;
{$endif}
Function FileRead (Handle : THandle; out Buffer; Count : longint) : Longint;
Function FileWrite (Handle : THandle; const Buffer; Count : Longint) : Longint;
@ -114,14 +163,9 @@ Function FileSeek (Handle : THandle; FOffset, Origin: Longint) : Longint;
Function FileSeek (Handle : THandle; FOffset: Int64; Origin: Longint) : Int64;
Procedure FileClose (Handle : THandle);
Function FileTruncate (Handle : THandle;Size: Int64) : boolean;
{$ifndef FPUNONE}
Function FileAge (Const FileName : String): Longint;
{$endif}
Function FindFirst (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;
Function FindNext (Var Rslt : TSearchRec) : Longint;
Procedure FindClose (Var F : TSearchrec);
Function FindNext (Var Rslt : TRawByteSearchRec) : Longint;
Procedure FindClose (Var F : TRawByteSearchrec);
Function FileGetDate (Handle : THandle) : Longint;
Function FileSetDate (Handle : THandle;Age : Longint) : Longint;
Function GetFileHandle(var f : File):THandle;
Function GetFileHandle(var f : Text):THandle;
function FileAge(const FileName: string; out FileDateTime: TDateTime; FollowLink: Boolean = True): Boolean;

12
rtl/objpas/sysutils/fina.inc
View File

@ -155,7 +155,11 @@ end;
function ExpandFileNameCase (const FileName: PathStr; out MatchFound: TFilenameCaseMatch): PathStr;
var
SR: TSearchRec;
{$ifdef SYSUTILSUNICODE}
SR: TUnicodeSearchRec;
{$else SYSUTILSUNICODE}
SR: TRawByteSearchRec;
{$endif SYSUTILSUNICODE}
ItemsFound: byte;
FoundPath: PathStr;
RestPos: SizeUInt;
@ -163,7 +167,11 @@ var
procedure TryCase (const Base, Rest: PathStr);
var
SR: TSearchRec;
{$ifdef SYSUTILSUNICODE}
SR: TUnicodeSearchRec;
{$else SYSUTILSUNICODE}
SR: TRawByteSearchRec;
{$endif SYSUTILSUNICODE}
RC: longint;
NextDirPos: SizeUInt;
NextPart: PathStr;

20
rtl/objpas/sysutils/sysutils.inc
View File

@ -19,10 +19,12 @@
{$macro on}
{$define PathStr:=UnicodeString}
{$define PathPChar:=PWideChar}
{$define SYSUTILSUNICODE}
{ Read filename handling functions implementation }
{$i fina.inc}
{ Read disk function implementations }
{$i disk.inc}
{$undef SYSUTILSUNICODE}
{$define PathStr:=AnsiString}
{$define PathPChar:=PAnsiChar}
{ Read filename handling functions implementation }
@ -156,24 +158,6 @@ end;
temp.free;
end;
function FileAge(const FileName: string; out FileDateTime: TDateTime; FollowLink: Boolean = True): Boolean;
Var
Info : TSearchRec;
A : Integer;
begin
for A:=1 to Length(FileName) do
If (FileName[A] in ['?','*']) then
Exit(False);
A:=0;
if Not FollowLink then
A:=A or faSymLink;
Result:=FindFirst(FileName,A,Info)=0;
If Result then
FileDateTime:=FileDatetoDateTime (Info.Time);
FindClose(Info);
end;
{ Interfaces support }
{$i sysuintf.inc}

34
rtl/os2/sysutils.pp
View File

@ -167,7 +167,7 @@ begin
FileSeek(Handle, 0, 2);
end;
function FileAge (const FileName: string): longint;
function FileAge (const FileName: RawByteString): longint;
var Handle: longint;
begin
Handle := FileOpen (FileName, 0);
@ -202,27 +202,29 @@ type TRec = record
end;
PSearchRec = ^TSearchRec;
function FindFirst (const Path: string; Attr: longint; out Rslt: TSearchRec): longint;
Function InternalFindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name: RawByteString) : Longint;
var SR: PSearchRec;
FStat: PFileFindBuf3L;
Count: cardinal;
Err: cardinal;
I: cardinal;
SystemEncodedPath: RawByteString;
begin
SystemEncodedPath := ToSingleByteFileSystemEncodedFileName(Path);
New (FStat);
Rslt.FindHandle := THandle ($FFFFFFFF);
Count := 1;
if FSApi64 then
Err := DosFindFirst (PChar (Path), Rslt.FindHandle,
Err := DosFindFirst (PChar (SystemEncodedPath), Rslt.FindHandle,
Attr and FindResvdMask, FStat, SizeOf (FStat^), Count, ilStandardL)
else
Err := DosFindFirst (PChar (Path), Rslt.FindHandle,
Err := DosFindFirst (PChar (SystemEncodedPath), Rslt.FindHandle,
Attr and FindResvdMask, FStat, SizeOf (FStat^), Count, ilStandard);
if (Err = 0) and (Count = 0) then
Err := 18;
FindFirst := -Err;
InternalFindFirst := -Err;
if Err = 0 then
begin
Rslt.ExcludeAttr := 0;
@ -231,24 +233,25 @@ begin
if FSApi64 then
begin
Rslt.Size := FStat^.FileSize;
Rslt.Name := FStat^.Name;
Name := FStat^.Name;
Rslt.Attr := FStat^.AttrFile;
end
else
begin
Rslt.Size := PFileFindBuf3 (FStat)^.FileSize;
Rslt.Name := PFileFindBuf3 (FStat)^.Name;
Name := PFileFindBuf3 (FStat)^.Name;
Rslt.Attr := PFileFindBuf3 (FStat)^.AttrFile;
end;
SetCodePage (Name, DefaultFileSystemCodePage, false);
end
else
FindClose(Rslt);
InternalFindClose(Rslt.FindHandle);
Dispose (FStat);
end;
function FindNext (var Rslt: TSearchRec): longint;
Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : RawByteString) : Longint;
var
SR: PSearchRec;
FStat: PFileFindBuf3L;
@ -260,7 +263,7 @@ begin
Err := DosFindNext (Rslt.FindHandle, FStat, SizeOf (FStat^), Count);
if (Err = 0) and (Count = 0) then
Err := 18;
FindNext := -Err;
InternalFindNext := -Err;
if Err = 0 then
begin
Rslt.ExcludeAttr := 0;
@ -269,26 +272,27 @@ begin
if FSApi64 then
begin
Rslt.Size := FStat^.FileSize;
Rslt.Name := FStat^.Name;
Name := FStat^.Name;
Rslt.Attr := FStat^.AttrFile;
end
else
begin
Rslt.Size := PFileFindBuf3 (FStat)^.FileSize;
Rslt.Name := PFileFindBuf3 (FStat)^.Name;
Name := PFileFindBuf3 (FStat)^.Name;
Rslt.Attr := PFileFindBuf3 (FStat)^.AttrFile;
end;
SetCodePage (Name, DefaultFileSystemCodePage, false);
end;
Dispose (FStat);
end;
procedure FindClose (var F: TSearchrec);
Procedure InternalFindClose(var Handle: THandle);
var
SR: PSearchRec;
begin
DosFindClose (F.FindHandle);
F.FindHandle := 0;
DosFindClose (Handle);
Handle := 0;
end;
function FileGetDate (Handle: THandle): longint;

420
rtl/unix/sysutils.pp
View File

@ -548,13 +548,13 @@ begin
end;
end;
Function FileAge (Const FileName : String): Longint;
Var Info : Stat;
Function FileAge (Const FileName : RawByteString): Longint;
Var
Info : Stat;
SystemFileName: RawByteString;
begin
If (fpstat (pointer(FileName),Info)<0) or fpS_ISDIR(info.st_mode) then
SystemFileName:=ToSingleByteFileSystemEncodedFileName(FileName);
If (fpstat(pchar(SystemFileName),Info)<0) or fpS_ISDIR(info.st_mode) then
exit(-1)
else
Result:=info.st_mtime;
@ -611,75 +611,253 @@ Function FNMatch(const Pattern,Name:string):Boolean;
Var
LenPat,LenName : longint;
{ assumes that pattern and name have the same code page }
function NameUtf8CodePointLen(index: longint): longint;
var
bytes: longint;
firstzerobit: byte;
begin
{ see https://en.wikipedia.org/wiki/UTF-8#Description for details }
Result:=1;
{ multiple byte UTF-8 code point? }
if Name[index]>#127 then
begin
{ bsr searches for the leftmost 1 bit. We are interested in the
leftmost 0 bit, so first invert the value
}
firstzerobit:=BsrByte(not(byte(Name[index])));
{ if there is no zero bit or the first zero bit is the rightmost bit
(bit 0), this is an invalid UTF-8 byte ($ff cannot appear in an
UTF-8-encoded string, and in the worst case bit 1 has to be zero)
}
if (firstzerobit=0) or (firstzerobit=255) then
exit;
{ the number of bytes belonging to this code point is
7-(pos first 0-bit). Subtract 1 since we're already at the first
byte. All subsequent bytes of the same sequence must have their
highest bit set and the next one unset. We stop when we detect an
invalid sequence.
}
bytes:=6-firstzerobit;
while (index+Result<=LenName) and
(bytes>0) and
((ord(Name[index+Result]) and %10000000) = %10000000) do
begin
inc(Result);
dec(bytes);
end;
{ stopped because of invalid sequence -> exit }
if bytes<>0 then
exit;
end;
{ combining diacritics?
1) U+0300 - U+036F in UTF-8 = %11001100 10000000 - %11001101 10101111
2) U+1DC0 - U+1DFF in UTF-8 = %11100001 10110111 10000000 - %11100001 10110111 10111111
3) U+20D0 - U+20FF in UTF-8 = %11100010 10000011 10010000 - %11100010 10000011 10111111
4) U+FE20 - U+FE2F in UTF-8 = %11101111 10111000 10100000 - %11101111 10111000 10101111
}
repeat
bytes:=Result;
if (index+Result+1<=LenName) then
begin
{ case 1) }
if ((ord(Name[index+Result]) and %11001100 = %11001100)) and
(ord(Name[index+Result+1]) >= %10000000) and
(ord(Name[index+Result+1]) <= %10101111) then
inc(Result,2)
{ case 2), 3), 4) }
else if (index+Result+2<=LenName) and
(ord(Name[index+Result])>=%11100001) then
begin
{ case 2) }
if ((ord(Name[index+Result])=%11100001) and
(ord(Name[index+Result+1])=%10110111) and
(ord(Name[index+Result+2])>=%10000000)) or
{ case 3) }
((ord(Name[index+Result])=%11100010) and
(ord(Name[index+Result+1])=%10000011) and
(ord(Name[index+Result+2])>=%10010000)) or
{ case 4) }
((ord(Name[index+Result])=%11101111) and
(ord(Name[index+Result+1])=%10111000) and
(ord(Name[index+Result+2])>=%10100000) and
(ord(Name[index+Result+2])<=%10101111)) then
inc(Result,3);
end;
end;
until bytes=Result;
end;
procedure GoToLastByteOfUtf8CodePoint(var j: longint);
begin
{ Take one less, because we have to stop at the last byte of the sequence.
}
inc(j,NameUtf8CodePointLen(j)-1);
end;
{ input:
i: current position in pattern (start of utf-8 code point)
j: current position in name (start of utf-8 code point)
update_i_j: should i and j be changed by the routine or not
output:
i: if update_i_j, then position of last matching part of code point in
pattern, or first non-matching code point in pattern. Otherwise the
same value as on input.
j: if update_i_j, then position of last matching part of code point in
name, or first non-matching code point in name. Otherwise the
same value as on input.
result: true if match, false if no match
}
function CompareUtf8CodePoint(var i,j: longint; update_i_j: boolean): Boolean;
var
bytes,
new_i,
new_j: longint;
begin
bytes:=NameUtf8CodePointLen(j);
new_i:=i;
new_j:=j;
{ ensure that a part of an UTF-8 codepoint isn't interpreted
as '*' or '?' }
repeat
dec(bytes);
Result:=
(new_j<=LenName) and
(new_i<=LenPat) and
(Pattern[new_i]=Name[new_j]);
inc(new_i);
inc(new_j);
until not(Result) or
(bytes=0);
if update_i_j then
begin
i:=new_i;
j:=new_j;
end;
end;
Function DoFNMatch(i,j:longint):Boolean;
Var
Found : boolean;
UTF8, Found : boolean;
Begin
Found:=true;
While Found and (i<=LenPat) Do
Begin
Case Pattern[i] of
'?' : Found:=(j<=LenName);
'*' : Begin
{find the next character in pattern, different of ? and *}
while Found do
begin
inc(i);
if i>LenPat then Break;
case Pattern[i] of
'*' : ;
'?' : begin
if j>LenName then begin DoFNMatch:=false; Exit; end;
inc(j);
end;
else
Found:=false;
end;
end;
Assert((i>LenPat) or ( (Pattern[i]<>'*') and (Pattern[i]<>'?') ));
{Now, find in name the character which i points to, if the * or ?
wasn't the last character in the pattern, else, use up all the
chars in name}
Found:=false;
if (i<=LenPat) then
begin
repeat
{find a letter (not only first !) which maches pattern[i]}
while (j<=LenName) and (name[j]<>pattern[i]) do
inc (j);
if (j<LenName) then
Found:=true;
{ ensure that we don't skip partial characters in UTF-8-encoded strings }
UTF8:=StringCodePage(Name)=CP_UTF8;
While Found and (i<=LenPat) Do
Begin
Case Pattern[i] of
'?' :
begin
Found:=(j<=LenName);
if UTF8 then
GoToLastByteOfUtf8CodePoint(j);
end;
'*' : Begin
{find the next character in pattern, different of ? and *}
while Found do
begin
if DoFnMatch(i+1,j+1) then
begin
i:=LenPat;
j:=LenName;{we can stop}
Found:=true;
inc(i);
if i>LenPat then
Break;
end else
inc(j);{We didn't find one, need to look further}
end else
if j=LenName then
case Pattern[i] of
'*' : ;
'?' : begin
if j>LenName then
begin
DoFNMatch:=false;
Exit;
end;
if UTF8 then
GoToLastByteOfUtf8CodePoint(j);
inc(j);
end;
else
Found:=false;
end;
end;
Assert((i>LenPat) or ( (Pattern[i]<>'*') and (Pattern[i]<>'?') ));
{ Now, find in name the character which i points to, if the * or
? wasn't the last character in the pattern, else, use up all
the chars in name }
Found:=false;
if (i<=LenPat) then
begin
repeat
{find a letter (not only first !) which maches pattern[i]}
if UTF8 then
begin
while (j<=LenName) and
((name[j]<>pattern[i]) or
not CompareUtf8CodePoint(i,j,false)) do
begin
GoToLastByteOfUtf8CodePoint(j);
inc(j);
end;
end
else
begin
while (j<=LenName) and (name[j]<>pattern[i]) do
inc (j);
end;
if (j<LenName) then
begin
{ while positions i/j have already been checked, in
case of UTF-8 we have to ensure that we don't split
a code point. Otherwise we can skip over comparing
the same characters twice }
if DoFnMatch(i+ord(not UTF8),j+ord(not UTF8)) then
begin
i:=LenPat;
j:=LenName;{we can stop}
Found:=true;
Break;
end
{ We didn't find one, need to look further }
else
begin
if UTF8 then
GoToLastByteOfUtf8CodePoint(j);
inc(j);
end;
end
else if j=LenName then
begin
Found:=true;
Break;
end;
{ This 'until' condition must be j>LenName, not j>=LenName.
That's because when we 'need to look further' and
j = LenName then loop must not terminate. }
until (j>LenName);
end
else
begin
j:=LenName;{we can stop}
Found:=true;
Break;
end;
{ This 'until' condition must be j>LenName, not j>=LenName.
That's because when we 'need to look further' and
j = LenName then loop must not terminate. }
until (j>LenName);
end else
begin
j:=LenName;{we can stop}
Found:=true;
end;
end;
else {not a wildcard character in pattern}
Found:=(j<=LenName) and (pattern[i]=name[j]);
#128..#255:
begin
Found:=(j<=LenName) and (pattern[i]=name[j]);
if Found and UTF8 then
begin
{ ensure that a part of an UTF-8 codepoint isn't matched with
'*' or '?' }
Found:=CompareUtf8CodePoint(i,j,true);
{ at this point, either Found is false (and we'll stop), or
both pattern[i] and name[j] are the end of the current code
point and equal }
end
end
else {not a wildcard character in pattern}
Found:=(j<=LenName) and (pattern[i]=name[j]);
end;
inc(i);
inc(j);
end;
inc(i);
inc(j);
end;
DoFnMatch:=Found and (j>LenName);
DoFnMatch:=Found and (j>LenName);
end;
Begin {start FNMatch}
@ -693,78 +871,73 @@ Type
TUnixFindData = Record
NamePos : LongInt; {to track which search this is}
DirPtr : Pointer; {directory pointer for reading directory}
SearchSpec : String;
SearchSpec : RawbyteString;
SearchType : Byte; {0=normal, 1=open will close, 2=only 1 file}
SearchAttr : Byte; {attribute we are searching for}
End;
PUnixFindData = ^TUnixFindData;
Procedure FindClose(Var f: TSearchRec);
Procedure InternalFindClose(var Handle: Pointer);
var
UnixFindData : PUnixFindData;
Begin
UnixFindData:=PUnixFindData(f.FindHandle);
If (UnixFindData=Nil) then
Exit;
if UnixFindData^.SearchType=0 then
begin
if UnixFindData^.dirptr<>nil then
fpclosedir(pdir(UnixFindData^.dirptr)^);
end;
Dispose(UnixFindData);
f.FindHandle:=nil;
End;
Function FindGetFileInfo(const s:string;var f:TSearchRec):boolean;
var
st : baseunix.stat;
WinAttr : longint;
D: PUnixFindData absolute Handle;
begin
FindGetFileInfo:=false;
If Assigned(F.FindHandle) and ((((PUnixFindData(f.FindHandle)^.searchattr)) and faSymlink) > 0) then
FindGetFileInfo:=(fplstat(pointer(s),st)=0)
else
FindGetFileInfo:=(fpstat(pointer(s),st)=0);
If not FindGetFileInfo then
exit;
WinAttr:=LinuxToWinAttr(s,st);
If ((WinAttr and Not(PUnixFindData(f.FindHandle)^.searchattr))=0) Then
Begin
f.Name:=ExtractFileName(s);
f.Attr:=WinAttr;
f.Size:=st.st_Size;
f.Mode:=st.st_mode;
f.Time:=st.st_mtime;
FindGetFileInfo:=true;
End
else
FindGetFileInfo:=false;
If D=Nil then
Exit;
if D^.SearchType=0 then
begin
if D^.dirptr<>nil then
fpclosedir(pdir(D^.dirptr)^);
end;
Dispose(D);
D:=nil;
end;
Function FindNext (Var Rslt : TSearchRec) : Longint;
{
re-opens dir if not already in array and calls FindGetFileInfo
}
Function FindGetFileInfo(const s: RawByteString; var f: TAbstractSearchRec; var Name: RawByteString):boolean;
Var
DirName : String;
st : baseunix.stat;
WinAttr : longint;
begin
if Assigned(f.FindHandle) and ( (PUnixFindData(F.FindHandle)^.searchattr and faSymlink) > 0) then
FindGetFileInfo:=(fplstat(pointer(s),st)=0)
else
FindGetFileInfo:=(fpstat(pointer(s),st)=0);
if not FindGetFileInfo then
exit;
WinAttr:=LinuxToWinAttr(s,st);
FindGetFileInfo:=(WinAttr and Not(PUnixFindData(f.FindHandle)^.searchattr))=0;
if FindGetFileInfo then
begin
Name:=ExtractFileName(s);
f.Attr:=WinAttr;
f.Size:=st.st_Size;
f.Mode:=st.st_mode;
f.Time:=st.st_mtime;
FindGetFileInfo:=true;
end;
end;
// Returns the FOUND filename. Error code <> 0 if no file found
Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : RawByteString) : Longint;
Var
DirName : RawByteString;
FName,
SName : string;
SName : RawBytestring;
Found,
Finished : boolean;
p : pdirent;
UnixFindData : PUnixFindData;
Begin
Result:=-1;
UnixFindData:=PUnixFindData(Rslt.FindHandle);
{ SearchSpec='' means that there were no wild cards, so only one file to
find.
}
If (UnixFindData=Nil) then
exit;
if UnixFindData^.SearchSpec='' then
If (UnixFindData=Nil) or (UnixFindData^.SearchSpec='') then
exit;
if (UnixFindData^.SearchType=0) and
(UnixFindData^.Dirptr=nil) then
@ -773,7 +946,7 @@ Begin
DirName:='./'
Else
DirName:=Copy(UnixFindData^.SearchSpec,1,UnixFindData^.NamePos);
UnixFindData^.DirPtr := fpopendir(Pchar(pointer(DirName)));
UnixFindData^.DirPtr := fpopendir(Pchar(DirName));
end;
SName:=Copy(UnixFindData^.SearchSpec,UnixFindData^.NamePos+1,Length(UnixFindData^.SearchSpec));
Found:=False;
@ -789,9 +962,10 @@ Begin
Finished:=True
Else
Begin
SetCodePage(FName,DefaultFileSystemCodePage,false);
If FNMatch(SName,FName) Then
Begin
Found:=FindGetFileInfo(Copy(UnixFindData^.SearchSpec,1,UnixFindData^.NamePos)+FName,Rslt);
Found:=FindGetFileInfo(Copy(UnixFindData^.SearchSpec,1,UnixFindData^.NamePos)+FName,Rslt,Name);
if Found then
begin
Result:=0;
@ -803,7 +977,7 @@ Begin
End;
Function FindFirst (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;
Function InternalFindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name: RawByteString) : Longint;
{
opens dir and calls FindNext if needed.
}
@ -811,6 +985,8 @@ var
UnixFindData : PUnixFindData;
Begin
Result:=-1;
{ this is safe even though Rslt actually contains a refcounted field, because
it is declared as "out" and hence has already been initialised }
fillchar(Rslt,sizeof(Rslt),0);
if Path='' then
exit;
@ -823,20 +999,20 @@ Begin
{Wildcards?}
if (Pos('?',Path)=0) and (Pos('*',Path)=0) then
begin
if FindGetFileInfo(Path,Rslt) then
if FindGetFileInfo(ToSingleByteFileSystemEncodedFileName(Path),Rslt,Name) then
Result:=0;
end
else
begin
{Create Info}
UnixFindData^.SearchSpec := Path;
UnixFindData^.SearchSpec := ToSingleByteFileSystemEncodedFileName(Path);
UnixFindData^.NamePos := Length(UnixFindData^.SearchSpec);
while (UnixFindData^.NamePos>0) and (UnixFindData^.SearchSpec[UnixFindData^.NamePos]<>'/') do
dec(UnixFindData^.NamePos);
Result:=FindNext(Rslt);
Result:=InternalFindNext(Rslt,Name);
end;
If (Result<>0) then
FindClose(Rslt);
InternalFindClose(Rslt.FindHandle);
End;

19
rtl/watcom/sysutils.pp
View File

@ -277,7 +277,7 @@ begin
end;
Function FileAge (Const FileName : String): Longint;
Function FileAge (Const FileName : RawByteString): Longint;
var Handle: longint;
begin
Handle := FileOpen(FileName, 0);
@ -335,7 +335,7 @@ begin
end;
Function FindFirst (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;
Function InternalFindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name: RawByteString) : Longint;
Var Sr : PSearchrec;
@ -343,6 +343,7 @@ begin
//!! Sr := New(PSearchRec);
getmem(sr,sizeof(searchrec));
Rslt.FindHandle := longint(Sr);
{ FIXME: Dos version has shortstring interface -> discards encoding }
DOS.FindFirst(Path, Attr, Sr^);
result := -DosError;
if result = 0 then
@ -351,12 +352,13 @@ begin
Rslt.Size := Sr^.Size;
Rslt.Attr := Sr^.Attr;
Rslt.ExcludeAttr := 0;
Rslt.Name := Sr^.Name;
Name := Sr^.Name;
SetCodePage(Name,DefaultFileSystemCodePage,False);
end ;
end;
Function FindNext (Var Rslt : TSearchRec) : Longint;
Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : RawByteString) : Longint;
var
Sr: PSearchRec;
begin
@ -371,17 +373,18 @@ begin
Rslt.Size := Sr^.Size;
Rslt.Attr := Sr^.Attr;
Rslt.ExcludeAttr := 0;
Rslt.Name := Sr^.Name;
Name := Sr^.Name;
SetCodePage(Name,DefaultFileSystemCodePage,False);
end;
end;
end;
Procedure FindClose (Var F : TSearchrec);
Procedure InternalFindClose(var Handle: Pointer);
var
Sr: PSearchRec;
begin
Sr := PSearchRec(F.FindHandle);
Sr := PSearchRec(Handle);
if Sr <> nil then
begin
//!! Dispose(Sr);
@ -389,7 +392,7 @@ begin
DOS.FindClose(SR^);
freemem(sr,sizeof(searchrec));
end;
F.FindHandle := 0;
Handle := 0;
end;

8
rtl/wii/sysutils.pp
View File

@ -133,7 +133,7 @@ end;
(****** end of non portable routines ******)
Function FileAge (Const FileName : String): Longint;
Function FileAge (Const FileName : RawByteString): Longint;
begin
result := -1;
end;
@ -146,18 +146,18 @@ end;
Function FindFirst (Const Path : String; Attr : Longint; Out Rslt : TSearchRec) : Longint;
Function InternalFindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name: RawByteString) : Longint;
begin
result := -1;
end;
Function FindNext (Var Rslt : TSearchRec) : Longint;
Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : RawByteString) : Longint;
begin
result := -1;
end;
Procedure FindClose (Var F : TSearchrec);
Procedure InternalFindClose(var Handle: THandle);
begin
end;

38
rtl/win/sysutils.pp
View File

@ -132,12 +132,12 @@ function GetFileVersion(const AFileName:string):Cardinal;
result:=$fffffff;
fn:=AFileName;
UniqueString(fn);
size:=GetFileVersionInfoSize(pchar(fn),@h);
size:=GetFileVersionInfoSizeA(pchar(fn),@h);
if size>sizeof(buf) then
begin
getmem(bufp,size);
try
if GetFileVersionInfo(pchar(fn),h,size,bufp) then
if GetFileVersionInfoA(pchar(fn),h,size,bufp) then
if VerQueryValue(bufp,'\',valrec,valsize) then
result:=valrec^.dwFileVersionMS;
finally
@ -347,12 +347,12 @@ begin
end;
Function FileAge (Const FileName : String): Longint;
Function FileAge (Const FileName : UnicodeString): Longint;
var
Handle: THandle;
FindData: TWin32FindData;
FindData: TWin32FindDataW;
begin
Handle := FindFirstFile(Pchar(FileName), FindData);
Handle := FindFirstFileW(Pwidechar(FileName), FindData);
if Handle <> INVALID_HANDLE_VALUE then
begin
Windows.FindClose(Handle);
@ -388,13 +388,12 @@ begin
Result:=False;
end;
Function FindMatch(var f: TSearchRec) : Longint;
Function FindMatch(var f: TAbstractSearchRec; var Name: UnicodeString) : Longint;
begin
{ Find file with correct attribute }
While (F.FindData.dwFileAttributes and cardinal(F.ExcludeAttr))<>0 do
begin
if not FindNextFile (F.FindHandle,F.FindData) then
if not FindNextFileW (F.FindHandle,F.FindData) then
begin
Result:=GetLastError;
exit;
@ -404,42 +403,41 @@ begin
WinToDosTime(F.FindData.ftLastWriteTime,F.Time);
f.size:=F.FindData.NFileSizeLow+(qword(maxdword)+1)*F.FindData.NFileSizeHigh;
f.attr:=F.FindData.dwFileAttributes;
f.Name:=StrPas(@F.FindData.cFileName[0]);
Name:=F.FindData.cFileName;
Result:=0;
end;
Function FindFirst (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;
Function InternalFindFirst (Const Path : UnicodeString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name : UnicodeString) : Longint;
begin
Rslt.Name:=Path;
Name:=Path;
Rslt.Attr:=attr;
Rslt.ExcludeAttr:=(not Attr) and ($1e);
{ $1e = faHidden or faSysFile or faVolumeID or faDirectory }
{ FindFirstFile is a Win32 Call }
Rslt.FindHandle:=FindFirstFile (PChar(Path),Rslt.FindData);
Rslt.FindHandle:=FindFirstFileW (PWideChar(Path),Rslt.FindData);
If Rslt.FindHandle=Invalid_Handle_value then
begin
Result:=GetLastError;
exit;
end;
{ Find file with correct attribute }
Result:=FindMatch(Rslt);
Result:=FindMatch(Rslt,Name);
end;
Function FindNext (Var Rslt : TSearchRec) : Longint;
Function InternalFindNext (Var Rslt : TAbstractSearchRec; var Name: UnicodeString) : Longint;
begin
if FindNextFile(Rslt.FindHandle, Rslt.FindData) then
Result := FindMatch(Rslt)
if FindNextFileW(Rslt.FindHandle, Rslt.FindData) then
Result := FindMatch(Rslt, Name)
else
Result := GetLastError;
end;
Procedure FindClose (Var F : TSearchrec);
Procedure InternalFindClose (var Handle: THandle; var FindData: TFindData);
begin
if F.FindHandle <> INVALID_HANDLE_VALUE then
Windows.FindClose(F.FindHandle);
if Handle <> INVALID_HANDLE_VALUE then
Windows.FindClose(Handle);
end;

30
rtl/wince/sysutils.pp
View File

@ -248,15 +248,12 @@ begin
end;
Function FileAge (Const FileName : String): Longint;
Function FileAge (Const FileName : UnicodeString): Longint;
var
Handle: THandle;
FindData: TWin32FindData;
fn: PWideChar;
begin
fn:=StringToPWideChar(FileName);
Handle := FindFirstFile(fn, FindData);
FreeMem(fn);
Handle := FindFirstFile(PWideChar(FileName), FindData);
if Handle <> INVALID_HANDLE_VALUE then
begin
Windows.FindClose(Handle);
@ -292,7 +289,7 @@ begin
end;
Function FindMatch(var f: TSearchRec) : Longint;
Function FindMatch(var f: TAbstractSearchRec; var Name: UnicodeString) : Longint;
begin
{ Find file with correct attribute }
While (F.FindData.dwFileAttributes and cardinal(F.ExcludeAttr))<>0 do
@ -307,46 +304,45 @@ begin
WinToDosTime(F.FindData.ftLastWriteTime,F.Time);
f.size:=F.FindData.NFileSizeLow;
f.attr:=F.FindData.dwFileAttributes;
PWideCharToString(@F.FindData.cFileName[0], f.Name);
Name:=F.FindData.cFileName;
Result:=0;
end;
Function FindFirst (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;
Function InternalFindFirst (Const Path : UnicodeString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name : UnicodeString) : Longint;
var
fn: PWideChar;
begin
fn:=StringToPWideChar(Path);
Rslt.Name:=Path;
fn:=PWideChar(Path);
Name:=Path;
Rslt.Attr:=attr;
Rslt.ExcludeAttr:=(not Attr) and ($1e);
{ $1e = faHidden or faSysFile or faVolumeID or faDirectory }
{ FindFirstFile is a WinCE Call }
Rslt.FindHandle:=FindFirstFile (fn, Rslt.FindData);
FreeMem(fn);
If Rslt.FindHandle=Invalid_Handle_value then
begin
Result:=GetLastError;
exit;
end;
{ Find file with correct attribute }
Result:=FindMatch(Rslt);
Result:=FindMatch(Rslt, Name);
end;
Function FindNext (Var Rslt : TSearchRec) : Longint;
Function InternalFindNext (Var Rslt : TAbstractSearchRec; var Name: UnicodeString) : Longint;
begin
if FindNextFile(Rslt.FindHandle, Rslt.FindData) then
Result := FindMatch(Rslt)
Result := FindMatch(Rslt, Name)
else
Result := GetLastError;
end;
Procedure FindClose (Var F : TSearchrec);
Procedure InternalFindClose (var Handle: THandle; var FindData: TFindData);
begin
if F.FindHandle <> INVALID_HANDLE_VALUE then
Windows.FindClose(F.FindHandle);
if Handle <> INVALID_HANDLE_VALUE then
Windows.FindClose(Handle);
end;

236
tests/test/units/sysutils/tffirst.pp Normal file
View File

@ -0,0 +1,236 @@
{ %target=linux,freebsd,openbsd,netbsd,win32,win64,darwin,haiku,morphos }
{$codepage utf8}
uses
{$ifdef unix}
cwstring,
{$endif}
SysUtils;
procedure tffirstutf8;
const
FNAME = utf8string('adéfg');
var
f: thandle;
res: longint;
fnamecmp,
fsearch,
curdir: utf8string;
rsr: TRawByteSearchRec;
begin
if not CreateDir('tffdir') then
halt(100);
curdir:=utf8string(GetCurrentDir);
if not SetCurrentDir('tffdir') then
halt(101);
f:=FileCreate(FNAME);
if f<=0 then
halt(102);
FileClose(f);
{ determine how the file system reports the name of the file (with the é
precomposed or decomposed) so we can pass the correct form to findfirst. We cannot
deal with this automatically in findfirst itself, because some OSes/file systems
allow both forms to coexist. }
if (findfirst('ad*fg',faAnyFile and not(faDirectory),rsr)<>0) then
halt(1)
else
begin
fnamecmp:=rsr.name;
findclose(rsr);
end;
fsearch:=fnamecmp;
fsearch[1]:='?';
res:=findfirst(fsearch,faAnyFile and not(faDirectory),rsr);
if (res<>0) or
(rsr.name<>fnamecmp) then
begin
writeln('res: ',res);
if res=0 then
writeln('fn: ',rsr.name);
halt(2)
end
else
findclose(rsr);
fsearch:=fnamecmp;
fsearch[2]:='?';
if (findfirst(fsearch,faAnyFile and not(faDirectory),rsr)<>0) or
(rsr.name<>fnamecmp) then
halt(3)
else
findclose(rsr);
{ must succeed regardless of whether the é is decomposed or not }
if (findfirst('ad?fg',faAnyFile and not(faDirectory),rsr)<>0) or
(rsr.name<>fnamecmp) then
halt(4)
else
findclose(rsr);
{ this should succeed if if the the é is decomposed (at least "ls ade?fg" succeeds
on Mac OS X) }
if (fnamecmp[3]='e') then
if (findfirst('ade?fg',faAnyFile and not(faDirectory),rsr)<>0) then
halt(5)
else
findclose(rsr);
fsearch:=fnamecmp;
fsearch[length(fsearch)-1]:='?';
if (findfirst(fsearch,faAnyFile and not(faDirectory),rsr)<>0) or
(rsr.name<>fnamecmp) then
halt(6)
else
findclose(rsr);
fsearch:=fnamecmp;
fsearch[length(fsearch)]:='?';
if (findfirst(fsearch,faAnyFile and not(faDirectory),rsr)<>0) or
(rsr.name<>fnamecmp) then
halt(7)
else
findclose(rsr);
if (findfirst('a*fg',faAnyFile and not(faDirectory),rsr)<>0) or
(rsr.name<>fnamecmp) then
halt(8)
else
findclose(rsr);
if (findfirst('ad*',faAnyFile and not(faDirectory),rsr)<>0) or
(rsr.name<>fnamecmp) then
halt(9)
else
findclose(rsr);
fsearch:=fnamecmp;
fsearch[length(fsearch)-1]:='*';
if (findfirst(fsearch,faAnyFile and not(faDirectory),rsr)<>0) or
(rsr.name<>fnamecmp) then
halt(10)
else
findclose(rsr);
DeleteFile(FNAME);
SetCurrentDir(curdir);
RemoveDir('tffdir');
end;
procedure tffirstutf16;
const
FNAME = unicodestring('adéfg');
var
f: thandle;
res: longint;
fnamecmp,
fsearch,
curdir: unicodestring;
usr: TUnicodeSearchRec;
begin
if not CreateDir('tffdir') then
halt(200);
curdir:=unicodestring(GetCurrentDir);
if not SetCurrentDir('tffdir') then
halt(201);
f:=FileCreate(FNAME);
if f<=0 then
halt(202);
FileClose(f);
{ determine how the file system reports the name of the file (with the é
precomposed or decomposed) so we can pass the correct form to findfirst. We cannot
deal with this automatically in findfirst itself, because some OSes/file systems
allow both forms to coexist. }
if (findfirst('ad*fg',faAnyFile and not(faDirectory),usr)<>0) then
halt(11)
else
begin
fnamecmp:=usr.name;
findclose(usr);
end;
fsearch:=fnamecmp;
fsearch[1]:='?';
res:=findfirst(fsearch,faAnyFile and not(faDirectory),usr);
if (res<>0) or
(usr.name<>fnamecmp) then
begin
writeln('res: ',res);
if res=0 then
writeln('fn: ',usr.name);
halt(12)
end
else
findclose(usr);
fsearch:=fnamecmp;
fsearch[2]:='?';
if (findfirst(fsearch,faAnyFile and not(faDirectory),usr)<>0) or
(usr.name<>fnamecmp) then
halt(13)
else
findclose(usr);
{ must succeed regardless of whether the é is decomposed or not }
if (findfirst('ad?fg',faAnyFile and not(faDirectory),usr)<>0) or
(usr.name<>fnamecmp) then
halt(14)
else
findclose(usr);
{ this should succeed if if the the é is decomposed (at least "ls ade?fg" succeeds
on Mac OS X) }
if (fnamecmp[3]='e') then
if (findfirst('ade?fg',faAnyFile and not(faDirectory),usr)<>0) then
halt(15)
else
findclose(usr);
fsearch:=fnamecmp;
fsearch[length(fsearch)-1]:='?';
if (findfirst(fsearch,faAnyFile and not(faDirectory),usr)<>0) or
(usr.name<>fnamecmp) then
halt(16)
else
findclose(usr);
fsearch:=fnamecmp;
fsearch[length(fsearch)]:='?';
if (findfirst(fsearch,faAnyFile and not(faDirectory),usr)<>0) or
(usr.name<>fnamecmp) then
halt(17)
else
findclose(usr);
if (findfirst('a*fg',faAnyFile and not(faDirectory),usr)<>0) or
(usr.name<>fnamecmp) then
halt(18)
else
findclose(usr);
if (findfirst('ad*',faAnyFile and not(faDirectory),usr)<>0) or
(usr.name<>fnamecmp) then
halt(19)
else
findclose(usr);
fsearch:=fnamecmp;
fsearch[length(fsearch)-1]:='*';
if (findfirst(fsearch,faAnyFile and not(faDirectory),usr)<>0) or
(usr.name<>fnamecmp) then
halt(20)
else
findclose(usr);
DeleteFile(FNAME);
SetCurrentDir(curdir);
RemoveDir('tffdir');
end;
begin
tffirstutf8;
tffirstutf16;
end.