diff --git a/Packages/X2LogDXE2.dpk b/Packages/X2LogDXE2.dpk
index c9af3c9..7212a7e 100644
--- a/Packages/X2LogDXE2.dpk
+++ b/Packages/X2LogDXE2.dpk
@@ -51,7 +51,8 @@ contains
X2Log.Details.Registry in '..\X2Log.Details.Registry.pas',
X2Log.Util.Stream in '..\X2Log.Util.Stream.pas',
X2Log.Translations.Dutch in '..\X2Log.Translations.Dutch.pas',
- X2Log.Decorator in '..\X2Log.Decorator.pas';
+ X2Log.Decorator in '..\X2Log.Decorator.pas',
+ X2Log.Observer.RollingLogFile in '..\X2Log.Observer.RollingLogFile.pas';
end.
diff --git a/Packages/X2LogDXE2.dproj b/Packages/X2LogDXE2.dproj
index d8a66b3..8146f87 100644
--- a/Packages/X2LogDXE2.dproj
+++ b/Packages/X2LogDXE2.dproj
@@ -108,6 +108,7 @@
+
Base
diff --git a/Test/X2LogTest.dpr b/Test/X2LogTest.dpr
index 0b9d6f2..363a00a 100644
--- a/Test/X2LogTest.dpr
+++ b/Test/X2LogTest.dpr
@@ -23,7 +23,8 @@ uses
X2Log.Details.Registry in '..\X2Log.Details.Registry.pas',
X2Log.Details.Intf in '..\X2Log.Details.Intf.pas',
X2Log.Util.Stream in '..\X2Log.Util.Stream.pas',
- X2Log.Decorator in '..\X2Log.Decorator.pas';
+ X2Log.Decorator in '..\X2Log.Decorator.pas',
+ X2Log.Observer.RollingLogFile in '..\X2Log.Observer.RollingLogFile.pas';
{$R *.res}
diff --git a/Test/X2LogTest.dproj b/Test/X2LogTest.dproj
index c66fb7e..daf79fa 100644
--- a/Test/X2LogTest.dproj
+++ b/Test/X2LogTest.dproj
@@ -195,6 +195,7 @@
+
RCDATA
GraphicDetails
diff --git a/Test/source/MainFrm.dfm b/Test/source/MainFrm.dfm
index de36aee..57e616d 100644
--- a/Test/source/MainFrm.dfm
+++ b/Test/source/MainFrm.dfm
@@ -26,14 +26,12 @@ object MainForm: TMainForm
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
- ActivePage = tsNamedPipe
+ ActivePage = tsRollingFile
Align = alClient
Images = ilsObservers
TabOrder = 0
- ExplicitWidth = 595
object tsEvent: TTabSheet
Caption = 'Event'
- ExplicitWidth = 587
object mmoEvent: TMemo
AlignWithMargins = True
Left = 8
@@ -48,7 +46,6 @@ object MainForm: TMainForm
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 0
- ExplicitWidth = 571
end
object btnEventStart: TButton
Left = 8
@@ -71,7 +68,6 @@ object MainForm: TMainForm
end
object tsFile: TTabSheet
Caption = 'File'
- ExplicitWidth = 587
DesignSize = (
623
299)
@@ -122,7 +118,7 @@ object MainForm: TMainForm
object rbUserData: TRadioButton
Left = 88
Top = 111
- Width = 113
+ Width = 141
Height = 17
Caption = 'User Application Data'
TabOrder = 4
@@ -136,9 +132,89 @@ object MainForm: TMainForm
TabOrder = 5
end
end
+ object tsRollingFile: TTabSheet
+ Caption = 'Rolling File'
+ DesignSize = (
+ 623
+ 299)
+ object lblRollingFileName: TLabel
+ Left = 12
+ Top = 64
+ Width = 46
+ Height = 13
+ Caption = 'Filename:'
+ end
+ object lblRollingDays: TLabel
+ Left = 12
+ Top = 176
+ Width = 67
+ Height = 13
+ Caption = 'Days to keep:'
+ end
+ object btnRollingFileStart: TButton
+ Left = 8
+ Top = 8
+ Width = 75
+ Height = 25
+ Caption = 'Start'
+ TabOrder = 0
+ OnClick = btnRollingFileStartClick
+ end
+ object btnRollingFileStop: TButton
+ Left = 89
+ Top = 8
+ Width = 75
+ Height = 25
+ Caption = 'Stop'
+ TabOrder = 1
+ OnClick = btnRollingFileStopClick
+ end
+ object edtRollingFileName: TEdit
+ Left = 88
+ Top = 61
+ Width = 525
+ Height = 21
+ Anchors = [akLeft, akTop, akRight]
+ TabOrder = 2
+ Text = 'X2LogTest\Test.log'
+ end
+ object rbRollingProgramData: TRadioButton
+ Left = 88
+ Top = 88
+ Width = 113
+ Height = 17
+ Caption = 'Program Data'
+ Checked = True
+ TabOrder = 3
+ TabStop = True
+ end
+ object rbRollingUserData: TRadioButton
+ Left = 88
+ Top = 111
+ Width = 141
+ Height = 17
+ Caption = 'User Application Data'
+ TabOrder = 4
+ end
+ object rbRollingAbsolute: TRadioButton
+ Left = 88
+ Top = 134
+ Width = 113
+ Height = 17
+ Caption = 'Absolute path'
+ TabOrder = 5
+ end
+ object edtRollingDays: TEdit
+ Left = 88
+ Top = 173
+ Width = 61
+ Height = 21
+ TabOrder = 6
+ Text = '7'
+ end
+ end
object tsNamedPipe: TTabSheet
Caption = 'Named Pipe'
- ExplicitWidth = 587
DesignSize = (
623
299)
@@ -192,7 +268,6 @@ object MainForm: TMainForm
Caption = '&Refresh'
TabOrder = 3
OnClick = btnNamedPipeRefreshClick
- ExplicitLeft = 502
end
object lbNamedPipeServers: TListBox
Left = 8
@@ -202,7 +277,6 @@ object MainForm: TMainForm
Anchors = [akLeft, akTop, akRight, akBottom]
ItemHeight = 13
TabOrder = 4
- ExplicitWidth = 569
end
end
end
@@ -219,7 +293,6 @@ object MainForm: TMainForm
Align = alBottom
BevelOuter = bvNone
TabOrder = 1
- ExplicitWidth = 595
object btnClose: TButton
Left = 556
Top = 0
@@ -230,7 +303,6 @@ object MainForm: TMainForm
Caption = 'Close'
TabOrder = 1
OnClick = btnCloseClick
- ExplicitLeft = 520
end
object btnMonitorForm: TButton
Left = 0
@@ -289,10 +361,8 @@ object MainForm: TMainForm
ActivePage = tsTimer
Align = alTop
TabOrder = 2
- ExplicitWidth = 595
object tsText: TTabSheet
Caption = 'Text'
- ExplicitWidth = 587
DesignSize = (
623
76)
@@ -348,7 +418,6 @@ object MainForm: TMainForm
TabOrder = 4
Text = 'Hello world!'
OnKeyDown = edtMessageKeyDown
- ExplicitWidth = 477
end
object btnCategory: TButton
Left = 416
@@ -363,7 +432,6 @@ object MainForm: TMainForm
object tsException: TTabSheet
Caption = 'Exception'
ImageIndex = 1
- ExplicitWidth = 587
DesignSize = (
623
76)
@@ -392,13 +460,11 @@ object MainForm: TMainForm
TabOrder = 1
Text = 'Horrible things are happening.'
OnKeyDown = edtExceptionKeyDown
- ExplicitWidth = 477
end
end
object tsBinary: TTabSheet
Caption = 'Binary'
ImageIndex = 2
- ExplicitWidth = 587
object btnBinaryRawByteString: TButton
Left = 12
Top = 15
@@ -421,7 +487,6 @@ object MainForm: TMainForm
object tsTimer: TTabSheet
Caption = 'Timer'
ImageIndex = 3
- ExplicitWidth = 587
object lblTimer: TLabel
Left = 8
Top = 12
@@ -488,7 +553,6 @@ object MainForm: TMainForm
Font.Style = [fsBold]
ParentFont = False
TabOrder = 3
- ExplicitWidth = 595
object bvlDispatch: TBevel
Left = 80
Top = 12
@@ -518,7 +582,6 @@ object MainForm: TMainForm
Font.Style = [fsBold]
ParentFont = False
TabOrder = 4
- ExplicitWidth = 595
object bvlObservers: TBevel
Left = 80
Top = 12
@@ -533,7 +596,7 @@ object MainForm: TMainForm
Left = 552
Top = 176
Bitmap = {
- 494C01010200140054000C000C00FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
+ 494C01010200140058000C000C00FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000300000000C00000001002000000000000009
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
diff --git a/Test/source/MainFrm.pas b/Test/source/MainFrm.pas
index 47ac3c8..47994c8 100644
--- a/Test/source/MainFrm.pas
+++ b/Test/source/MainFrm.pas
@@ -69,6 +69,16 @@ type
btnTimerStart: TButton;
btnTimerStop: TButton;
Timer: TTimer;
+ tsRollingFile: TTabSheet;
+ lblRollingFileName: TLabel;
+ btnRollingFileStart: TButton;
+ btnRollingFileStop: TButton;
+ edtRollingFileName: TEdit;
+ rbRollingProgramData: TRadioButton;
+ rbRollingUserData: TRadioButton;
+ rbRollingAbsolute: TRadioButton;
+ lblRollingDays: TLabel;
+ edtRollingDays: TEdit;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
@@ -93,10 +103,13 @@ type
procedure btnTimerStartClick(Sender: TObject);
procedure btnTimerStopClick(Sender: TObject);
procedure TimerTimer(Sender: TObject);
+ procedure btnRollingFileStartClick(Sender: TObject);
+ procedure btnRollingFileStopClick(Sender: TObject);
private
FLog: IX2Log;
FEventObserver: IX2LogObserver;
FFileObserver: IX2LogObserver;
+ FRollingFileObserver: IX2LogObserver;
FNamedPipeObserver: IX2LogObserver;
protected
procedure DoLog(Sender: TObject; Level: TX2LogLevel; DateTime: TDateTime; const Msg, Category: string; Details: IX2LogDetails);
@@ -119,6 +132,7 @@ uses
X2Log.Observer.LogFile,
X2Log.Observer.MonitorForm,
X2Log.Observer.NamedPipe,
+ X2Log.Observer.RollingLogFile,
X2Log.Global;
@@ -334,6 +348,41 @@ begin
end;
+procedure TMainForm.btnRollingFileStartClick(Sender: TObject);
+var
+ days: Integer;
+
+begin
+ if not Assigned(FRollingFileObserver) then
+ begin
+ days := StrToIntDef(edtRollingDays.Text, 7);
+
+ if rbRollingProgramData.Checked then
+ FRollingFileObserver := TX2RollingLogFileObserver.CreateInProgramData(edtFilename.Text, days)
+ else if rbRollingUserData.Checked then
+ FRollingFileObserver := TX2RollingLogFileObserver.CreateInUserAppData(edtFilename.Text, days)
+ else
+ FRollingFileObserver := TX2RollingLogFileObserver.Create(edtFilename.Text, days);
+
+ FLog.Attach(FRollingFileObserver);
+
+ tsRollingFile.ImageIndex := 1;
+ end;
+end;
+
+
+procedure TMainForm.btnRollingFileStopClick(Sender: TObject);
+begin
+ if Assigned(FRollingFileObserver) then
+ begin
+ FLog.Detach(FRollingFileObserver);
+ FRollingFileObserver := nil;
+
+ tsRollingFile.ImageIndex := 0;
+ end;
+end;
+
+
procedure TMainForm.btnNamedPipeStartClick(Sender: TObject);
begin
if not Assigned(FNamedPipeObserver) then
diff --git a/X2Log.Constants.pas b/X2Log.Constants.pas
index cf30473..0e64794 100644
--- a/X2Log.Constants.pas
+++ b/X2Log.Constants.pas
@@ -49,6 +49,15 @@ resourcestring
LogFileLineDetails = '%0:s (details: %1:s)';
+ {
+ X2Log.Observer.RollingLogFile
+ }
+
+ { Date format used in the rolling log file's file name }
+ RollingLogFileDateFormat = 'yyyy.mm.dd';
+
+
+
{
X2Log.Observer.MonitorForm
}
diff --git a/X2Log.Observer.LogFile.pas b/X2Log.Observer.LogFile.pas
index 58672dc..cbc1cbe 100644
--- a/X2Log.Observer.LogFile.pas
+++ b/X2Log.Observer.LogFile.pas
@@ -17,6 +17,8 @@ type
FFileName: string;
protected
function CreateWorkerThread: TX2LogObserverWorkerThread; override;
+
+ property FileName: string read FFileName;
public
constructor Create(const AFileName: string; ALogLevels: TX2LogLevels = X2LogLevelsDefault);
constructor CreateInProgramData(const AFileName: string; ALogLevels: TX2LogLevels = X2LogLevelsDefault);
@@ -24,6 +26,19 @@ type
end;
+ TX2LogFileWorkerThread = class(TX2LogObserverWorkerThread)
+ private
+ FFileName: string;
+ protected
+ function GetFileName: string; virtual;
+ procedure ProcessEntry(AEntry: TX2LogQueueEntry); override;
+
+ property FileName: string read GetFileName;
+ public
+ constructor Create(const AFileName: string);
+ end;
+
+
implementation
uses
System.IOUtils,
@@ -35,19 +50,6 @@ uses
X2Log.Constants;
-type
- TX2LogFileWorkerThread = class(TX2LogObserverWorkerThread)
- private
- FFileName: string;
- protected
- procedure ProcessEntry(AEntry: TX2LogQueueEntry); override;
-
- property FileName: string read FFileName;
- public
- constructor Create(const AFileName: string);
- end;
-
-
{ TX2LogFileObserver }
constructor TX2LogFileObserver.Create(const AFileName: string; ALogLevels: TX2LogLevels);
@@ -90,7 +92,7 @@ end;
function TX2LogFileObserver.CreateWorkerThread: TX2LogObserverWorkerThread;
begin
- Result := TX2LogFileWorkerThread.Create(FFileName);
+ Result := TX2LogFileWorkerThread.Create(FileName);
end;
@@ -181,4 +183,10 @@ begin
end;
end;
+
+function TX2LogFileWorkerThread.GetFileName: string;
+begin
+ Result := FFileName;
+end;
+
end.
diff --git a/X2Log.Observer.RollingLogFile.pas b/X2Log.Observer.RollingLogFile.pas
new file mode 100644
index 0000000..edaf622
--- /dev/null
+++ b/X2Log.Observer.RollingLogFile.pas
@@ -0,0 +1,162 @@
+unit X2Log.Observer.RollingLogFile;
+
+interface
+uses
+ System.SysUtils,
+
+ X2Log.Intf,
+ X2Log.Observer.CustomThreaded,
+ X2Log.Observer.LogFile;
+
+
+const
+ X2LogDefaultDays = 5;
+
+
+type
+ TX2RollingLogFileObserver = class(TX2LogFileObserver)
+ private
+ FDays: Integer;
+ protected
+ function CreateWorkerThread: TX2LogObserverWorkerThread; override;
+
+ property Days: Integer read FDays;
+ public
+ constructor Create(const AFileName: string; ADays: Integer = X2LogDefaultDays; ALogLevels: TX2LogLevels = X2LogLevelsDefault);
+ constructor CreateInProgramData(const AFileName: string; ADays: Integer = X2LogDefaultDays; ALogLevels: TX2LogLevels = X2LogLevelsDefault);
+ constructor CreateInUserAppData(const AFileName: string; ADays: Integer = X2LogDefaultDays; ALogLevels: TX2LogLevels = X2LogLevelsDefault);
+ end;
+
+
+ TX2RollingLogFileWorkerThread = class(TX2LogFileWorkerThread)
+ private
+ FDays: Integer;
+ FLastCleanupDate: TDateTime;
+ FFormatSettings: TFormatSettings;
+ FDateFormat: string;
+ protected
+ function GetFileName: string; override;
+ function GetDateFileName(ADate: TDateTime): string;
+
+ procedure ProcessEntry(AEntry: TX2LogQueueEntry); override;
+ procedure CleanupLogFiles; virtual;
+
+ property Days: Integer read FDays;
+ property LastCleanupDate: TDateTime read FLastCleanupDate write FLastCleanupDate;
+ public
+ constructor Create(const AFileName: string; ADays: Integer);
+ end;
+
+
+implementation
+uses
+ System.DateUtils,
+ System.IOUtils,
+ System.StrUtils,
+ System.Types,
+
+ X2Log.Constants;
+
+
+{ TX2RollingLogFileObserver }
+constructor TX2RollingLogFileObserver.Create(const AFileName: string; ADays: Integer; ALogLevels: TX2LogLevels);
+begin
+ FDays := ADays;
+
+ inherited Create(AFileName, ALogLevels);
+end;
+
+
+constructor TX2RollingLogFileObserver.CreateInProgramData(const AFileName: string; ADays: Integer; ALogLevels: TX2LogLevels);
+begin
+ FDays := ADays;
+
+ inherited CreateInProgramData(AFileName, ALogLevels);
+end;
+
+
+constructor TX2RollingLogFileObserver.CreateInUserAppData(const AFileName: string; ADays: Integer; ALogLevels: TX2LogLevels);
+begin
+ FDays := ADays;
+
+ inherited CreateInUserAppData(AFileName, ALogLevels);
+end;
+
+
+function TX2RollingLogFileObserver.CreateWorkerThread: TX2LogObserverWorkerThread;
+begin
+ Result := TX2RollingLogFileWorkerThread.Create(FileName, Days);
+end;
+
+
+{ TX2RollingLogFileWorkerThread }
+constructor TX2RollingLogFileWorkerThread.Create(const AFileName: string; ADays: Integer);
+begin
+ FDays := ADays;
+ FFormatSettings := TFormatSettings.Create;
+ FDateFormat := GetLogResourceString(@RollingLogFileDateFormat);
+
+ inherited Create(AFileName);
+end;
+
+
+function TX2RollingLogFileWorkerThread.GetFileName: string;
+begin
+ Result := GetDateFileName(Date);
+end;
+
+
+function TX2RollingLogFileWorkerThread.GetDateFileName(ADate: TDateTime): string;
+var
+ baseFileName: string;
+
+begin
+ baseFileName := inherited GetFileName;
+ Result := ChangeFileExt(baseFileName, '') + '.' +
+ FormatDateTime(FDateFormat, ADate, FFormatSettings) +
+ ExtractFileExt(baseFileName);
+end;
+
+
+procedure TX2RollingLogFileWorkerThread.ProcessEntry(AEntry: TX2LogQueueEntry);
+begin
+ if not SameDate(Date, LastCleanupDate) then
+ begin
+ CleanupLogFiles;
+ LastCleanupDate := Date;
+ end;
+
+ inherited ProcessEntry(AEntry);
+end;
+
+
+procedure TX2RollingLogFileWorkerThread.CleanupLogFiles;
+var
+ baseFileName: string;
+ fileMask: string;
+ validFileNames: TStringDynArray;
+ day: Integer;
+ filePath: string;
+ fileName: string;
+
+begin
+ baseFileName := inherited GetFileName;
+ fileMask := ChangeFileExt(ExtractFileName(baseFileName), '') + '.*' +
+ ExtractFileExt(baseFileName);
+
+ { The date format can be customized, so instead of parsing back the file
+ names, use a whitelist }
+ SetLength(validFileNames, Days);
+ for day := 0 to Pred(Days) do
+ validFileNames[day] := ExtractFileName(GetDateFileName(IncDay(Date, -day)));
+
+ for filePath in TDirectory.GetFiles(ExtractFilePath(baseFileName), fileMask) do
+ begin
+ fileName := ExtractFileName(filePath);
+
+ if IndexText(fileName, validFileNames) = -1 then
+ DeleteFile(filePath);
+ end;
+end;
+
+end.