1
0
mirror of synced 2024-12-17 23:13:08 +01:00

Added: support for binary details

Added: Save button for Monitor Form
This commit is contained in:
Mark van Renswoude 2014-05-30 12:51:01 +00:00
parent c07852bfa3
commit 6d5355e0b6
22 changed files with 559 additions and 125 deletions

View File

@ -30,7 +30,8 @@ package X2LogDXE2;
{$IMPLICITBUILD ON}
requires
rtl;
rtl,
vcl;
contains
X2Log.Client.Base in '..\X2Log.Client.Base.pas',
@ -44,7 +45,8 @@ contains
X2Log.Observer.Event in '..\X2Log.Observer.Event.pas',
X2Log.Observer.LogFile in '..\X2Log.Observer.LogFile.pas',
X2Log.Observer.NamedPipe in '..\X2Log.Observer.NamedPipe.pas',
X2Log in '..\X2Log.pas';
X2Log in '..\X2Log.pas',
X2Log.Details.Default in '..\X2Log.Details.Default.pas';
end.

View File

@ -78,6 +78,7 @@
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="rtl.dcp"/>
<DCCReference Include="vcl.dcp"/>
<DCCReference Include="..\X2Log.Client.Base.pas"/>
<DCCReference Include="..\X2Log.Client.NamedPipe.pas"/>
<DCCReference Include="..\X2Log.Constants.pas"/>
@ -90,6 +91,7 @@
<DCCReference Include="..\X2Log.Observer.LogFile.pas"/>
<DCCReference Include="..\X2Log.Observer.NamedPipe.pas"/>
<DCCReference Include="..\X2Log.pas"/>
<DCCReference Include="..\X2Log.Details.Default.pas"/>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>

View File

@ -1,11 +1,6 @@
program X2LogTest;
uses
madExcept,
madLinkDisAsm,
madListHardware,
madListProcesses,
madListModules,
Forms,
MainFrm in 'source\MainFrm.pas' {MainForm},
X2Log.Intf in '..\X2Log.Intf.pas',
@ -22,7 +17,7 @@ uses
X2Log.Global in '..\X2Log.Global.pas',
X2Log.Client.NamedPipe in '..\X2Log.Client.NamedPipe.pas',
X2Log.Client.Base in '..\X2Log.Client.Base.pas',
X2Log.Registry.NamedPipe in '..\X2Log.Registry.NamedPipe.pas';
X2Log.Details.Default in '..\X2Log.Details.Default.pas';
{$R *.res}

View File

@ -84,7 +84,6 @@
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<DCC_Define>madExcept;$(DCC_Define)</DCC_Define>
<DCC_MapFile>3</DCC_MapFile>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
@ -192,7 +191,7 @@
<DCCReference Include="..\X2Log.Global.pas"/>
<DCCReference Include="..\X2Log.Client.NamedPipe.pas"/>
<DCCReference Include="..\X2Log.Client.Base.pas"/>
<DCCReference Include="..\X2Log.Registry.NamedPipe.pas"/>
<DCCReference Include="..\X2Log.Details.Default.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>

View File

