GitHub-Mirror/x2log
1
0
Fork 0
mirror of synced 2024-11-23 20:03:50 +00:00
Code Issues Projects Releases Wiki Activity

Added: RollingLogFile Observer

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Packages/X2LogDXE2.dpk
View File

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

1
Packages/X2LogDXE2.dproj
View File

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

3
Test/X2LogTest.dpr
View File

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

1
Test/X2LogTest.dproj
View File

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

105
Test/source/MainFrm.dfm
View File

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

49
Test/source/MainFrm.pas
View File

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

9
X2Log.Constants.pas
View File

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

36
X2Log.Observer.LogFile.pas
View File

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

162
X2Log.Observer.RollingLogFile.pas Normal file
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.