-
Notifications
You must be signed in to change notification settings - Fork 19
Description
Added a callable function to create the logfile but preserve "old" log and remove all old logs older than n days. Call this when initiate th logger instead of the original function.
----------- code start
PROCEDURE TLogger.ClearAndStore(DaysToPreserve: integer);
// added by rnervi nov23
CONST
// cannot use : as is forbidden by OS !
FORMAT_DATETIME_DEFAULT = 'yyyy-mm-dd hh.nn.ss';
VAR
p, f: string;
PROCEDURE DeleteFilesOlderThanXDays(Path: string; DaysOld: integer = 0;
// 0 => Delete every file, ignoring the file age
FileMask: string = '.');
VAR
iFindResult: integer;
SearchRecord: tSearchRec;
iFilesDeleted: integer;
BEGIN
iFilesDeleted := 0;
// iFindResult := FindFirst(TPath.Combine(Path, FileMask), faAnyFile, SearchRecord);
iFindResult := FindFirst(Path + FileMask, faAnyFile, SearchRecord);
IF iFindResult = 0 THEN
BEGIN
WHILE iFindResult = 0 DO
BEGIN
IF ((SearchRecord.Attr and faDirectory) = 0) THEN
BEGIN
IF (FileDateToDateTime(SearchRecord.Time) < Now - DaysOld) or (DaysOld = 0) THEN
BEGIN
// DeleteFile(TPath.Combine(Path, SearchRecord.Name));
DeleteFile(pchar(Path+SearchRecord.Name));
iFilesDeleted := iFilesDeleted + 1;
END;
END;
iFindResult := FindNext(SearchRecord);
END;
// FindClose(SearchRecord);
END;
// Result := iFilesDeleted;
END;
BEGIN
p := extractfilepath(FFileName);
// want to delete n "old versions" to avoid waste of space
// DeleteFilesOlderThan(DaysToPreserve,p,'.old);
DeleteFilesOlderThanXDays(p, DaysToPreserve, '.old');
IF FileExists(FFileName) THEN
BEGIN
// want to make an historic of log file. thus
// rename it with his datetime to preserve
f := FormatDateTime(FORMAT_DATETIME_DEFAULT, Now) + ' ' +
ExtractFileName(FFileName);
// rename as .old makes cleanup procedure easy !
f := ChangeFileExt(f, '.old');
renamefile(FFileName, p + f);
// copyfile(pchar(FFileName),pchar(f),false);
END;
IF not FileExists(FFileName) THEN
Exit;
IF FIsInit THEN
CloseFile(FOutFile);
SysUtils.DeleteFile(FFileName);
FIsInit := False;
END;
----------- code end