@ -2,7 +2,7 @@ object MainForm: TMainForm
Left = 0
Top = 0
Caption = 'X'#178'Log Test'
ClientHeight = 515
ClientHeight = 544
ClientWidth = 611
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
@ -21,27 +21,25 @@ object MainForm: TMainForm
Left = 8
Top = 169
Width = 595
Height = 305
Height = 334
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
ActivePage = tsFile
ActivePage = tsEvent
Align = alClient
Images = ilsObservers
TabOrder = 0
ExplicitHeight = 305
object tsEvent: TTabSheet
Caption = 'Event Observer '
ExplicitLeft = 0
ExplicitTop = 0
ExplicitWidth = 0
ExplicitHeight = 0
ExplicitHeight = 277
object mmoEvent: TMemo
AlignWithMargins = True
Left = 8
Top = 40
Width = 571
Height = 229
Height = 258
Margins.Left = 8
Margins.Top = 40
Margins.Right = 8
@ -50,7 +48,7 @@ object MainForm: TMainForm
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 0
ExplicitTop = 41
ExplicitHeight = 229
end
object btnEventStart: TButton
Left = 8
@ -73,6 +71,7 @@ object MainForm: TMainForm
end
object tsFile: TTabSheet
Caption = 'File Observer'
ExplicitHeight = 277
object lblFilename: TLabel
Left = 12
Top = 64
@ -135,10 +134,7 @@ object MainForm: TMainForm
end
object tsNamedPipe: TTabSheet
Caption = 'Named Pipe Observer'
ExplicitLeft = 0
ExplicitTop = 30
ExplicitWidth = 0
ExplicitHeight = 0
ExplicitHeight = 277
object lblPipeName: TLabel
Left = 12
Top = 64
@ -177,7 +173,7 @@ object MainForm: TMainForm
object pnlButtons: TPanel
AlignWithMargins = True
Left = 8
Top = 482
Top = 511
Width = 595
Height = 25
Margins.Left = 8
@ -187,6 +183,7 @@ object MainForm: TMainForm
Align = alBottom
BevelOuter = bvNone
TabOrder = 1
ExplicitTop = 482
object btnClose: TButton
Left = 520
Top = 0
@ -210,7 +207,7 @@ object MainForm: TMainForm
OnClick = btnMonitorFormClick
end
end
object GroupBox1: TGroupBox
object gbDispatch: TGroupBox
AlignWithMargins = True
Left = 8
Top = 8
@ -255,7 +252,6 @@ object MainForm: TMainForm
Top = 56
Width = 75
Height = 21
Anchors = [akLeft, akTop, akRight]
Caption = 'Verbose'
TabOrder = 1
OnClick = btnLogClick
@ -266,7 +262,7 @@ object MainForm: TMainForm
Width = 402
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 2
TabOrder = 6
Text = 'Horrible things are happening.'
OnKeyDown = edtExceptionKeyDown
end
@ -275,9 +271,8 @@ object MainForm: TMainForm
Top = 123
Width = 75
Height = 21
Anchors = [akLeft, akTop, akRight]
Caption = '&Send'
TabOrder = 3
TabOrder = 7
OnClick = btnExceptionClick
end
object btnInfo: TButton
@ -285,9 +280,8 @@ object MainForm: TMainForm
Top = 56
Width = 75
Height = 21
Anchors = [akLeft, akTop, akRight]
Caption = 'Info'
TabOrder = 4
TabOrder = 2
OnClick = btnLogClick
end
object btnWarning: TButton
@ -295,9 +289,8 @@ object MainForm: TMainForm
Top = 56
Width = 75
Height = 21
Anchors = [akLeft, akTop, akRight]
Caption = 'Warning'
TabOrder = 5
TabOrder = 3
OnClick = btnLogClick
end
object btnError: TButton
@ -305,9 +298,17 @@ object MainForm: TMainForm
Top = 56
Width = 75
Height = 21
Anchors = [akLeft, akTop, akRight]
Caption = 'Error'
TabOrder = 6
TabOrder = 4
OnClick = btnLogClick
end
object btnBinary: TButton
Left = 432
Top = 56
Width = 62
Height = 21
Caption = 'Binary'
TabOrder = 5
OnClick = btnLogClick
end
end
@ -317,7 +318,7 @@ object MainForm: TMainForm
Left = 552
Top = 176
Bitmap = {
494C01010200140024000C000C00FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
494C01010200140028000C000C00FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000300000000C00000001002000000000000009
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000

View File

@ -17,7 +17,7 @@ type
btnClose: TButton;
btnVerbose: TButton;
edtMessage: TEdit;
GroupBox1: TGroupBox;
gbDispatch: TGroupBox;
lblMessage: TLabel;
mmoEvent: TMemo;
pcObservers: TPageControl;
@ -46,6 +46,7 @@ type
rbAbsolute: TRadioButton;
edtPipeName: TEdit;
lblPipeName: TLabel;
btnBinary: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
@ -67,7 +68,7 @@ type
FFileObserver: IX2LogObserver;
FNamedPipeObserver: IX2LogObserver;
protected
procedure DoLog(Sender: TObject; Level: TX2LogLevel; const Msg, Details: string);
procedure DoLog(Sender: TObject; Level: TX2LogLevel; const Msg: string; Details: IX2LogDetails);
end;
@ -78,6 +79,7 @@ uses
X2Log,
X2Log.Constants,
X2Log.Details.Default,
X2Log.Exception.madExcept,
X2Log.Observer.Event,
X2Log.Observer.LogFile,
@ -118,9 +120,18 @@ begin
end;
procedure TMainForm.DoLog(Sender: TObject; Level: TX2LogLevel; const Msg, Details: string);
procedure TMainForm.DoLog(Sender: TObject; Level: TX2LogLevel; const Msg: string; Details: IX2LogDetails);
var
text: string;
logDetailsText: IX2LogDetailsText;
begin
mmoEvent.Lines.Add(GetLogLevelText(Level) + ': ' + Msg + ' (' + Details + ')');
text := GetLogLevelText(Level) + ': ' + Msg;
if Supports(Details, IX2LogDetailsText, logDetailsText) then
text := text + ' (' + logDetailsText.AsString + ')';
mmoEvent.Lines.Add(text);
end;
@ -158,7 +169,9 @@ begin
else if Sender = btnWarning then
FLog.Warning(edtMessage.Text)
else if Sender = btnError then
FLog.Error(edtMessage.Text);
FLog.Error(edtMessage.Text)
else if Sender = btnBinary then
FLog.InfoEx(edtMessage.Text, TX2LogBinaryDetails.Create(#0#1#2#3'Test'#12'Some more data'));
end;

View File

@ -9,7 +9,7 @@ uses
type
TX2LogBaseClient = class(TInterfacedPersistent, IX2LogObservable)
TX2LogBaseClient = class(TInterfacedPersistent, IX2LogBase, IX2LogObservable)
private
FObservers: TList<IX2LogObserver>;
protected
@ -19,7 +19,8 @@ type
destructor Destroy; override;
{ IX2LogBase }
procedure Log(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string = ''); virtual;
procedure Log(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails = nil); virtual;
{ IX2LogObservable }
procedure Attach(AObserver: IX2LogObserver);
@ -63,7 +64,7 @@ begin
end;
procedure TX2LogBaseClient.Log(ALevel: TX2LogLevel; const AMessage, ADetails: string);
procedure TX2LogBaseClient.Log(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails);
var
observer: IX2LogObserver;

View File

@ -24,8 +24,9 @@ implementation
uses
System.SyncObjs,
System.SysUtils,
Winapi.Windows,
Winapi.Windows;
X2Log.Details.Default;
type
@ -290,7 +291,8 @@ begin
msg := ReadString;
details := ReadString;
Log.Log(header.Level, msg, details);
// #ToDo1 named pipe support for non-string details
Log.Log(header.Level, msg, TX2LogStringDetails.CreateIfNotEmpty(details));
except
on E:EReadError do
ClosePipe;

View File

@ -46,6 +46,8 @@ resourcestring
{ Status messages }
LogMonitorFormStatusPaused = 'Paused: %d log message(s) skipped';
LogMonitorFormSaveDetailsFilter = 'All files (*.*)|*.*';
function GetLogLevelText(ALogLevel: TX2LogLevel): string;

139
X2Log.Details.Default.pas Normal file
View File

@ -0,0 +1,139 @@
unit X2Log.Details.Default;
interface
uses
System.Classes,
X2Log.Intf;
type
TX2LogStringDetails = class(TInterfacedObject, IX2LogDetails, IX2LogDetailsText,
IX2LogDetailsCopyable, IX2LogDetailsStreamable)
private
FText: string;
public
class function CreateIfNotEmpty(const AText: string): TX2LogStringDetails;
constructor Create(const AText: string);
{ IX2LogDetailsText }
function GetAsString: string;
{ IX2LogDetailsCopyable }
procedure CopyToClipboard;
{ IX2LogDetailsStreamable }
procedure SaveToStream(AStream: TStream);
end;
TX2LogBinaryDetails = class(TInterfacedObject, IX2LogDetails, IX2LogDetailsBinary,
IX2LogDetailsStreamable)
private
FData: TStream;
protected
property Data: TStream read FData;
public
constructor Create(ACopyFrom: TStream); overload;
constructor Create(AData: RawByteString); overload;
destructor Destroy; override;
{ IX2LogDetailsBinary }
function GetAsStream: TStream;
{ IX2LogDetailsStreamable }
procedure SaveToStream(AStream: TStream);
end;
implementation
uses
System.SysUtils,
Vcl.ClipBrd;
{ TX2LogStringDetails }
class function TX2LogStringDetails.CreateIfNotEmpty(const AText: string): TX2LogStringDetails;
begin
if Length(AText) > 0 then
Result := Self.Create(AText)
else
Result := nil;
end;
constructor TX2LogStringDetails.Create(const AText: string);
begin
inherited Create;
FText := AText;
end;
function TX2LogStringDetails.GetAsString: string;
begin
Result := FText;
end;
procedure TX2LogStringDetails.CopyToClipboard;
begin
Clipboard.AsText := GetAsString;
end;
procedure TX2LogStringDetails.SaveToStream(AStream: TStream);
var
textStream: TStringStream;
begin
textStream := TStringStream.Create(GetAsString, TEncoding.ANSI, False);
try
AStream.CopyFrom(textStream, 0);
finally
FreeAndNil(textStream);
end;
end;
{ TX2LogBinaryDetails }
constructor TX2LogBinaryDetails.Create(ACopyFrom: TStream);
begin
inherited Create;
FData := TMemoryStream.Create;
FData.CopyFrom(ACopyFrom, ACopyFrom.Size - ACopyFrom.Position);
end;
constructor TX2LogBinaryDetails.Create(AData: RawByteString);
begin
inherited Create;
FData := TStringStream.Create(AData);
end;
destructor TX2LogBinaryDetails.Destroy;
begin
FreeAndNil(FData);
inherited Destroy;
end;
function TX2LogBinaryDetails.GetAsStream: TStream;
begin
Data.Position := 0;
Result := Data;
end;
procedure TX2LogBinaryDetails.SaveToStream(AStream: TStream);
begin
AStream.CopyFrom(Data, 0);
end;
end.

View File

@ -11,7 +11,7 @@ type
TX2LogDefaultExceptionStrategy = class(TInterfacedObject, IX2LogExceptionStrategy)
public
{ IX2LogExceptionStrategy }
procedure Execute(AException: Exception; var AMessage: string; var ADetails: string); virtual;
procedure Execute(AException: Exception; var AMessage: string; var ADetails: IX2LogDetails); virtual;
end;
@ -19,7 +19,7 @@ implementation
{ TX2LogDefaultExceptionStrategy }
procedure TX2LogDefaultExceptionStrategy.Execute(AException: Exception; var AMessage, ADetails: string);
procedure TX2LogDefaultExceptionStrategy.Execute(AException: Exception; var AMessage: string; var ADetails: IX2LogDetails);
begin
if Length(AMessage) > 0 then
AMessage := AMessage + ': ';

View File

@ -12,24 +12,23 @@ type
TX2LogmadExceptExceptionStrategy = class(TX2LogDefaultExceptionStrategy)
public
{ IX2LogExceptionStrategy }
procedure Execute(AException: Exception; var AMessage: string; var ADetails: string); override;
procedure Execute(AException: Exception; var AMessage: string; var ADetails: IX2LogDetails); override;
end;
implementation
uses
madExcept;
madExcept,
X2Log.Details.Default;
{ TX2LogmadExceptExceptionStrategy }
procedure TX2LogmadExceptExceptionStrategy.Execute(AException: Exception; var AMessage, ADetails: string);
procedure TX2LogmadExceptExceptionStrategy.Execute(AException: Exception; var AMessage: string; var ADetails: IX2LogDetails);
begin
inherited Execute(AException, AMessage, ADetails);
if Length(ADetails) > 0 then
ADetails := ADetails + #13#10;
ADetails := ADetails + madExcept.CreateBugReport(etNormal, AException);
ADetails := TX2LogStringDetails.CreateIfNotEmpty(madExcept.CreateBugReport(etNormal, AException));
end;
end.

View File

@ -24,17 +24,27 @@ type
class procedure SetExceptionStrategy(AStrategy: IX2LogExceptionStrategy);
{ Facade for IX2LogBase }
class procedure Log(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string = '');
class procedure Log(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails);
class procedure Verbose(const AMessage: string; const ADetails: string = '');
class procedure VerboseEx(const AMessage: string; ADetails: IX2LogDetails = nil);
class procedure Info(const AMessage: string; const ADetails: string = '');
class procedure InfoEx(const AMessage: string; ADetails: IX2LogDetails = nil);
class procedure Warning(const AMessage: string; const ADetails: string = '');
class procedure WarningEx(const AMessage: string; ADetails: IX2LogDetails = nil);
class procedure Error(const AMessage: string; const ADetails: string = '');
class procedure Exception(AException: Exception; const AMessage: string = ''; const ADetails: string = '');
class procedure ErrorEx(const AMessage: string; ADetails: IX2LogDetails = nil);
class procedure Exception(AException: Exception; const AMessage: string = '');
end;
implementation
uses
X2Log.Details.Default;
{ TX2GlobalLog }
@ -72,7 +82,7 @@ begin
end;
class procedure TX2GlobalLog.Log(ALevel: TX2LogLevel; const AMessage, ADetails: string);
class procedure TX2GlobalLog.Log(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails);
begin
Instance.Log(ALevel, AMessage, ADetails);
end;
@ -84,27 +94,51 @@ begin
end;
class procedure TX2GlobalLog.VerboseEx(const AMessage: string; ADetails: IX2LogDetails);
begin
Instance.VerboseEx(AMessage, ADetails);
end;
class procedure TX2GlobalLog.Info(const AMessage, ADetails: string);
begin
Instance.Info(AMessage, ADetails);
end;
class procedure TX2GlobalLog.InfoEx(const AMessage: string; ADetails: IX2LogDetails);
begin
Instance.InfoEx(AMessage, ADetails);
end;
class procedure TX2GlobalLog.Warning(const AMessage, ADetails: string);
begin
Instance.Warning(AMessage, ADetails);
end;
class procedure TX2GlobalLog.WarningEx(const AMessage: string; ADetails: IX2LogDetails);
begin
Instance.WarningEx(AMessage, ADetails);
end;
class procedure TX2GlobalLog.Error(const AMessage, ADetails: string);
begin
Instance.Error(AMessage, ADetails);
end;
class procedure TX2GlobalLog.Exception(AException: Exception; const AMessage, ADetails: string);
class procedure TX2GlobalLog.ErrorEx(const AMessage: string; ADetails: IX2LogDetails);
begin
Instance.Exception(AException, AMessage, ADetails);
Instance.ErrorEx(AMessage, ADetails);
end;
class procedure TX2GlobalLog.Exception(AException: Exception; const AMessage: string);
begin
Instance.Exception(AException, AMessage);
end;

View File

@ -2,8 +2,10 @@ unit X2Log.Intf;
interface
uses
System.Classes,
System.SysUtils;
type
TX2LogLevel = (Verbose, Info, Warning, Error);
@ -14,9 +16,45 @@ const
type
{ Details }
IX2LogDetails = interface
['{86F24F52-CE1F-4A79-936F-A5805D84E18A}']
end;
IX2LogDetailsCopyable = interface
['{BA93B3CD-4F05-4887-A585-78093E0B31C9}']
procedure CopyToClipboard;
end;
IX2LogDetailsStreamable = interface
['{7DD0756D-F06E-4267-A433-04BEFF4FA955}']
procedure SaveToStream(AStream: TStream);
end;
IX2LogDetailsText = interface(IX2LogDetails)
['{D5F194E9-8633-4575-801D-E8983124118F}']
function GetAsString: string;
property AsString: string read GetAsString;
end;
IX2LogDetailsBinary = interface(IX2LogDetails)
['{265739E7-BB65-434B-BCD3-BB89B936A854}']
function GetAsStream: TStream;
{ Note: Stream Position will be reset by GetAsStream }
property AsStream: TStream read GetAsStream;
end;
{ Logging }
IX2LogBase = interface
['{1949E8DC-6DC5-43DC-B678-55CF8274E79D}']
procedure Log(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string = '');
procedure Log(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails = nil); overload;
end;
@ -27,7 +65,7 @@ type
IX2LogExceptionStrategy = interface
['{C0B7950E-BE0A-4A21-A7C5-F8322FD4E205}']
procedure Execute(AException: Exception; var AMessage: string; var ADetails: string);
procedure Execute(AException: Exception; var AMessage: string; var ADetails: IX2LogDetails);
end;
@ -43,10 +81,18 @@ type
procedure SetExceptionStrategy(AStrategy: IX2LogExceptionStrategy);
procedure Verbose(const AMessage: string; const ADetails: string = '');
procedure VerboseEx(const AMessage: string; ADetails: IX2LogDetails = nil);
procedure Info(const AMessage: string; const ADetails: string = '');
procedure InfoEx(const AMessage: string; ADetails: IX2LogDetails = nil);
procedure Warning(const AMessage: string; const ADetails: string = '');
procedure WarningEx(const AMessage: string; ADetails: IX2LogDetails = nil);
procedure Error(const AMessage: string; const ADetails: string = '');
procedure Exception(AException: Exception; const AMessage: string = ''; const ADetails: string = '');
procedure ErrorEx(const AMessage: string; ADetails: IX2LogDetails = nil);
procedure Exception(AException: Exception; const AMessage: string = '');
end;

View File

@ -11,18 +11,18 @@ uses
type
TX2LogLevels = set of TX2LogLevel;
TX2LogCustomObserver = class(TInterfacedObject, IX2LogObserver)
TX2LogCustomObserver = class(TInterfacedObject, IX2LogBase, IX2LogObserver)
private
FLogLevels: TX2LogLevels;
protected
procedure DoLog(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string = ''); virtual; abstract;
{ IX2LogObserver }
procedure Log(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string = ''); virtual;
procedure DoLog(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails); virtual; abstract;
property LogLevels: TX2LogLevels read FLogLevels;
public
constructor Create(ALogLevels: TX2LogLevels = X2LogLevelsDefault);
{ IX2LogBase }
procedure Log(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails = nil);
end;
@ -38,7 +38,7 @@ begin
end;
procedure TX2LogCustomObserver.Log(ALevel: TX2LogLevel; const AMessage, ADetails: string);
procedure TX2LogCustomObserver.Log(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails);
begin
if ALevel in LogLevels then
DoLog(ALevel, AMessage, ADetails);

View File

@ -20,7 +20,7 @@ type
protected
function CreateWorkerThread: TX2LogObserverWorkerThread; virtual; abstract;
procedure DoLog(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string = ''); override;
procedure DoLog(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails); override;
property WorkerThread: TX2LogObserverWorkerThread read FWorkerThread;
public
@ -31,16 +31,16 @@ type
TX2LogQueueEntry = class(TPersistent)
private
FDetails: string;
FDetails: IX2LogDetails;
FLevel: TX2LogLevel;
FMessage: string;
public
constructor Create(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string); overload;
constructor Create(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails); overload;
constructor Create(AEntry: TX2LogQueueEntry); overload;
procedure Assign(Source: TPersistent); override;
property Details: string read FDetails;
property Details: IX2LogDetails read FDetails;
property Level: TX2LogLevel read FLevel;
property Message: string read FMessage;
end;
@ -68,7 +68,7 @@ type
constructor Create;
destructor Destroy; override;
procedure Log(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string = '');
procedure Log(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails);
end;
@ -94,7 +94,7 @@ begin
end;
procedure TX2LogCustomThreadedObserver.DoLog(ALevel: TX2LogLevel; const AMessage, ADetails: string);
procedure TX2LogCustomThreadedObserver.DoLog(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails);
begin
WorkerThread.Log(ALevel, AMessage, ADetails);
end;
@ -102,7 +102,7 @@ end;
{ TX2LogQueueEntry }
constructor TX2LogQueueEntry.Create(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string);
constructor TX2LogQueueEntry.Create(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails);
begin
inherited Create;
@ -156,7 +156,7 @@ begin
end;
procedure TX2LogObserverWorkerThread.Log(ALevel: TX2LogLevel; const AMessage, ADetails: string);
procedure TX2LogObserverWorkerThread.Log(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails);
begin
TMonitor.Enter(LogQueue);
try

View File

@ -7,7 +7,7 @@ uses
type
TX2LogEvent = procedure(Sender: TObject; Level: TX2LogLevel; const Msg, Details: string) of object;
TX2LogEvent = procedure(Sender: TObject; Level: TX2LogLevel; const Msg: string; Details: IX2LogDetails) of object;
TX2LogEventObserver = class(TX2LogCustomObserver)
@ -15,7 +15,7 @@ type
FOnLog: TX2LogEvent;
FRunInMainThread: Boolean;
protected
procedure DoLog(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string = ''); override;
procedure DoLog(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails); override;
public
constructor Create(ALogLevels: TX2LogLevels = X2LogLevelsDefault); overload;
constructor Create(AOnLog: TX2LogEvent; ALogLevels: TX2LogLevels = X2LogLevelsDefault); overload;
@ -48,7 +48,7 @@ begin
end;
procedure TX2LogEventObserver.DoLog(ALevel: TX2LogLevel; const AMessage, ADetails: string);
procedure TX2LogEventObserver.DoLog(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails);
begin
if Assigned(FOnLog) then
begin

View File

@ -114,12 +114,13 @@ var
detailsFileName: string;
detailsNumber: Integer;
writer: TStreamWriter;
logDetailsStreamable: IX2LogDetailsStreamable;
begin
ForceDirectories(ExtractFilePath(FileName));
errorMsg := AEntry.Message;
if Length(AEntry.Details) > 0 then
if Supports(AEntry.Details, IX2LogDetailsStreamable, logDetailsStreamable) then
begin
detailsExtension := ExtractFileExt(FileName);
baseReportFileName := ChangeFileExt(FileName, '_' + FormatDateTime(GetLogResourceString(@LogFileNameDateFormat), Now));
@ -150,12 +151,7 @@ begin
try
detailsFileStream := THandleStream.Create(detailsFile);
try
detailsWriter := TStreamWriter.Create(detailsFileStream, TEncoding.ANSI);
try
detailsWriter.Write(AEntry.Details);
finally
FreeAndNil(detailsWriter);
end;
logDetailsStreamable.SaveToStream(detailsFileStream);
finally
FreeAndNil(detailsFileStream);
end;

View File

@ -18,7 +18,7 @@ object X2LogObserverMonitorForm: TX2LogObserverMonitorForm
PixelsPerInch = 96
TextHeight = 13
object splDetails: TSplitter
Left = 634
Left = 602
Top = 0
Width = 6
Height = 496
@ -28,9 +28,9 @@ object X2LogObserverMonitorForm: TX2LogObserverMonitorForm
ExplicitHeight = 519
end
object pnlDetails: TPanel
Left = 640
Left = 608
Top = 0
Width = 350
Width = 382
Height = 496
Align = alRight
BevelOuter = bvNone
@ -38,7 +38,7 @@ object X2LogObserverMonitorForm: TX2LogObserverMonitorForm
object tbDetails: TToolBar
Left = 0
Top = 0
Width = 350
Width = 382
Height = 22
AutoSize = True
ButtonWidth = 52
@ -46,6 +46,7 @@ object X2LogObserverMonitorForm: TX2LogObserverMonitorForm
List = True
ShowCaptions = True
TabOrder = 0
ExplicitWidth = 350
object tbCopyDetails: TToolButton
Left = 0
Top = 0
@ -62,30 +63,32 @@ object X2LogObserverMonitorForm: TX2LogObserverMonitorForm
object pnlBorder: TPanel
Left = 0
Top = 22
Width = 350
Width = 382
Height = 474
Align = alClient
BevelKind = bkFlat
BevelOuter = bvNone
TabOrder = 1
ExplicitWidth = 350
object HeaderControl1: THeaderControl
Left = 0
Top = 0
Width = 346
Width = 378
Height = 17
Sections = <
item
AutoSize = True
ImageIndex = -1
Text = 'Details'
Width = 346
Width = 378
end>
NoSizing = True
ExplicitWidth = 346
end
object reDetails: TRichEdit
Left = 0
Top = 17
Width = 346
Width = 378
Height = 453
Align = alClient
BorderStyle = bsNone
@ -99,21 +102,24 @@ object X2LogObserverMonitorForm: TX2LogObserverMonitorForm
ReadOnly = True
ScrollBars = ssBoth
TabOrder = 1
ExplicitLeft = -2
ExplicitWidth = 348
end
end
end
object pnlLog: TPanel
Left = 0
Top = 0
Width = 634
Width = 602
Height = 496
Align = alClient
BevelOuter = bvNone
TabOrder = 1
ExplicitWidth = 634
object vstLog: TVirtualStringTree
Left = 0
Top = 22
Width = 634
Width = 602
Height = 474
Align = alClient
Header.AutoSizeIndex = 2
@ -134,6 +140,7 @@ object X2LogObserverMonitorForm: TX2LogObserverMonitorForm
OnGetImageIndex = vstLogGetImageIndex
OnGetHint = vstLogGetHint
OnInitNode = vstLogInitNode
ExplicitWidth = 634
Columns = <
item
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coShowDropMark, coVisible, coAllowFocus]
@ -147,14 +154,14 @@ object X2LogObserverMonitorForm: TX2LogObserverMonitorForm
end
item
Position = 2
Width = 460
Width = 424
WideText = 'Message'
end>
end
object tbLog: TToolBar
Left = 0
Top = 0
Width = 634
Width = 602
Height = 22
AutoSize = True
ButtonWidth = 56
@ -163,6 +170,7 @@ object X2LogObserverMonitorForm: TX2LogObserverMonitorForm
List = True
ShowCaptions = True
TabOrder = 1
ExplicitWidth = 634
object tbClear: TToolButton
Left = 0
Top = 0
@ -191,10 +199,10 @@ object X2LogObserverMonitorForm: TX2LogObserverMonitorForm
SimplePanel = True
end
object ilsLog: TImageList
Left = 584
Left = 448
Top = 48
Bitmap = {
494C010109004000840010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
494C010109004000880010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000400000003000000001002000000000000030
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
@ -608,13 +616,15 @@ object X2LogObserverMonitorForm: TX2LogObserverMonitorForm
end
object actCopyDetails: TAction
Caption = 'Copy'
Enabled = False
ImageIndex = 7
OnExecute = actCopyDetailsExecute
end
object actSaveDetails: TAction
Caption = 'Save'
Enabled = False
ImageIndex = 5
Visible = False
OnExecute = actSaveDetailsExecute
end
object actPause: TAction
AutoCheck = True
@ -623,4 +633,9 @@ object X2LogObserverMonitorForm: TX2LogObserverMonitorForm
OnExecute = actPauseExecute
end
end
object sdDetails: TSaveDialog
Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing]
Left = 512
Top = 112
end
end

View File

@ -4,8 +4,10 @@ interface
uses
System.Classes,
System.Generics.Collections,
Vcl.ActnList,
Vcl.ComCtrls,
Vcl.Controls,
Vcl.Dialogs,
Vcl.ExtCtrls,
Vcl.Forms,
Vcl.ImgList,
@ -14,7 +16,7 @@ uses
VirtualTrees,
Winapi.Messages,
X2Log.Intf, Vcl.ActnList;
X2Log.Intf;
const
@ -43,6 +45,7 @@ type
actSaveDetails: TAction;
actPause: TAction;
tbPause: TToolButton;
sdDetails: TSaveDialog;
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
@ -54,6 +57,7 @@ type
procedure vstLogFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex);
procedure actClearExecute(Sender: TObject);
procedure actCopyDetailsExecute(Sender: TObject);
procedure actSaveDetailsExecute(Sender: TObject);
procedure actPauseExecute(Sender: TObject);
private class var
FInstances: TDictionary<IX2Log,TX2LogObserverMonitorForm>;
@ -62,6 +66,7 @@ type
FLogToAttach: IX2Log;
FLogAttached: Boolean;
FPausedLogCount: Integer;
FDetails: IX2LogDetails;
function GetPaused: Boolean;
protected
@ -77,6 +82,10 @@ type
procedure UpdateUI;
procedure UpdateStatus;
procedure SetDetails(ADetails: IX2LogDetails);
procedure SetBinaryDetails(ADetails: IX2LogDetailsBinary);
property Details: IX2LogDetails read FDetails;
property LogToAttach: IX2Log read FLogToAttach;
property LogAttached: Boolean read FLogAttached;
property Paused: Boolean read GetPaused;
@ -91,7 +100,7 @@ type
destructor Destroy; override;
{ IX2LogObserver }
procedure Log(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string = '');
procedure Log(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails);
property FreeOnClose: Boolean read FFreeOnClose write FFreeOnClose;
end;
@ -100,6 +109,7 @@ type
implementation
uses
System.DateUtils,
System.Math,
System.SysUtils,
Vcl.Clipbrd,
Winapi.Windows,
@ -115,9 +125,9 @@ type
Time: TDateTime;
Level: TX2LogLevel;
Message: string;
Details: string;
Details: IX2LogDetails;
procedure Initialize(ALevel: TX2LogLevel; const AMessage, ADetails: string);
procedure Initialize(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails);
end;
PLogEntryNodeData = ^TLogEntryNodeData;
@ -130,7 +140,7 @@ const
{ TLogEntryNode }
procedure TLogEntryNodeData.Initialize(ALevel: TX2LogLevel; const AMessage, ADetails: string);
procedure TLogEntryNodeData.Initialize(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails);
begin
Time := Now;
Level := ALevel;
@ -236,6 +246,8 @@ begin
tbCopyDetails.Caption := GetLogResourceString(@LogMonitorFormButtonCopyDetails);
tbSaveDetails.Caption := GetLogResourceString(@LogMonitorFormButtonSaveDetails);
sdDetails.Filter := GetLogResourceString(@LogMonitorFormSaveDetailsFilter);
UpdateUI;
end;
@ -284,7 +296,7 @@ begin
end;
procedure TX2LogObserverMonitorForm.Log(ALevel: TX2LogLevel; const AMessage, ADetails: string);
procedure TX2LogObserverMonitorForm.Log(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails);
var
node: PVirtualNode;
nodeData: PLogEntryNodeData;
@ -326,15 +338,8 @@ end;
procedure TX2LogObserverMonitorForm.UpdateUI;
var
hasDetails: Boolean;
begin
actClear.Enabled := (vstLog.RootNodeCount > 0);
hasDetails := (Length(reDetails.Text) > 0);
actCopyDetails.Enabled := hasDetails;
actSaveDetails.Enabled := hasDetails;
end;
@ -347,6 +352,126 @@ begin
end;
procedure TX2LogObserverMonitorForm.SetDetails(ADetails: IX2LogDetails);
var
logDetailsBinary: IX2LogDetailsBinary;
logDetailsText: IX2LogDetailsText;
begin
FDetails := ADetails;
if Assigned(Details) then
begin
if Supports(ADetails, IX2LogDetailsBinary, logDetailsBinary) then
SetBinaryDetails(logDetailsBinary)
else if Supports(ADetails, IX2LogDetailsText, logDetailsText) then
reDetails.Text := logDetailsText.AsString;
end else
reDetails.Clear;
actCopyDetails.Enabled := Supports(ADetails, IX2LogDetailsCopyable);
actSaveDetails.Enabled := Supports(ADetails, IX2LogDetailsStreamable);
end;
procedure TX2LogObserverMonitorForm.SetBinaryDetails(ADetails: IX2LogDetailsBinary);
const
BufferSize = 4096;
BytesPerLine = 16;
HexSplitPos = 7;
HexSplitSpacing = 1;
HexDigits = 2;
TextDigits = 1;
HexSpacing = 0;
HexTextSpacing = 2;
ReadableCharacters = [32..126, 161..255];
UnreadableCharacter = '.';
procedure ResetLine(var ALine: string);
var
linePos: Integer;
begin
for linePos := 1 to Length(ALine) do
ALine[linePos] := ' ';
end;
var
stream: TStream;
buffer: array[0..Pred(BufferSize)] of Byte;
readBytes: Integer;
linePosition: Integer;
line: string;
bufferIndex: Integer;
hexValue: string;
hexPos: Integer;
textPos: Integer;
begin
stream := ADetails.AsStream;
linePosition := 0;
SetLength(line, (BytesPerLine * (HexDigits + HexSpacing + TextDigits)) + HexTextSpacing +
IfThen(HexSplitPos < BytesPerLine, HexSplitSpacing, 0));
ResetLine(line);
reDetails.Lines.BeginUpdate;
try
reDetails.Lines.Clear;
while True do
begin
readBytes := stream.Read(buffer, SizeOf(buffer));
if readBytes = 0 then
break;
for bufferIndex := 0 to Pred(readBytes) do
begin
hexValue := IntToHex(buffer[bufferIndex], HexDigits);
if linePosition >= BytesPerLine then
begin
reDetails.Lines.Add(line);
ResetLine(line);
linePosition := 0;
end;
hexPos := (linePosition * (HexDigits + HexSpacing));
if linePosition > HexSplitPos then
Inc(hexPos, HexSplitSpacing);
line[hexPos + 1] := hexValue[1];
line[hexPos + 2] := hexValue[2];
textPos := (BytesPerLine * (HexDigits + HexSpacing)) + HexTextSpacing + (linePosition * TextDigits);
if HexSplitPos < BytesPerLine then
Inc(textPos, HexSplitSpacing);
if buffer[bufferIndex] in ReadableCharacters then
line[textPos] := Chr(buffer[bufferIndex])
else
line[textPos] := UnreadableCharacter;
Inc(linePosition);
end;
end;
if linePosition > 0 then
reDetails.Lines.Add(line);
finally
reDetails.Lines.EndUpdate;
end;
end;
function TX2LogObserverMonitorForm.GetPaused: Boolean;
begin
Result := actPause.Checked;
@ -427,7 +552,7 @@ begin
end;
ColumnMessage:
if Length(nodeData^.Details) > 0 then
if Assigned(nodeData^.Details) then
ImageIndex := 4;
end;
end;
@ -442,9 +567,9 @@ begin
if Assigned(Node) then
begin
nodeData := Sender.GetNodeData(Node);
reDetails.Text := nodeData^.Details;
SetDetails(nodeData^.Details);
end else
reDetails.Text := '';
SetDetails(nil);
UpdateUI;
end;
@ -458,9 +583,33 @@ end;
procedure TX2LogObserverMonitorForm.actCopyDetailsExecute(Sender: TObject);
var
logDetailsCopyable: IX2LogDetailsCopyable;
begin
if Length(reDetails.Text) > 0 then
Clipboard.AsText := reDetails.Text;
if Supports(Details, IX2LogDetailsCopyable, logDetailsCopyable) then
logDetailsCopyable.CopyToClipboard;
end;
procedure TX2LogObserverMonitorForm.actSaveDetailsExecute(Sender: TObject);
var
logDetailsStreamable: IX2LogDetailsStreamable;
outputStream: TFileStream;
begin
if Supports(Details, IX2LogDetailsStreamable, logDetailsStreamable) then
begin
if sdDetails.Execute then
begin
outputStream := TFileStream.Create(sdDetails.FileName, fmCreate or fmShareDenyWrite);
try
logDetailsStreamable.SaveToStream(outputStream);
finally
FreeAndNil(outputStream);
end;
end;
end;
end;

View File

@ -208,6 +208,7 @@ var
header: TX2LogMessageHeader;
bytesWritten: Cardinal;
lastError: Cardinal;
logDetailsText: IX2LogDetailsText;
begin
ClearWriteBuffer;
@ -221,7 +222,12 @@ begin
WriteBuffer.WriteBuffer(header, SizeOf(header));
WriteString(AEntry.Message);
WriteString(AEntry.Details);
// #ToDo1 support for non-string details
if Supports(AEntry.Details, IX2LogDetailsText, logDetailsText) then
WriteString(logDetailsText.AsString)
else
WriteString('');
Result := WriteFile(Pipe, WriteBuffer.Memory^, WriteBuffer.Size, bytesWritten, @Overlapped);
if not Result then

View File

@ -23,15 +23,24 @@ type
procedure SetExceptionStrategy(AStrategy: IX2LogExceptionStrategy);
procedure Verbose(const AMessage: string; const ADetails: string = '');
procedure VerboseEx(const AMessage: string; ADetails: IX2LogDetails = nil);
procedure Info(const AMessage: string; const ADetails: string = '');
procedure InfoEx(const AMessage: string; ADetails: IX2LogDetails = nil);
procedure Warning(const AMessage: string; const ADetails: string = '');
procedure WarningEx(const AMessage: string; ADetails: IX2LogDetails = nil);
procedure Error(const AMessage: string; const ADetails: string = '');
procedure Exception(AException: Exception; const AMessage: string = ''; const ADetails: string = '');
procedure ErrorEx(const AMessage: string; ADetails: IX2LogDetails = nil);
procedure Exception(AException: Exception; const AMessage: string = '');
end;
implementation
uses
X2Log.Details.Default,
X2Log.Exception.Default;
@ -54,37 +63,61 @@ end;
procedure TX2Log.Verbose(const AMessage, ADetails: string);
begin
Log(TX2LogLevel.Verbose, AMessage, TX2LogStringDetails.CreateIfNotEmpty(ADetails));
end;
procedure TX2Log.VerboseEx(const AMessage: string; ADetails: IX2LogDetails);
begin
Log(TX2LogLevel.Verbose, AMessage, ADetails);
end;
procedure TX2Log.Info(const AMessage, ADetails: string);
begin
Log(TX2LogLevel.Info, AMessage, TX2LogStringDetails.CreateIfNotEmpty(ADetails));
end;
procedure TX2Log.InfoEx(const AMessage: string; ADetails: IX2LogDetails);
begin
Log(TX2LogLevel.Info, AMessage, ADetails);
end;
procedure TX2Log.Warning(const AMessage, ADetails: string);
begin
Log(TX2LogLevel.Warning, AMessage, TX2LogStringDetails.CreateIfNotEmpty(ADetails));
end;
procedure TX2Log.WarningEx(const AMessage: string; ADetails: IX2LogDetails);
begin
Log(TX2LogLevel.Warning, AMessage, ADetails);
end;
procedure TX2Log.Error(const AMessage, ADetails: string);
begin
Log(TX2LogLevel.Error, AMessage, TX2LogStringDetails.CreateIfNotEmpty(ADetails));
end;
procedure TX2Log.ErrorEx(const AMessage: string; ADetails: IX2LogDetails);
begin
Log(TX2LogLevel.Error, AMessage, ADetails);
end;
procedure TX2Log.Exception(AException: Exception; const AMessage, ADetails: string);
procedure TX2Log.Exception(AException: Exception; const AMessage: string);
var
msg: string;
details: string;
details: IX2LogDetails;
begin
msg := AMessage;
details := ADetails;
details := nil;
ExceptionStrategy.Execute(AException, msg, details);
Log(TX2LogLevel.Error, msg, details);