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

* FileSetDate now working on Win, see #7837

Browse Source 
* FileSetDate more Delphi compatible

git-svn-id: trunk@5824 -
This commit is contained in:
florian 2007-01-06 10:48:10 +00:00
parent c759b114bf
commit 35fdb22b91
4 changed files with 39 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -6895,6 +6895,7 @@ tests/test/units/system/ttrunc.pp svneol=native#text/plain
tests/test/units/sysutils/execansi.pp svneol=native#text/plain tests/test/units/sysutils/execansi.pp svneol=native#text/plain
tests/test/units/sysutils/execedbya.pp svneol=native#text/plain tests/test/units/sysutils/execedbya.pp svneol=native#text/plain
tests/test/units/sysutils/extractquote.pp svneol=native#text/plain tests/test/units/sysutils/extractquote.pp svneol=native#text/plain
tests/test/units/sysutils/tfile1.pp svneol=native#text/plain
tests/test/units/sysutils/tsscanf.pp svneol=native#text/plain tests/test/units/sysutils/tsscanf.pp svneol=native#text/plain
tests/test/units/sysutils/tstrtobool.pp svneol=native#text/plain tests/test/units/sysutils/tstrtobool.pp svneol=native#text/plain
tests/test/uprec6.pp svneol=native#text/plain tests/test/uprec6.pp svneol=native#text/plain

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

@ -59,12 +59,11 @@
{$ifndef OS_FILESETDATEBYNAME} {$ifndef OS_FILESETDATEBYNAME}
Function FileSetDate (Const FileName : String;Age : Longint) : Longint; Function FileSetDate (Const FileName : String;Age : Longint) : Longint;
Var Var
fd : THandle; fd : THandle;
begin begin
fd:=FileOpen(FileName,fmOpenRead); { at least windows requires fmOpenWrite here }
fd:=FileOpen(FileName,fmOpenWrite);
If (Fd<>feInvalidHandle) then If (Fd<>feInvalidHandle) then
try try
Result:=FileSetDate(fd,Age); Result:=FileSetDate(fd,Age);
@ -72,7 +71,7 @@
FileClose(fd); FileClose(fd);
end end
else else
Result:=Fd; Result:=fd;
end; end;
{$endif} {$endif}

2
rtl/win/sysutils.pp
View File

@ -409,7 +409,7 @@ Var
begin begin
Result := 0; Result := 0;
if DosToWinTime(Age,FT) and if DosToWinTime(Age,FT) and
SetFileTime(Handle, ft, ft, FT) then SetFileTime(Handle, nil, nil, @FT) then
Exit; Exit;
Result := GetLastError; Result := GetLastError;
end; end;

34
tests/test/units/sysutils/tfile1.pp Normal file
View File

@ -0,0 +1,34 @@
PROGRAM Test;
USES
SysUtils;
procedure do_error(l : longint);
begin
writeln('Error near number ',l);
halt(1);
end;
VAR
dateTime: TDateTime;
f : file;
BEGIN
if FileExists('datetest.dat') then
begin
Assign(f,'datetest.dat');
Erase(f);
end;
if FileExists('datetest.dat') then
do_error(1000);
FileClose(FileCreate('datetest.dat'));
if not(FileExists('datetest.dat')) then
do_error(1001);
dateTime := IncMonth(Now, -1);
if FileSetDate('datetest.dat', DateTimeToFileDate(dateTime))<>0 then
do_error(1002);
END.