* Date/Time info for files (Delphi compatibility)

This commit is contained in:
Michael Van Canneyt 2023-01-21 13:38:51 +01:00
parent a06c034189
commit d1b2fe1659
4 changed files with 214 additions and 3 deletions

View File

@ -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}

View File

@ -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

View File

@ -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;

View File

@ -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;