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

* Hopefully fixed GetFileStamps/FileGetDateTimeInfo

Browse Source 
(cherry picked from commit c5af4c420e)
This commit is contained in:
Michaël Van Canneyt 2023-01-31 19:05:42 +01:00 committed by marcoonthegit
parent f7edcf0fa5
commit 0a9b46d86f
3 changed files with 80 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
packages/vcl-compat/src/system.ioutils.pp
View File

@ -230,7 +230,7 @@ type
private
class function DetectFileEncoding(const aPath: String; out BOMLength: Integer
): TEncoding;
class procedure GetFileTimestamps(const aFilename: TFileName; var CreateUTC, WriteUTC, AccessUTC: TDateTime);
class procedure GetFileTimestamps(const aFilename: TFileName; var aCreate, aWrite, aAccess: TDateTime; IsUTC : Boolean);
public
class function IntegerToFileAttributes(const Attributes: Integer): TFileAttributes;
class function FileAttributesToInteger(const Attributes: TFileAttributes): Integer;
@ -1384,44 +1384,26 @@ end;
{ TFile }
class procedure TFile.GetFileTimestamps(const aFilename: TFileName;
var CreateUTC, WriteUTC, AccessUTC: TDateTime);
{$IfDef MSWINDOWS}
var
Info: TWin32FileAttributeData;
DosTime: DWORD;
{$endif}
{$ifdef UNIX}
var
Info: stat;
{$EndIf}
class procedure TFile.GetFileTimestamps(const aFilename: TFileName; var aCreate, aWrite, aAccess: TDateTime; IsUTC: Boolean);
var
DateTime: TDateTimeInfoRec;
begin
{$If Defined(MSWINDOWS)}
if not GetFileAttributesEx(PChar(aFileName), GetFileExInfoStandard, @info) then
RaiseLastOSError;
DosTime:=0;
FileTimeToDosDateTime(info.ftCreationTime, LongRec(DosTime).Hi, LongRec(DosTime).Lo);
CreateUTC:=FileDateToDateTime(DosTime);
FileTimeToDosDateTime(info.ftLastWriteTime, LongRec(DosTime).Hi, LongRec(DosTime).Lo);
WriteUTC :=FileDateToDateTime(DosTime);
FileTimeToDosDateTime(info.ftLastAccessTime, LongRec(DosTime).Hi, LongRec(DosTime).Lo);
AccessUTC:=FileDateToDateTime(DosTime);
{$ElseIf Defined(UNIX)}
Info:=Default(Stat);
if fpstat(aFileName, info) <> 0 then
raise EInOutError.CreateFmt(errStatFailed, [aFileName, fpgeterrno]);
CreateUTC:=UnixToDateTime(info.st_ctime, True);
WriteUTC :=UnixToDateTime(info.st_mtime, True);
AccessUTC:=UnixToDateTime(info.st_atime, True);
{$Else}
if FileAge(aFilename, CreateUTC) then
begin
WriteUTC := CreateUTC;
AccessUTC := CreateUTC;
end
else
raise EInOutError.CreateFmt(SErrFileNotFound, [aFileName]);
{$EndIf}
if FileGetDateTimeInfo(aFileName,DateTime) then
begin
aCreate:=DateTime.CreationTime;
aWrite:=DateTime.TimeStamp;
aAccess:=DateTime.LastAccessTime;
if isUTC then
begin
aCreate:=LocalTimeToUniversal(aCreate);
aWrite:=LocalTimeToUniversal(aCreate);
aAccess:=LocalTimeToUniversal(aCreate);
end;
end
else
raise EInOutError.CreateFmt(SErrFileNotFound, [aFileName]);
end;
class function TFile.IntegerToFileAttributes(const Attributes: Integer
@ -1703,8 +1685,14 @@ begin
end;
class function TFile.GetCreationTime(const aPath: string): TDateTime;
var
Dummy1, Dummy2: TDateTime;
begin
Result:=UTCtoLocal(TFile.GetCreationTimeUtc(aPath));
Result:=MinDateTime;
Dummy1:=MinDateTime;
Dummy2:=MinDateTime;
GetFileTimestamps(aPath, Result, Dummy1, Dummy2, False);
end;
class function TFile.GetCreationTimeUtc(const aPath: string): TDateTime;
@ -1714,12 +1702,17 @@ begin
Result:=MinDateTime;
Dummy1:=MinDateTime;
Dummy2:=MinDateTime;
GetFileTimestamps(aPath, Result, Dummy1, Dummy2);
GetFileTimestamps(aPath, Result, Dummy1, Dummy2, True);
end;
class function TFile.GetLastAccessTime(const aPath: string): TDateTime;
var
Dummy1, Dummy2: TDateTime;
begin
Result:=UTCtoLocal(TFile.GetLastAccessTimeUtc(aPath));
Result:=MinDateTime;
Dummy1:=MinDateTime;
Dummy2:=MinDateTime;
GetFileTimestamps(aPath, Dummy1, Dummy2, Result, False);
end;
class function TFile.GetLastAccessTimeUtc(const aPath: string): TDateTime;
@ -1729,12 +1722,17 @@ begin
Result:=MinDateTime;
Dummy1:=MinDateTime;
Dummy2:=MinDateTime;
GetFileTimestamps(aPath, Dummy1, Dummy2, Result);
GetFileTimestamps(aPath, Dummy1, Dummy2, Result,True);
end;
class function TFile.GetLastWriteTime(const aPath: string): TDateTime;
var
Dummy1, Dummy2: TDateTime;
begin
Result:=UTCtoLocal(TFile.GetLastWriteTime(aPath));
Result:=MinDateTime;
Dummy1:=MinDateTime;
Dummy2:=MinDateTime;
GetFileTimestamps(aPath, Dummy1, Result, Dummy2, False);
end;
class function TFile.GetLastWriteTimeUtc(const aPath: string): TDateTime;
@ -1744,7 +1742,7 @@ begin
Result:=MinDateTime;
Dummy1:=MinDateTime;
Dummy2:=MinDateTime;
GetFileTimestamps(aPath, Dummy1, Result, Dummy2);
GetFileTimestamps(aPath, Dummy1, Result, Dummy2,True);
end;
class function TFile.GetSymLinkTarget(const aFileName: string;

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

@ -697,11 +697,7 @@ begin
Result:=FileDateToDateTime(data.st_ctime)
{$endif}
{$else}
{$IFDEF SEARCHREC_USEFINDDATA}
FileDateToDateTime(Data.Time);
{$ELSE}
Result:=0;
{$ENDIF}
Result:=FileDateToDateTime(Data.Time);
{$ENDIF}
{$ENDIF}
end;
@ -718,14 +714,9 @@ begin
Result:=FileDateToDateTime(data.st_atime)
{$endif}
{$else}
{$IFDEF SEARCHREC_USEFINDDATA}
FileDateToDateTime(Data.Time);
{$ELSE}
Result:=0;
{$ENDIF}
Result:=FileDateToDateTime(Data.Time);
{$ENDIF}
{$ENDIF}
end;
function TDateTimeInfoRec.GetTimeStamp: TDateTime;
@ -740,11 +731,7 @@ begin
Result:=FileDateToDateTime(data.st_mtime)
{$endif}
{$else}
{$IFDEF SEARCHREC_USEFINDDATA}
FileDateToDateTime(Data.Time);
{$ELSE}
Result:=0;
{$ENDIF}
Result:=FileDateToDateTime(Data.Time);
{$ENDIF}
{$ENDIF}
end;
@ -992,18 +979,17 @@ end;
{$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}
Result:=FindFirst(FileName,0,Info)=0;
if Result then
begin
DateTime.data:=Info;
FindClose(FileName,0,Info)
end;
end;
{$ENDIF}

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

@ -47,29 +47,6 @@ 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
@ -164,6 +141,32 @@ Type
TSymLinkRec = TRawbyteSymLinkRec;
{$ENDIF}
{ TDateTimeInfoRec }
TDateTimeInfoRec = record
private
{$IF DEFINED(WINDOWS) AND NOT DEFINED(WIN16)}
Data: TFindData platform;
{$ELSE}
{$IFDEF UNIX}
{$IFDEF USE_STATX}
data : tstatx platform;
{$ELSE}
data : baseunix.stat platform;
{$ENDIF USE_STATX}
{$ELSE}
data : TSearchRec;
{$ENDIF}
{$ENDIF}
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;
Const
{ File attributes }
@ -230,6 +233,7 @@ Function ExeSearch (Const Name : UnicodeString; Const DirList : UnicodeString =
Function FileIsReadOnly(const FileName : UnicodeString): Boolean;
function FileAge(const FileName: UnicodeString; out FileDateTime: TDateTime; FollowLink: Boolean = True): Boolean;
function FileAgeUTC(const FileName: UnicodeString; out FileDateTimeUTC: TDateTime; FollowLink: Boolean = True): Boolean;
function FileGetDateTimeInfo(const FileName: string; out DateTime: TDateTimeInfoRec; FollowLink: Boolean = True): Boolean;
function FileGetSymLinkTarget(const FileName: UnicodeString; out SymLinkRec: TUnicodeSymLinkRec): Boolean;
function FileGetSymLinkTarget(const FileName: UnicodeString; out TargetName: UnicodeString): Boolean; inline;