program TestFileDate;
{$APPTYPE CONSOLE}
uses
SysUtils, Classes, Windows,
DateUtils;
const
TestFilename = '
TestFileOrg.TXT';
TestFilename2 = '
TestFileRen.TXT';
TempFilename = '
TestFileNew.TMP';
function FileTimeToDateTime(ft: TFileTime): TDateTime;
var st : TSystemTime;
begin
FileTimeToLocalFileTime(ft,ft);
FileTimeToSystemTime (ft, st);
with st
do
result := EncodeDate(wYear, wMonth, wDay) +
EncodeTime(wHour, wMinute, wSecond, wMilliSeconds);
end;
function DateTimeToFileTime(dt: TDateTime): TFileTime;
var
st : TSystemTime;
begin
with st
do
begin
DecodeDate(dt, st.wYear, st.wMonth, st.wDay);
DecodeTime(dt, st.wHour, st.wMinute, st.wSecond, st.wMilliSeconds);
end;
SystemTimeToFileTime (st, result);
LocalFileTimeToFileTime(result,result);
end;
procedure WriteFileTile(AFileName:
string);
var
F:TFileStream;
CreateTime, LastWriteTime: TFileTime;
begin
F := TFileStream.Create(AFileName, fmOpenRead);
try
GetFileTime(F.Handle,@CreateTime,
nil,@LastWriteTime);
finally
F.Free;
end;
WriteLn(AFileName,
'
Created:',
DateTimeToStr(FileTimeToDateTime(CreateTime)),
'
geaendert:' ,DateTimeToStr(FileTimeToDateTime( LastWriteTime)));
end;
procedure CreateTestFile(AFileName:
string;AFileTime: TDateTime);
var
F:TFileStream;
FT:TFileTime;
begin
F := TFileStream.Create(AFileName, fmCreate);
try
F.
Write(AFileName[1],Length(AFileName));
FT := DateTimeToFileTime(AFileTime);
SetFileTime(F.Handle,@FT,
nil, @FT);
finally
F.Free;
end;
WriteFileTile(AFileName)
end;
begin
try
// alte Dateien löschen
DeleteFile(TestFilename);
DeleteFile(TestFileName2);
WriteLn('
1. Datei mit altem Datum anlegen');
CreateTestFile(TestFilename,IncMinute(IncHour(IncDay(IncMonth(IncYear(Now, - 1),-1),-1),-1),-1));
WriteLn('
2. Datei mit aktuellem Datum anlegen');
CreateTestFile(TempFilename,Now);
WriteLn('
Rename: ',TestFilename,'
-> ', TestFileName2);
RenameFile(TestFilename, TestFileName2);
WriteFileTile(TestFileName2);
WriteFileTile(TempFilename);
RenameFile(TempFilename,TestFilename);
WriteLn('
Rename: ',TempFilename,'
-> ',TestFilename);
WriteFileTile(TestFilename);
readln;
except
on E:
Exception do
Writeln(E.Classname, '
: ', E.
Message);
end;
end.