1
0
mirror of synced 2024-11-09 14:49:15 +00:00

Added: RollingLogFile Observer

This commit is contained in:
Mark van Renswoude 2015-03-06 11:51:59 +00:00
parent 8ff6795d13
commit a901a2d0b6
9 changed files with 332 additions and 37 deletions

View File

@ -51,7 +51,8 @@ contains
X2Log.Details.Registry in '..\X2Log.Details.Registry.pas', X2Log.Details.Registry in '..\X2Log.Details.Registry.pas',
X2Log.Util.Stream in '..\X2Log.Util.Stream.pas', X2Log.Util.Stream in '..\X2Log.Util.Stream.pas',
X2Log.Translations.Dutch in '..\X2Log.Translations.Dutch.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. end.

View File

@ -108,6 +108,7 @@
<DCCReference Include="..\X2Log.Util.Stream.pas"/> <DCCReference Include="..\X2Log.Util.Stream.pas"/>
<DCCReference Include="..\X2Log.Translations.Dutch.pas"/> <DCCReference Include="..\X2Log.Translations.Dutch.pas"/>
<DCCReference Include="..\X2Log.Decorator.pas"/> <DCCReference Include="..\X2Log.Decorator.pas"/>
<DCCReference Include="..\X2Log.Observer.RollingLogFile.pas"/>
<BuildConfiguration Include="Base"> <BuildConfiguration Include="Base">
<Key>Base</Key> <Key>Base</Key>
</BuildConfiguration> </BuildConfiguration>

View File

@ -23,7 +23,8 @@ uses
X2Log.Details.Registry in '..\X2Log.Details.Registry.pas', X2Log.Details.Registry in '..\X2Log.Details.Registry.pas',
X2Log.Details.Intf in '..\X2Log.Details.Intf.pas', X2Log.Details.Intf in '..\X2Log.Details.Intf.pas',
X2Log.Util.Stream in '..\X2Log.Util.Stream.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} {$R *.res}

View File

@ -195,6 +195,7 @@
<DCCReference Include="..\X2Log.Details.Intf.pas"/> <DCCReference Include="..\X2Log.Details.Intf.pas"/>
<DCCReference Include="..\X2Log.Util.Stream.pas"/> <DCCReference Include="..\X2Log.Util.Stream.pas"/>
<DCCReference Include="..\X2Log.Decorator.pas"/> <DCCReference Include="..\X2Log.Decorator.pas"/>
<DCCReference Include="..\X2Log.Observer.RollingLogFile.pas"/>
<RcItem Include="resources\Graphic.jpg"> <RcItem Include="resources\Graphic.jpg">
<ResourceType>RCDATA</ResourceType> <ResourceType>RCDATA</ResourceType>
<ResourceId>GraphicDetails</ResourceId> <ResourceId>GraphicDetails</ResourceId>

View File

