mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-25 12:22:34 +02:00
566 lines
16 KiB
PHP
566 lines
16 KiB
PHP
{
|
|
This file is part of the Free Pascal run time library.
|
|
Copyright (c) 2012 by the Free Pascal development team
|
|
|
|
File utility calls
|
|
|
|
See the file COPYING.FPC, included in this distribution,
|
|
for details about the copyright.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
|
**********************************************************************}
|
|
|
|
|
|
|
|
{$ifndef SYSUTILS_HAS_UNICODESTR_FILEUTIL_IMPL}
|
|
Function FileOpen (Const FileName : unicodestring; Mode : Integer) : THandle;
|
|
begin
|
|
Result:=FileOpen(ToSingleByteFileSystemEncodedFileName(FileName),Mode);
|
|
end;
|
|
|
|
|
|
Function FileCreate (Const FileName : UnicodeString) : THandle;
|
|
begin
|
|
Result:=FileCreate(ToSingleByteFileSystemEncodedFileName(FileName));
|
|
end;
|
|
|
|
|
|
Function FileCreate (Const FileName : UnicodeString; Rights : Integer) : THandle;
|
|
begin
|
|
Result:=FileCreate(ToSingleByteFileSystemEncodedFileName(FileName),Rights);
|
|
end;
|
|
|
|
|
|
Function FileCreate (Const FileName : UnicodeString; ShareMode : Integer; Rights : Integer) : THandle;
|
|
begin
|
|
Result:=FileCreate(ToSingleByteFileSystemEncodedFileName(FileName),ShareMode,Rights);
|
|
end;
|
|
|
|
|
|
Function FileAge (Const FileName : UnicodeString): Longint;
|
|
begin
|
|
Result:=FileAge(ToSingleByteFileSystemEncodedFileName(FileName));
|
|
end;
|
|
|
|
|
|
Function FileExists (Const FileName : UnicodeString) : Boolean;
|
|
begin
|
|
Result:=FileExists(ToSingleByteFileSystemEncodedFileName(FileName));
|
|
end;
|
|
|
|
|
|
Function DirectoryExists (Const Directory : UnicodeString) : Boolean;
|
|
begin
|
|
Result:=DirectoryExists(ToSingleByteFileSystemEncodedFileName(Directory));
|
|
end;
|
|
|
|
|
|
Function FileGetAttr (Const FileName : UnicodeString) : Longint;
|
|
begin
|
|
Result:=FileGetAttr(ToSingleByteFileSystemEncodedFileName(FileName));
|
|
end;
|
|
|
|
|
|
Function FileSetAttr (Const Filename : UnicodeString; Attr: longint) : Longint;
|
|
begin
|
|
Result:=FileSetAttr(ToSingleByteFileSystemEncodedFileName(FileName),Attr);
|
|
end;
|
|
|
|
|
|
Function DeleteFile (Const FileName : UnicodeString) : Boolean;
|
|
begin
|
|
Result:=DeleteFile(ToSingleByteFileSystemEncodedFileName(FileName));
|
|
end;
|
|
|
|
|
|
Function RenameFile (Const OldName, NewName : UnicodeString) : Boolean;
|
|
|
|
begin
|
|
Result:=RenameFile(ToSingleByteFileSystemEncodedFileName(OldName),
|
|
ToSingleByteFileSystemEncodedFileName(NewName));
|
|
end;
|
|
|
|
{$ifdef OS_FILEISREADONLY}
|
|
Function FileIsReadOnly(const FileName: UnicodeString): Boolean;
|
|
begin
|
|
Result:=FileIsReadOnly(ToSingleByteFileSystemEncodedFileName(FileName));
|
|
end;
|
|
{$endif}
|
|
|
|
|
|
{$ifdef OS_FILESETDATEBYNAME}
|
|
Function FileSetDate (Const FileName : UnicodeString;Age : Longint) : Longint;
|
|
begin
|
|
Result:=FileSetDate(ToSingleByteFileSystemEncodedFileName(FileName),Age);
|
|
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),
|
|
ToSingleByteFileSystemEncodedFileName(Dirlist),Options));
|
|
end;
|
|
|
|
|
|
Function FileSearch (Const Name, DirList : UnicodeString; ImplicitCurrentDir : Boolean) : UnicodeString;
|
|
begin
|
|
Result:=UnicodeString(FileSearch(ToSingleByteFileSystemEncodedFileName(Name),
|
|
ToSingleByteFileSystemEncodedFileName(DirList),ImplicitCurrentDir));
|
|
end;
|
|
|
|
|
|
Function ExeSearch (Const Name : UnicodeString; Const DirList : UnicodeString ='' ) : UnicodeString;
|
|
begin
|
|
Result:=UnicodeString(ExeSearch(ToSingleByteFileSystemEncodedFileName(Name),
|
|
ToSingleByteFileSystemEncodedFileName(Dirlist)));
|
|
end;
|
|
|
|
|
|
|
|
Function FileSearch (Const Name, DirList : RawByteString; Options : TFileSearchoptions = [sfoImplicitCurrentDir]) : RawByteString;
|
|
Var
|
|
I : longint;
|
|
Temp : RawByteString;
|
|
begin
|
|
Result:=Name;
|
|
temp:=SetDirSeparators(DirList);
|
|
// Start with checking the file in the current directory
|
|
If (sfoImplicitCurrentDir in Options) and (Result <> '') and FileExists(Result) Then
|
|
exit;
|
|
while True do begin
|
|
If Temp = '' then
|
|
Break; // No more directories to search - fail
|
|
I:=pos(PathSeparator,Temp);
|
|
If I<>0 then
|
|
begin
|
|
Result:=Copy (Temp,1,i-1);
|
|
system.Delete(Temp,1,I);
|
|
end
|
|
else
|
|
begin
|
|
Result:=Temp;
|
|
Temp:='';
|
|
end;
|
|
If Result<>'' then
|
|
begin
|
|
If (sfoStripQuotes in Options) and (Result[1]='"') and (Result[Length(Result)]='"') then
|
|
Result:=Copy(Result,2,Length(Result)-2);
|
|
if (Result<>'') then
|
|
Result:=IncludeTrailingPathDelimiter(Result)+name;
|
|
end;
|
|
If (Result <> '') and FileExists(Result) Then
|
|
exit;
|
|
end;
|
|
Result:='';
|
|
end;
|
|
|
|
|
|
Function FileSearch (Const Name, DirList : RawByteString; ImplicitCurrentDir : Boolean) : RawByteString;
|
|
begin
|
|
if ImplicitCurrentDir then
|
|
Result:=FileSearch(Name,DirList,[sfoImplicitCurrentDir])
|
|
else
|
|
Result:=FileSearch(Name,DirList,[]);
|
|
end;
|
|
|
|
|
|
Function ExeSearch (Const Name : RawByteString; Const DirList : RawByteString ='' ) : RawByteString;
|
|
Var
|
|
D : RawByteString;
|
|
O : TFileSearchOptions;
|
|
begin
|
|
D:=DirList;
|
|
if (D='') then
|
|
D:=GetEnvironmentVariable('PATH');
|
|
{$ifdef unix}
|
|
O:=[];
|
|
{$else unix}
|
|
O:=[sfoImplicitCurrentDir,sfoStripQuotes];
|
|
{$endif unix}
|
|
Result := FileSearch(Name, D, O);
|
|
end;
|
|
|
|
{$endif}
|
|
|
|
{$ifndef SYSUTILS_HAS_ANSISTR_FILEUTIL_IMPL}
|
|
Function FileOpen (Const FileName : rawbytestring; Mode : Integer) : THandle;
|
|
begin
|
|
Result:=FileOpen(UnicodeString(FileName),Mode);
|
|
end;
|
|
|
|
|
|
Function FileCreate (Const FileName : RawByteString) : THandle;
|
|
begin
|
|
Result:=FileCreate(UnicodeString(FileName));
|
|
end;
|
|
|
|
|
|
Function FileCreate (Const FileName : RawByteString; Rights : Integer) : THandle;
|
|
begin
|
|
Result:=FileCreate(UnicodeString(FileName),Rights);
|
|
end;
|
|
|
|
|
|
Function FileCreate (Const FileName : RawByteString; ShareMode : Integer; Rights : Integer) : THandle;
|
|
begin
|
|
Result:=FileCreate(UnicodeString(FileName),ShareMode,Rights);
|
|
end;
|
|
|
|
|
|
Function FileAge (Const FileName : RawByteString): Longint;
|
|
begin
|
|
Result:=FileAge(UnicodeString(FileName));
|
|
end;
|
|
|
|
|
|
Function FileExists (Const FileName : RawByteString) : Boolean;
|
|
begin
|
|
Result:=FileExists(UnicodeString(FileName));
|
|
end;
|
|
|
|
|
|
Function DirectoryExists (Const Directory : RawByteString) : Boolean;
|
|
begin
|
|
Result:=DirectoryExists(UnicodeString(Directory));
|
|
end;
|
|
|
|
|
|
Function FileGetAttr (Const FileName : RawByteString) : Longint;
|
|
begin
|
|
Result:=FileGetAttr(unicodestring(FileName));
|
|
end;
|
|
|
|
|
|
Function FileSetAttr (Const Filename : RawByteString; Attr: longint) : Longint;
|
|
begin
|
|
Result:=FileSetAttr(unicodestring(FileName),Attr);
|
|
end;
|
|
|
|
|
|
Function DeleteFile (Const FileName : RawByteString) : Boolean;
|
|
begin
|
|
Result:=DeleteFile(UnicodeString(FileName));
|
|
end;
|
|
|
|
|
|
Function RenameFile (Const OldName, NewName : RawByteString) : Boolean;
|
|
begin
|
|
Result:=RenameFile(UnicodeString(OldName),UnicodeString(NewName));
|
|
end;
|
|
|
|
{$ifdef OS_FILEISREADONLY}
|
|
Function FileIsReadOnly(const FileName: RawByteString): Boolean;
|
|
begin
|
|
Result:=FileIsReadOnly(UnicodeString(FileName));
|
|
end;
|
|
{$endif}
|
|
|
|
{$ifdef OS_FILESETDATEBYNAME}
|
|
Function FileSetDate (Const FileName : RawByteString;Age : Longint) : Longint;
|
|
begin
|
|
Result:=FileSetDate(UnicodeString(FileName),Age);
|
|
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;
|
|
Temp : UnicodeString;
|
|
begin
|
|
Result:=Name;
|
|
temp:=SetDirSeparators(DirList);
|
|
// Start with checking the file in the current directory
|
|
If (sfoImplicitCurrentDir in Options) and (Result <> '') and FileExists(Result) Then
|
|
exit;
|
|
while True do begin
|
|
If Temp = '' then
|
|
Break; // No more directories to search - fail
|
|
I:=pos(PathSeparator,Temp);
|
|
If I<>0 then
|
|
begin
|
|
Result:=Copy (Temp,1,i-1);
|
|
system.Delete(Temp,1,I);
|
|
end
|
|
else
|
|
begin
|
|
Result:=Temp;
|
|
Temp:='';
|
|
end;
|
|
If Result<>'' then
|
|
begin
|
|
If (sfoStripQuotes in Options) and (Result[1]='"') and (Result[Length(Result)]='"') then
|
|
Result:=Copy(Result,2,Length(Result)-2);
|
|
if (Result<>'') then
|
|
Result:=IncludeTrailingPathDelimiter(Result)+name;
|
|
end;
|
|
If (Result <> '') and FileExists(Result) Then
|
|
exit;
|
|
end;
|
|
Result:='';
|
|
end;
|
|
|
|
|
|
Function FileSearch (Const Name, DirList : RawbyteString; Options : TFileSearchoptions = [sfoImplicitCurrentDir]) : RawByteString;
|
|
begin
|
|
Result:=ToSingleByteFileSystemEncodedFileName(FileSearch(unicodestring(name),unicodestring(dirlist),options));
|
|
end;
|
|
|
|
|
|
Function FileSearch (Const Name, DirList : RawbyteString; ImplicitCurrentDir : Boolean) : RawByteString;
|
|
begin
|
|
Result:=ToSingleByteFileSystemEncodedFileName(FileSearch(unicodestring(name),unicodestring(dirlist),ImplicitCurrentDir));
|
|
end;
|
|
|
|
|
|
Function FileSearch (Const Name, DirList : UnicodeString; ImplicitCurrentDir : Boolean) : UnicodeString;
|
|
begin
|
|
if ImplicitCurrentDir then
|
|
Result:=FileSearch(Name,DirList,[sfoImplicitCurrentDir])
|
|
else
|
|
Result:=FileSearch(Name,DirList,[]);
|
|
end;
|
|
|
|
|
|
Function ExeSearch (Const Name : UnicodeString; Const DirList : UnicodeString ='' ) : UnicodeString;
|
|
Var
|
|
D : UnicodeString;
|
|
O : TFileSearchOptions;
|
|
begin
|
|
D:=DirList;
|
|
if (D='') then
|
|
D:=UnicodeString(GetEnvironmentVariable('PATH'));
|
|
{$ifdef unix}
|
|
O:=[];
|
|
{$else unix}
|
|
O:=[sfoImplicitCurrentDir,sfoStripQuotes];
|
|
{$endif unix}
|
|
Result := FileSearch(Name, D, O);
|
|
end;
|
|
|
|
|
|
Function ExeSearch (Const Name : RawbyteString; Const DirList : RawbyteString ='' ) : RawByteString;
|
|
begin
|
|
Result:=ToSingleByteFileSystemEncodedFileName(ExeSearch(unicodestring(name),unicodestring(dirlist)));
|
|
end;
|
|
{$endif}
|
|
|
|
|
|
Function GetFileHandle(var f : File):THandle;
|
|
begin
|
|
Result:=filerec(f).handle;
|
|
end;
|
|
|
|
|
|
Function GetFileHandle(var f : Text):THandle;
|
|
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; keep it a reference-counted type
|
|
so that -gt doesn't overwrite it, the field name should be
|
|
indication enough that you should not touch it }
|
|
Name_do_not_touch : RawByteString;
|
|
ExcludeAttr : Longint;
|
|
FindHandle : {$ifdef FINDHANDLE_IS_POINTER}Pointer{$else}THandle{$endif};
|
|
{$ifdef unix}
|
|
Mode : TMode;
|
|
{$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 FINDHANDLE_IS_POINTER}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;
|
|
|
|
{ TUnicodeSearchRec }
|
|
|
|
function TUnicodeSearchRec.GetTimeStamp: TDateTime;
|
|
begin
|
|
Result := FileDateToDateTime(Time);
|
|
end;
|
|
|
|
{ TRawbyteSearchRec }
|
|
|
|
function TRawbyteSearchRec.GetTimeStamp: TDateTime;
|
|
begin
|
|
Result := FileDateToDateTime(Time);
|
|
end;
|
|
|
|
|
|
{$ifndef SYSUTILS_HAS_FILEFLUSH_IMPL}
|
|
function FileFlush(Handle: THandle): Boolean;
|
|
begin
|
|
Result:= False;
|
|
end;
|
|
{$endif}
|