636 lines
16 KiB
ObjectPascal
636 lines
16 KiB
ObjectPascal
unit X2Log.Observer.MonitorForm;
|
|
|
|
interface
|
|
uses
|
|
System.Classes,
|
|
System.Generics.Collections,
|
|
Vcl.ActnList,
|
|
Vcl.ComCtrls,
|
|
Vcl.Controls,
|
|
Vcl.Dialogs,
|
|
Vcl.ExtCtrls,
|
|
Vcl.Forms,
|
|
Vcl.ImgList,
|
|
Vcl.StdCtrls,
|
|
Vcl.ToolWin,
|
|
VirtualTrees,
|
|
Winapi.Messages,
|
|
|
|
X2Log.Intf;
|
|
|
|
|
|
const
|
|
CM_REENABLE = WM_APP + 1;
|
|
|
|
|
|
type
|
|
TX2LogObserverMonitorForm = class(TForm, IX2LogObserver)
|
|
vstLog: TVirtualStringTree;
|
|
ilsLog: TImageList;
|
|
splDetails: TSplitter;
|
|
HeaderControl1: THeaderControl;
|
|
pnlDetails: TPanel;
|
|
reDetails: TRichEdit;
|
|
pnlLog: TPanel;
|
|
tbLog: TToolBar;
|
|
tbDetails: TToolBar;
|
|
pnlBorder: TPanel;
|
|
tbClear: TToolButton;
|
|
tbSaveDetails: TToolButton;
|
|
sbStatus: TStatusBar;
|
|
tbCopyDetails: TToolButton;
|
|
alLog: TActionList;
|
|
actClear: TAction;
|
|
actCopyDetails: TAction;
|
|
actSaveDetails: TAction;
|
|
actPause: TAction;
|
|
tbPause: TToolButton;
|
|
sdDetails: TSaveDialog;
|
|
|
|
procedure FormShow(Sender: TObject);
|
|
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
|
procedure vstLogInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
|
|
procedure vstLogFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
|
|
procedure vstLogGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
|
|
procedure vstLogGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string);
|
|
procedure vstLogGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer);
|
|
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: TObjectDictionary<IX2Log,TX2LogObserverMonitorForm>;
|
|
private
|
|
FFreeOnClose: Boolean;
|
|
FLogToAttach: IX2Log;
|
|
FLogAttached: Boolean;
|
|
FPausedLogCount: Integer;
|
|
FDetails: IX2LogDetails;
|
|
|
|
function GetPaused: Boolean;
|
|
protected
|
|
class function GetInstance(ALog: IX2Log; out AForm: TX2LogObserverMonitorForm): Boolean;
|
|
class procedure RemoveInstance(AForm: TX2LogObserverMonitorForm);
|
|
class procedure CleanupInstances;
|
|
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
|
|
procedure WMEnable(var Msg: TWMEnable); message WM_ENABLE;
|
|
procedure CMReenable(var Msg: TMessage); message CM_REENABLE;
|
|
|
|
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;
|
|
property PausedLogCount: Integer read FPausedLogCount write FPausedLogCount;
|
|
public
|
|
class function Instance(ALog: IX2Log): TX2LogObserverMonitorForm;
|
|
|
|
class procedure ShowInstance(ALog: IX2Log);
|
|
class procedure CloseInstance(ALog: IX2Log);
|
|
|
|
constructor Create(AOwner: TComponent; ALogToAttach: IX2Log = nil); reintroduce;
|
|
destructor Destroy; override;
|
|
|
|
{ IX2LogObserver }
|
|
procedure Log(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails);
|
|
|
|
property FreeOnClose: Boolean read FFreeOnClose write FFreeOnClose;
|
|
end;
|
|
|
|
|
|
implementation
|
|
uses
|
|
System.DateUtils,
|
|
System.Math,
|
|
System.SysUtils,
|
|
Vcl.Clipbrd,
|
|
Winapi.Windows,
|
|
|
|
X2Log.Constants;
|
|
|
|
|
|
{$R *.dfm}
|
|
|
|
|
|
type
|
|
TLogEntryNodeData = record
|
|
Time: TDateTime;
|
|
Level: TX2LogLevel;
|
|
Message: string;
|
|
Details: IX2LogDetails;
|
|
|
|
procedure Initialize(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails);
|
|
end;
|
|
|
|
PLogEntryNodeData = ^TLogEntryNodeData;
|
|
|
|
|
|
const
|
|
ColumnLevel = 0;
|
|
ColumnTime = 1;
|
|
ColumnMessage = 2;
|
|
|
|
|
|
{ TLogEntryNode }
|
|
procedure TLogEntryNodeData.Initialize(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails);
|
|
begin
|
|
Self.Time := Now;
|
|
Self.Level := ALevel;
|
|
Self.Message := AMessage;
|
|
Self.Details := ADetails;
|
|
end;
|
|
|
|
|
|
{ TX2LogObserverMonitorForm }
|
|
class function TX2LogObserverMonitorForm.Instance(ALog: IX2Log): TX2LogObserverMonitorForm;
|
|
var
|
|
log: IX2Log;
|
|
|
|
begin
|
|
{ Explicit cast ensures we're getting the same pointer every time if, for example,
|
|
the implementing interface is a descendant of IX2Log }
|
|
log := (ALog as IX2Log);
|
|
|
|
if not Assigned(FInstances) then
|
|
FInstances := TObjectDictionary<IX2Log,TX2LogObserverMonitorForm>.Create([doOwnsValues]);
|
|
|
|
if not FInstances.TryGetValue(log, Result) then
|
|
begin
|
|
Result := TX2LogObserverMonitorForm.Create(nil, log);
|
|
Result.FreeOnClose := True;
|
|
|
|
FInstances.Add(log, Result);
|
|
end;
|
|
end;
|
|
|
|
|
|
class procedure TX2LogObserverMonitorForm.ShowInstance(ALog: IX2Log);
|
|
begin
|
|
Instance(ALog).Show;
|
|
end;
|
|
|
|
|
|
class procedure TX2LogObserverMonitorForm.CloseInstance(ALog: IX2Log);
|
|
var
|
|
monitorForm: TX2LogObserverMonitorForm;
|
|
|
|
begin
|
|
if GetInstance(ALog, monitorForm) then
|
|
monitorForm.Close;
|
|
end;
|
|
|
|
|
|
class function TX2LogObserverMonitorForm.GetInstance(ALog: IX2Log; out AForm: TX2LogObserverMonitorForm): Boolean;
|
|
begin
|
|
Result := False;
|
|
|
|
if Assigned(FInstances) then
|
|
Result := FInstances.TryGetValue(ALog as IX2Log, AForm);
|
|
end;
|
|
|
|
|
|
class procedure TX2LogObserverMonitorForm.RemoveInstance(AForm: TX2LogObserverMonitorForm);
|
|
var
|
|
log: IX2Log;
|
|
|
|
begin
|
|
if Assigned(FInstances) then
|
|
begin
|
|
for log in FInstances.Keys do
|
|
begin
|
|
if FInstances[log] = AForm then
|
|
begin
|
|
FInstances.ExtractPair(log);
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
class procedure TX2LogObserverMonitorForm.CleanupInstances;
|
|
begin
|
|
if Assigned(FInstances) then
|
|
FreeAndNil(FInstances);
|
|
end;
|
|
|
|
|
|
constructor TX2LogObserverMonitorForm.Create(AOwner: TComponent; ALogToAttach: IX2Log);
|
|
var
|
|
captionFormat: string;
|
|
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
FLogToAttach := ALogToAttach;
|
|
|
|
captionFormat := GetLogResourceString(@LogMonitorFormCaption);
|
|
if Pos('%s', captionFormat) > 0 then
|
|
Caption := Format(captionFormat, [Application.Title])
|
|
else
|
|
Caption := captionFormat;
|
|
|
|
vstLog.NodeDataSize := SizeOf(TLogEntryNodeData);
|
|
vstLog.Header.Columns[ColumnTime].Text := GetLogResourceString(@LogMonitorFormColumnTime);
|
|
vstLog.Header.Columns[ColumnMessage].Text := GetLogResourceString(@LogMonitorFormColumnMessage);
|
|
|
|
tbClear.Caption := GetLogResourceString(@LogMonitorFormButtonClear);
|
|
tbCopyDetails.Caption := GetLogResourceString(@LogMonitorFormButtonCopyDetails);
|
|
tbSaveDetails.Caption := GetLogResourceString(@LogMonitorFormButtonSaveDetails);
|
|
|
|
sdDetails.Filter := GetLogResourceString(@LogMonitorFormSaveDetailsFilter);
|
|
|
|
UpdateUI;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.CreateParams(var Params: TCreateParams);
|
|
begin
|
|
inherited CreateParams(Params);
|
|
|
|
Params.WndParent := 0;
|
|
end;
|
|
|
|
|
|
destructor TX2LogObserverMonitorForm.Destroy;
|
|
begin
|
|
if Assigned(FLogToAttach) and FLogAttached then
|
|
FLogToAttach.Detach(Self);
|
|
|
|
RemoveInstance(Self);
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.FormShow(Sender: TObject);
|
|
begin
|
|
if Assigned(FLogToAttach) and (not FLogAttached) then
|
|
begin
|
|
FLogToAttach.Attach(Self);
|
|
FLogAttached := True;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.FormClose(Sender: TObject; var Action: TCloseAction);
|
|
begin
|
|
if Assigned(FLogToAttach) and FLogAttached then
|
|
begin
|
|
FLogToAttach.Detach(Self);
|
|
FLogAttached := False;
|
|
end;
|
|
|
|
if FreeOnClose then
|
|
Action := caFree
|
|
else
|
|
Action := caHide;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.Log(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails);
|
|
var
|
|
node: PVirtualNode;
|
|
nodeData: PLogEntryNodeData;
|
|
|
|
begin
|
|
{ Ensure thread safety; TThread.Queue will run the procedure immediately
|
|
if Log is called from the main thread, or queue it asynchronously }
|
|
TThread.Queue(nil,
|
|
procedure
|
|
var
|
|
scroll: Boolean;
|
|
|
|
begin
|
|
if not Paused then
|
|
begin
|
|
scroll := (vstLog.RootNodeCount > 0) and (vstLog.BottomNode = vstLog.GetLast);
|
|
|
|
node := vstLog.AddChild(nil);
|
|
nodeData := vstLog.GetNodeData(node);
|
|
nodeData^.Initialize(ALevel, AMessage, ADetails);
|
|
|
|
if scroll then
|
|
vstLog.ScrollIntoView(node, False);
|
|
|
|
UpdateUI;
|
|
end else
|
|
begin
|
|
PausedLogCount := PausedLogCount + 1;
|
|
UpdateStatus;
|
|
end;
|
|
end);
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.WMEnable(var Msg: TWMEnable);
|
|
begin
|
|
if not Msg.Enabled then
|
|
{ Modal forms disable all other forms, ensure we're still accessible }
|
|
PostMessage(Self.Handle, CM_REENABLE, 0, 0);
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.CMReenable(var Msg: TMessage);
|
|
begin
|
|
EnableWindow(Self.Handle, True);
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.UpdateUI;
|
|
begin
|
|
actClear.Enabled := (vstLog.RootNodeCount > 0);
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.UpdateStatus;
|
|
begin
|
|
if Paused then
|
|
sbStatus.SimpleText := ' ' + Format(GetLogResourceString(@LogMonitorFormStatusPaused), [PausedLogCount])
|
|
else
|
|
sbStatus.SimpleText := '';
|
|
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;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.vstLogInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
|
|
var InitialStates: TVirtualNodeInitStates);
|
|
var
|
|
nodeData: PLogEntryNodeData;
|
|
|
|
begin
|
|
nodeData := Sender.GetNodeData(Node);
|
|
Initialize(nodeData^);
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.vstLogFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
|
|
var
|
|
nodeData: PLogEntryNodeData;
|
|
|
|
begin
|
|
nodeData := Sender.GetNodeData(Node);
|
|
Finalize(nodeData^);
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.vstLogGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
|
|
TextType: TVSTTextType; var CellText: string);
|
|
var
|
|
nodeData: PLogEntryNodeData;
|
|
|
|
begin
|
|
CellText := '';
|
|
nodeData := Sender.GetNodeData(Node);
|
|
|
|
case Column of
|
|
ColumnTime:
|
|
CellText := DateTimeToStr(nodeData^.Time);
|
|
|
|
ColumnMessage:
|
|
CellText := nodeData^.Message;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.vstLogGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
|
|
var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string);
|
|
var
|
|
nodeData: PLogEntryNodeData;
|
|
|
|
begin
|
|
if Column = ColumnLevel then
|
|
begin
|
|
nodeData := Sender.GetNodeData(Node);
|
|
HintText := GetLogLevelText(nodeData^.Level);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.vstLogGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind;
|
|
Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer);
|
|
var
|
|
nodeData: PLogEntryNodeData;
|
|
|
|
begin
|
|
if Kind in [ikNormal, ikSelected] then
|
|
begin
|
|
nodeData := Sender.GetNodeData(Node);
|
|
|
|
case Column of
|
|
ColumnLevel:
|
|
case nodeData^.Level of
|
|
TX2LogLevel.Verbose: ImageIndex := 0;
|
|
TX2LogLevel.Info: ImageIndex := 1;
|
|
TX2LogLevel.Warning: ImageIndex := 2;
|
|
TX2LogLevel.Error: ImageIndex := 3;
|
|
end;
|
|
|
|
ColumnMessage:
|
|
if Assigned(nodeData^.Details) then
|
|
ImageIndex := 4;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.vstLogFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex);
|
|
var
|
|
nodeData: PLogEntryNodeData;
|
|
|
|
begin
|
|
if Assigned(Node) then
|
|
begin
|
|
nodeData := Sender.GetNodeData(Node);
|
|
SetDetails(nodeData^.Details);
|
|
end else
|
|
SetDetails(nil);
|
|
|
|
UpdateUI;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.actClearExecute(Sender: TObject);
|
|
begin
|
|
vstLog.Clear;
|
|
UpdateUI;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.actCopyDetailsExecute(Sender: TObject);
|
|
var
|
|
logDetailsCopyable: IX2LogDetailsCopyable;
|
|
|
|
begin
|
|
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;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.actPauseExecute(Sender: TObject);
|
|
begin
|
|
PausedLogCount := 0;
|
|
UpdateStatus;
|
|
end;
|
|
|
|
|
|
initialization
|
|
finalization
|
|
TX2LogObserverMonitorForm.CleanupInstances;
|
|
|
|
end.
|