@ -26,14 +26,12 @@ object MainForm: TMainForm
Margins.Top = 8 Margins.Top = 8
Margins.Right = 8 Margins.Right = 8
Margins.Bottom = 8 Margins.Bottom = 8
ActivePage = tsNamedPipe ActivePage = tsRollingFile
Align = alClient Align = alClient
Images = ilsObservers Images = ilsObservers
TabOrder = 0 TabOrder = 0
ExplicitWidth = 595
object tsEvent: TTabSheet object tsEvent: TTabSheet
Caption = 'Event' Caption = 'Event'
ExplicitWidth = 587
object mmoEvent: TMemo object mmoEvent: TMemo
AlignWithMargins = True AlignWithMargins = True
Left = 8 Left = 8
@ -48,7 +46,6 @@ object MainForm: TMainForm
ReadOnly = True ReadOnly = True
ScrollBars = ssVertical ScrollBars = ssVertical
TabOrder = 0 TabOrder = 0
ExplicitWidth = 571
end end
object btnEventStart: TButton object btnEventStart: TButton
Left = 8 Left = 8
@ -71,7 +68,6 @@ object MainForm: TMainForm
end end
object tsFile: TTabSheet object tsFile: TTabSheet
Caption = 'File' Caption = 'File'
ExplicitWidth = 587
DesignSize = ( DesignSize = (
623 623
299) 299)
@ -122,7 +118,7 @@ object MainForm: TMainForm
object rbUserData: TRadioButton object rbUserData: TRadioButton
Left = 88 Left = 88
Top = 111 Top = 111
Width = 113 Width = 141
Height = 17 Height = 17
Caption = 'User Application Data' Caption = 'User Application Data'
TabOrder = 4 TabOrder = 4
@ -136,9 +132,89 @@ object MainForm: TMainForm
TabOrder = 5 TabOrder = 5
end end
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 object tsNamedPipe: TTabSheet
Caption = 'Named Pipe' Caption = 'Named Pipe'
ExplicitWidth = 587
DesignSize = ( DesignSize = (
623 623
299) 299)
@ -192,7 +268,6 @@ object MainForm: TMainForm
Caption = '&Refresh' Caption = '&Refresh'
TabOrder = 3 TabOrder = 3
OnClick = btnNamedPipeRefreshClick OnClick = btnNamedPipeRefreshClick
ExplicitLeft = 502
end end
object lbNamedPipeServers: TListBox object lbNamedPipeServers: TListBox
Left = 8 Left = 8
@ -202,7 +277,6 @@ object MainForm: TMainForm
Anchors = [akLeft, akTop, akRight, akBottom] Anchors = [akLeft, akTop, akRight, akBottom]
ItemHeight = 13 ItemHeight = 13
TabOrder = 4 TabOrder = 4
ExplicitWidth = 569
end end
end end
end end
@ -219,7 +293,6 @@ object MainForm: TMainForm
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 1 TabOrder = 1
ExplicitWidth = 595
object btnClose: TButton object btnClose: TButton
Left = 556 Left = 556
Top = 0 Top = 0
@ -230,7 +303,6 @@ object MainForm: TMainForm
Caption = 'Close' Caption = 'Close'
TabOrder = 1 TabOrder = 1
OnClick = btnCloseClick OnClick = btnCloseClick
ExplicitLeft = 520
end end
object btnMonitorForm: TButton object btnMonitorForm: TButton
Left = 0 Left = 0
@ -289,10 +361,8 @@ object MainForm: TMainForm
ActivePage = tsTimer ActivePage = tsTimer
Align = alTop Align = alTop
TabOrder = 2 TabOrder = 2
ExplicitWidth = 595
object tsText: TTabSheet object tsText: TTabSheet
Caption = 'Text' Caption = 'Text'
ExplicitWidth = 587
DesignSize = ( DesignSize = (
623 623
76) 76)
@ -348,7 +418,6 @@ object MainForm: TMainForm
TabOrder = 4 TabOrder = 4
Text = 'Hello world!' Text = 'Hello world!'
OnKeyDown = edtMessageKeyDown OnKeyDown = edtMessageKeyDown
ExplicitWidth = 477
end end
object btnCategory: TButton object btnCategory: TButton
Left = 416 Left = 416
@ -363,7 +432,6 @@ object MainForm: TMainForm
object tsException: TTabSheet object tsException: TTabSheet
Caption = 'Exception' Caption = 'Exception'
ImageIndex = 1 ImageIndex = 1
ExplicitWidth = 587
DesignSize = ( DesignSize = (
623 623
76) 76)
@ -392,13 +460,11 @@ object MainForm: TMainForm
TabOrder = 1 TabOrder = 1
Text = 'Horrible things are happening.' Text = 'Horrible things are happening.'
OnKeyDown = edtExceptionKeyDown OnKeyDown = edtExceptionKeyDown
ExplicitWidth = 477
end end
end end
object tsBinary: TTabSheet object tsBinary: TTabSheet
Caption = 'Binary' Caption = 'Binary'
ImageIndex = 2 ImageIndex = 2
ExplicitWidth = 587
object btnBinaryRawByteString: TButton object btnBinaryRawByteString: TButton
Left = 12 Left = 12
Top = 15 Top = 15
@ -421,7 +487,6 @@ object MainForm: TMainForm
object tsTimer: TTabSheet object tsTimer: TTabSheet
Caption = 'Timer' Caption = 'Timer'
ImageIndex = 3 ImageIndex = 3
ExplicitWidth = 587
object lblTimer: TLabel object lblTimer: TLabel
Left = 8 Left = 8
Top = 12 Top = 12
@ -488,7 +553,6 @@ object MainForm: TMainForm
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
TabOrder = 3 TabOrder = 3
ExplicitWidth = 595
object bvlDispatch: TBevel object bvlDispatch: TBevel
Left = 80 Left = 80
Top = 12 Top = 12
@ -518,7 +582,6 @@ object MainForm: TMainForm
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
TabOrder = 4 TabOrder = 4
ExplicitWidth = 595
object bvlObservers: TBevel object bvlObservers: TBevel
Left = 80 Left = 80
Top = 12 Top = 12
@ -533,7 +596,7 @@ object MainForm: TMainForm
Left = 552 Left = 552
Top = 176 Top = 176
Bitmap = { Bitmap = {
494C01010200140054000C000C00FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 494C01010200140058000C000C00FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000300000000C00000001002000000000000009 0000000000003600000028000000300000000C00000001002000000000000009
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000

View File

@ -69,6 +69,16 @@ type
btnTimerStart: TButton; btnTimerStart: TButton;
btnTimerStop: TButton; btnTimerStop: TButton;
Timer: TTimer; 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 FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
@ -93,10 +103,13 @@ type
procedure btnTimerStartClick(Sender: TObject); procedure btnTimerStartClick(Sender: TObject);
procedure btnTimerStopClick(Sender: TObject); procedure btnTimerStopClick(Sender: TObject);
procedure TimerTimer(Sender: TObject); procedure TimerTimer(Sender: TObject);
procedure btnRollingFileStartClick(Sender: TObject);
procedure btnRollingFileStopClick(Sender: TObject);
private private
FLog: IX2Log; FLog: IX2Log;
FEventObserver: IX2LogObserver; FEventObserver: IX2LogObserver;
FFileObserver: IX2LogObserver; FFileObserver: IX2LogObserver;
FRollingFileObserver: IX2LogObserver;
FNamedPipeObserver: IX2LogObserver; FNamedPipeObserver: IX2LogObserver;
protected protected
procedure DoLog(Sender: TObject; Level: TX2LogLevel; DateTime: TDateTime; const Msg, Category: string; Details: IX2LogDetails); procedure DoLog(Sender: TObject; Level: TX2LogLevel; DateTime: TDateTime; const Msg, Category: string; Details: IX2LogDetails);
@ -119,6 +132,7 @@ uses
X2Log.Observer.LogFile, X2Log.Observer.LogFile,
X2Log.Observer.MonitorForm, X2Log.Observer.MonitorForm,
X2Log.Observer.NamedPipe, X2Log.Observer.NamedPipe,
X2Log.Observer.RollingLogFile,
X2Log.Global; X2Log.Global;
@ -334,6 +348,41 @@ begin
end; 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); procedure TMainForm.btnNamedPipeStartClick(Sender: TObject);
begin begin
if not Assigned(FNamedPipeObserver) then if not Assigned(FNamedPipeObserver) then

View File

@ -49,6 +49,15 @@ resourcestring
LogFileLineDetails = '%0:s (details: %1:s)'; 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 X2Log.Observer.MonitorForm
} }

