From a901a2d0b6418f2cc36bb21c227704a3b70067c5 Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Fri, 6 Mar 2015 11:51:59 +0000 Subject: [PATCH] Added: RollingLogFile Observer --- Packages/X2LogDXE2.dpk | 3 +- Packages/X2LogDXE2.dproj | 1 + Test/X2LogTest.dpr | 3 +- Test/X2LogTest.dproj | 1 + Test/source/MainFrm.dfm | 105 +++++++++++++++---- Test/source/MainFrm.pas | 49 +++++++++ X2Log.Constants.pas | 9 ++ X2Log.Observer.LogFile.pas | 36 ++++--- X2Log.Observer.RollingLogFile.pas | 162 ++++++++++++++++++++++++++++++ 9 files changed, 332 insertions(+), 37 deletions(-) create mode 100644 X2Log.Observer.RollingLogFile.pas 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.