mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-16 21:59:32 +02:00
* Date/Time info for files (Delphi compatibility)
This commit is contained in:
parent
a06c034189
commit
d1b2fe1659
@ -655,6 +655,7 @@ begin
|
||||
InternalFindClose(f.FindHandle{$ifdef SEARCHREC_USEFINDDATA},f.FindData{$endif});
|
||||
end;
|
||||
|
||||
|
||||
{$if defined(windows) and not defined(win16)}
|
||||
function FindDataTimeToDateTime(constref aFileTime: FILETIME; out aResult: TDateTime): Boolean;
|
||||
var
|
||||
@ -681,6 +682,73 @@ begin
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
{ TDateTimeInfoRec }
|
||||
|
||||
function TDateTimeInfoRec.GetCreationTime: TDateTime;
|
||||
begin
|
||||
{$if defined(windows) and not defined(win16)}
|
||||
FindDataTimeToDateTime(Data.ftCreationTime,Result)
|
||||
{$else}
|
||||
{$ifdef unix}
|
||||
{$ifdef use_statx}
|
||||
Result:=FileDateToDateTime(data.stx_ctime.tv_sec)
|
||||
{$else}
|
||||
Result:=FileDateToDateTime(data.st_ctime)
|
||||
{$endif}
|
||||
{$else}
|
||||
{$IFDEF SEARCHREC_USEFINDDATA}
|
||||
FileDateToDateTime(Data.Time);
|
||||
{$ELSE}
|
||||
Result:=0;
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TDateTimeInfoRec.GetLastAccessTime: TDateTime;
|
||||
begin
|
||||
{$if defined(windows) and not defined(win16)}
|
||||
FindDataTimeToDateTime(Data.ftLastAccessTime,Result)
|
||||
{$else}
|
||||
{$ifdef unix}
|
||||
{$ifdef use_statx}
|
||||
Result:=FileDateToDateTime(data.stx_atime.tv_sec)
|
||||
{$else}
|
||||
Result:=FileDateToDateTime(data.st_atime)
|
||||
{$endif}
|
||||
{$else}
|
||||
{$IFDEF SEARCHREC_USEFINDDATA}
|
||||
FileDateToDateTime(Data.Time);
|
||||
{$ELSE}
|
||||
Result:=0;
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
end;
|
||||
|
||||
function TDateTimeInfoRec.GetTimeStamp: TDateTime;
|
||||
begin
|
||||
{$if defined(windows) and not defined(win16)}
|
||||
FindDataTimeToDateTime(Data.ftLastWriteTime,Result)
|
||||
{$else}
|
||||
{$ifdef unix}
|
||||
{$ifdef use_statx}
|
||||
Result:=FileDateToDateTime(data.stx_mtime.tv_sec)
|
||||
{$else}
|
||||
Result:=FileDateToDateTime(data.st_mtime)
|
||||
{$endif}
|
||||
{$else}
|
||||
{$IFDEF SEARCHREC_USEFINDDATA}
|
||||
FileDateToDateTime(Data.Time);
|
||||
{$ELSE}
|
||||
Result:=0;
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
|
||||
{ TUnicodeSearchRec }
|
||||
|
||||
function TUnicodeSearchRec.GetTimeStamp: TDateTime;
|
||||
@ -920,3 +988,22 @@ begin
|
||||
end;
|
||||
{$ENDIF HAS_ISFILENAMECASEPRESERVING}
|
||||
|
||||
{$IFNDEF HAS_FILEGETDATETIMEINFO}
|
||||
function FileGetDateTimeInfo(const FileName: string;
|
||||
out DateTime: TDateTimeInfoRec; FollowLink: Boolean = True): Boolean;
|
||||
{$IFDEF SEARCHREC_USEFINDDATA}
|
||||
var
|
||||
Info : TSearchRec;
|
||||
{$ENDIF}
|
||||
begin
|
||||
{$IFDEF SEARCHREC_USEFINDDATA}
|
||||
Result:=FindFirst(FileName,0,Info)=0;
|
||||
if Result then
|
||||
DateTime.data:=Info.Data;
|
||||
{$ELSE}
|
||||
Result:=False;
|
||||
{$ENDIF}
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
|
@ -50,6 +50,29 @@ Type
|
||||
|
||||
// The actual unicode search record
|
||||
|
||||
{ TDateTimeInfoRec }
|
||||
|
||||
TDateTimeInfoRec = record
|
||||
private
|
||||
{$IFDEF SEARCHREC_USEFINDDATA}
|
||||
Data: TWin32FindData platform;
|
||||
{$ENDIF WINDOWS}
|
||||
{$IFDEF UNIX}
|
||||
{$ifdef USE_STATX}
|
||||
data : tstatx platform;
|
||||
{$else}
|
||||
data : baseunix.stat platform;
|
||||
{$endif USE_STATX}
|
||||
{$ENDIF UNIX}
|
||||
|
||||
function GetCreationTime: TDateTime;
|
||||
function GetLastAccessTime: TDateTime;
|
||||
function GetTimeStamp: TDateTime;
|
||||
public
|
||||
property CreationTime: TDateTime read GetCreationTime;
|
||||
property LastAccessTime: TDateTime read GetLastAccessTime;
|
||||
property TimeStamp: TDateTime read GetTimeStamp;
|
||||
end;
|
||||
{ TUnicodeSearchRec }
|
||||
|
||||
TUnicodeSearchRec = Record
|
||||
|
@ -26,7 +26,7 @@ interface
|
||||
{$if (defined(BSD) or defined(SUNOS)) and defined(FPC_USE_LIBC)}
|
||||
{$define USE_VFORK}
|
||||
{$endif}
|
||||
|
||||
{$DEFINE HAS_FILEGETDATETIMEINFO}
|
||||
{$DEFINE OS_FILESETDATEBYNAME}
|
||||
{$DEFINE HAS_SLEEP}
|
||||
{$DEFINE HAS_OSERROR}
|
||||
@ -49,7 +49,7 @@ interface
|
||||
uses
|
||||
{$IFDEF LINUX}linux,{$ENDIF}
|
||||
{$IFDEF FreeBSD}freebsd,{$ENDIF}
|
||||
Unix,errors,sysconst,Unixtype;
|
||||
baseunix, Unix,errors,sysconst,Unixtype;
|
||||
|
||||
{$IF defined(LINUX) or defined(FreeBSD)}
|
||||
{$DEFINE HAVECLOCKGETTIME}
|
||||
@ -100,7 +100,7 @@ Uses
|
||||
{$ifdef android}
|
||||
dl,
|
||||
{$endif android}
|
||||
{$ifdef FPC_USE_LIBC}initc{$ELSE}Syscall{$ENDIF}, Baseunix, unixutil;
|
||||
{$ifdef FPC_USE_LIBC}initc{$ELSE}Syscall{$ENDIF}, unixutil;
|
||||
|
||||
type
|
||||
tsiginfo = record
|
||||
@ -594,6 +594,41 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function FileGetDateTimeInfo(const FileName: string; out DateTime: TDateTimeInfoRec; FollowLink: Boolean = True): Boolean;
|
||||
|
||||
var
|
||||
FN : AnsiString;
|
||||
st: tstat;
|
||||
{$IFDEF USE_STATX}
|
||||
stx : tstatx;
|
||||
flags : Integer;
|
||||
|
||||
const
|
||||
STATXMASK = STATX_MTIME or STATX_ATIME or STATX_CTIME;
|
||||
{$ENDIF}
|
||||
begin
|
||||
FN:=FileName;
|
||||
{$ifdef USE_STATX}
|
||||
flags:=0;
|
||||
if Not FollowLink then
|
||||
Flags:=AT_SYMLINK_NOFOLLOW;
|
||||
if (statx(AT_FDCWD,PAnsiChar(FN),FLags,STATXMASK, stx)>=0 then
|
||||
begin
|
||||
DateTime.Data:=stx;
|
||||
Exit(True);
|
||||
end;
|
||||
{$else}
|
||||
if (FollowLink and (fpstat(FN,st) = 0)) or
|
||||
(not FollowLink and (fplstat(fn, st) = 0)) then
|
||||
begin
|
||||
DateTime.Data:=st;
|
||||
Result := True;
|
||||
end;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
|
||||
|
||||
Function LinuxToWinAttr (const FN : RawByteString; Const Info : Stat) : Longint;
|
||||
Var
|
||||
LinkInfo : Stat;
|
||||
|
@ -37,6 +37,7 @@ uses
|
||||
{$DEFINE HAS_GETTICKCOUNT64}
|
||||
{$DEFINE HAS_FILEDATETIME}
|
||||
{$DEFINE OS_FILESETDATEBYNAME}
|
||||
{$DEFINE HAS_FILEGETDATETIMEINFO}
|
||||
|
||||
// this target has an fileflush implementation, don't include dummy
|
||||
{$DEFINE SYSUTILS_HAS_FILEFLUSH_IMPL}
|
||||
@ -624,6 +625,46 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetFinalPathNameByHandle(aHandle : THandle; Buf : LPSTR; BufSize : DWord; Flags : DWord) : DWORD; external 'kernel32' name 'GetFinalPathNameByHandleA';
|
||||
|
||||
Const
|
||||
VOLUME_NAME_NT = $2;
|
||||
|
||||
Function FollowSymlink(const aLink: String): String;
|
||||
Var
|
||||
Attrs: Cardinal;
|
||||
aHandle: THandle;
|
||||
oFlags: DWord;
|
||||
Buf : Array[0..Max_Path] of AnsiChar;
|
||||
Len : Integer;
|
||||
|
||||
begin
|
||||
Result:='';
|
||||
FillChar(Buf,MAX_PATH+1,0);
|
||||
if Not FileExists(aLink,False) then
|
||||
exit;
|
||||
if not CheckWin32Version(6, 0) then
|
||||
exit;
|
||||
Attrs:=GetFileAttributes(PChar(aLink));
|
||||
if (Attrs=INVALID_FILE_ATTRIBUTES) or ((Attrs and faSymLink)=0) then
|
||||
exit;
|
||||
oFLags:=0;
|
||||
// https://learn.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-createfilea
|
||||
if (Attrs and faDirectory)=faDirectory then
|
||||
oFlags:=FILE_FLAG_BACKUP_SEMANTICS;
|
||||
aHandle:=CreateFile(PChar(aLink),GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING,oFlags,0);
|
||||
if aHandle=INVALID_HANDLE_VALUE then
|
||||
exit;
|
||||
try
|
||||
Len:=GetFinalPathNameByHandle(aHandle,@Buf,MAX_PATH,VOLUME_NAME_NT);
|
||||
If Len<=0 then
|
||||
exit;
|
||||
Result:=StrPas(PChar(@Buf));
|
||||
finally
|
||||
CloseHandle(aHandle);
|
||||
end;
|
||||
end;
|
||||
|
||||
Function InternalFindFirst (Const Path : UnicodeString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name : UnicodeString) : Longint;
|
||||
begin
|
||||
Name:=Path;
|
||||
@ -653,6 +694,31 @@ begin
|
||||
Result := GetLastError;
|
||||
end;
|
||||
|
||||
function FileGetDateTimeInfo(const FileName: string;
|
||||
out DateTime: TDateTimeInfoRec; FollowLink: Boolean = True): Boolean;
|
||||
var
|
||||
Data: TWin32FindData;
|
||||
FN: string;
|
||||
begin
|
||||
Result := False;
|
||||
SetLastError(ERROR_SUCCESS);
|
||||
FN:=FileName;
|
||||
if Not GetFileAttributesEx(PAnsiChar(FileName), GetFileExInfoStandard, @Data) then
|
||||
exit;
|
||||
if ((Data.dwFileAttributes and faSymlink)=faSymlink) then
|
||||
begin
|
||||
if FollowLink then
|
||||
begin
|
||||
FN:=FollowSymlink(FileName);
|
||||
if FN='' then
|
||||
exit;
|
||||
if not GetFileAttributesEx(PAnsiChar(FN), GetFileExInfoStandard, @Data) then
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
DateTime.Data:=Data;
|
||||
Result:=True;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user