View File

@ -17,6 +17,8 @@ type
FFileName: string; FFileName: string;
protected protected
function CreateWorkerThread: TX2LogObserverWorkerThread; override; function CreateWorkerThread: TX2LogObserverWorkerThread; override;
property FileName: string read FFileName;
public public
constructor Create(const AFileName: string; ALogLevels: TX2LogLevels = X2LogLevelsDefault); constructor Create(const AFileName: string; ALogLevels: TX2LogLevels = X2LogLevelsDefault);
constructor CreateInProgramData(const AFileName: string; ALogLevels: TX2LogLevels = X2LogLevelsDefault); constructor CreateInProgramData(const AFileName: string; ALogLevels: TX2LogLevels = X2LogLevelsDefault);
@ -24,6 +26,19 @@ type
end; 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 implementation
uses uses
System.IOUtils, System.IOUtils,
@ -35,19 +50,6 @@ uses
X2Log.Constants; 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 } { TX2LogFileObserver }
constructor TX2LogFileObserver.Create(const AFileName: string; ALogLevels: TX2LogLevels); constructor TX2LogFileObserver.Create(const AFileName: string; ALogLevels: TX2LogLevels);
@ -90,7 +92,7 @@ end;
function TX2LogFileObserver.CreateWorkerThread: TX2LogObserverWorkerThread; function TX2LogFileObserver.CreateWorkerThread: TX2LogObserverWorkerThread;
begin begin
Result := TX2LogFileWorkerThread.Create(FFileName); Result := TX2LogFileWorkerThread.Create(FileName);
end; end;
@ -181,4 +183,10 @@ begin
end; end;
end; end;
function TX2LogFileWorkerThread.GetFileName: string;
begin
Result := FFileName;
end;
end. end.

View File

@ -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.