526 lines
13 KiB
ObjectPascal
526 lines
13 KiB
ObjectPascal
unit dddToolsAdminLog;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows,
|
|
Messages,
|
|
SysUtils,
|
|
Variants,
|
|
Classes,
|
|
Graphics,
|
|
Controls,
|
|
Forms,
|
|
Dialogs,
|
|
ExtCtrls,
|
|
StdCtrls,
|
|
CheckLst,
|
|
Menus,
|
|
Grids,
|
|
SynCommons,
|
|
SynLog,
|
|
mORMot,
|
|
mORMotDDD;
|
|
|
|
type
|
|
TLogFrame = class(TFrame)
|
|
pnlLeft: TPanel;
|
|
pnlRight: TPanel;
|
|
spl1: TSplitter;
|
|
edtSearch: TEdit;
|
|
chklstEvents: TCheckListBox;
|
|
pmFilter: TPopupMenu;
|
|
mmoBottom: TMemo;
|
|
drwgrdEvents: TDrawGrid;
|
|
btnStartLog: TButton;
|
|
tmrRefresh: TTimer;
|
|
edtExistingLogKB: TEdit;
|
|
lblExistingLogKB: TLabel;
|
|
btnStopLog: TButton;
|
|
spl2: TSplitter;
|
|
BtnSearchNext: TButton;
|
|
BtnSearchPrevious: TButton;
|
|
procedure chklstEventsDrawItem(Control: TWinControl; Index: Integer; Rect:
|
|
TRect; State: TOwnerDrawState);
|
|
procedure btnStartLogClick(Sender: TObject);
|
|
procedure tmrRefreshTimer(Sender: TObject);
|
|
procedure drwgrdEventsDrawCell(Sender: TObject; ACol, ARow: Integer; Rect:
|
|
TRect; State: TGridDrawState);
|
|
procedure drwgrdEventsClick(Sender: TObject); virtual;
|
|
procedure btnSearchNextClick(Sender: TObject);
|
|
procedure chklstEventsDblClick(Sender: TObject);
|
|
procedure btnStopLogClick(Sender: TObject);
|
|
procedure chklstEventsClickCheck(Sender: TObject);
|
|
procedure drwgrdEventsDblClick(Sender: TObject);
|
|
protected
|
|
FLog: TSynLogFileView;
|
|
FMenuFilterAll, FMenuFilterNone: TMenuItem;
|
|
FCallbackPattern: RawUTF8;
|
|
FLogSafe: TSynLocker;
|
|
procedure EventsCheckToLogEvents;
|
|
procedure pmFilterClick(Sender: Tobject);
|
|
procedure ReceivedOne(const Text: RawUTF8);
|
|
procedure SetListItem(Index: integer; const search: RawUTF8 = '');
|
|
public
|
|
Admin: IAdministratedDaemon;
|
|
Callback: ISynLogCallback;
|
|
OnLogReceived: function(Sender: TLogFrame; Level: TSynLogInfo;
|
|
const Text: RawUTF8): boolean of object;
|
|
constructor Create(Owner: TComponent; const aAdmin: IAdministratedDaemon); reintroduce;
|
|
constructor CreateCustom(Owner: TComponent; const aAdmin: IAdministratedDaemon;
|
|
const aEvents, aPattern: RawUTF8); virtual;
|
|
destructor Destroy; override;
|
|
procedure LogFilter(F: TSynLogInfos);
|
|
procedure Closing;
|
|
end;
|
|
|
|
TLogFrameClass = class of TLogFrame;
|
|
|
|
TLogFrameDynArray = array of TLogFrame;
|
|
|
|
TLogFrameChat = class(TLogFrame)
|
|
protected
|
|
procedure mmoChatKeyPress(Sender: TObject; var Key: Char);
|
|
public
|
|
mmoChat: TMemo;
|
|
constructor CreateCustom(Owner: TComponent; const aAdmin:
|
|
IAdministratedDaemon; const aEvents, aPattern: RawUTF8); override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
dddToolsAdminMain;
|
|
|
|
{$R *.dfm}
|
|
|
|
{ TLogFrameCallback }
|
|
|
|
type
|
|
TLogFrameCallback = class(TInterfacedObject, ISynLogCallback)
|
|
public
|
|
Owner: TLogFrame;
|
|
Pattern: RawUTF8;
|
|
procedure Log(Level: TSynLogInfo; const Text: RawUTF8);
|
|
end;
|
|
|
|
procedure TLogFrameCallback.Log(Level: TSynLogInfo; const Text: RawUTF8);
|
|
begin
|
|
if (Pattern <> '') and (Level <> sllNone) then
|
|
if PosI(pointer(Pattern), Text) = 0 then
|
|
exit;
|
|
Owner.ReceivedOne(Text);
|
|
if Assigned(Owner.OnLogReceived) then
|
|
Owner.OnLogReceived(Owner, Level, Text);
|
|
end;
|
|
|
|
procedure TLogFrame.chklstEventsDrawItem(Control: TWinControl; Index: Integer;
|
|
Rect: TRect; State: TOwnerDrawState);
|
|
var
|
|
E: TSynLogInfo;
|
|
begin
|
|
if Index < 0 then
|
|
exit;
|
|
E := TSynLogInfo(chklstEvents.Items.Objects[Index]);
|
|
with chklstEvents.Canvas do begin
|
|
Brush.Color := LOG_LEVEL_COLORS[false, E];
|
|
Font.Color := LOG_LEVEL_COLORS[true, E];
|
|
TextRect(Rect, Rect.Left + 4, Rect.Top, ToCaption(E));
|
|
end;
|
|
end;
|
|
|
|
var
|
|
LogFrameCount: integer;
|
|
|
|
constructor TLogFrame.Create(Owner: TComponent; const aAdmin: IAdministratedDaemon);
|
|
var
|
|
F: TSynLogFilter;
|
|
M: TMenuItem;
|
|
begin
|
|
inherited Create(Owner);
|
|
FLogSafe.Init;
|
|
Admin := aAdmin;
|
|
Name := 'LogFrame' + IntToStr(LogFrameCount);
|
|
inc(LogFrameCount);
|
|
for F := low(F) to high(F) do begin
|
|
M := TMenuItem.Create(self);
|
|
M.Caption := ToCaption(F);
|
|
M.Tag := ord(F);
|
|
M.OnClick := pmFilterClick;
|
|
if F = lfAll then
|
|
FMenuFilterAll := M
|
|
else if F = lfNone then
|
|
FMenuFilterNone := M;
|
|
pmFilter.Items.Add(M);
|
|
end;
|
|
btnStopLogClick(nil);
|
|
end;
|
|
|
|
constructor TLogFrame.CreateCustom(Owner: TComponent;
|
|
const aAdmin: IAdministratedDaemon; const aEvents, aPattern: RawUTF8);
|
|
var
|
|
P: PUTF8Char;
|
|
e: integer;
|
|
begin
|
|
Create(Owner, aAdmin);
|
|
pmFilterClick(FMenuFilterNone);
|
|
P := pointer(aEvents);
|
|
while P <> nil do begin
|
|
e := PTypeInfo(TypeInfo(TSynLogInfo))^.EnumBaseType.GetEnumNameValue(
|
|
pointer(GetNextItem(P)));
|
|
if e > 0 then // ignore e=0=sllNone
|
|
chklstEvents.Checked[e - 1] := True;
|
|
end;
|
|
FCallbackPattern := UpperCase(aPattern);
|
|
btnStartLogClick(self);
|
|
btnStopLog.Hide; { TODO: allow event log closing }
|
|
end;
|
|
|
|
destructor TLogFrame.Destroy;
|
|
begin
|
|
FLogSafe.Done;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TLogFrame.btnStopLogClick(Sender: TObject);
|
|
var
|
|
E: TSynLogInfo;
|
|
begin
|
|
chklstEvents.Top := 56;
|
|
chklstEvents.Items.Clear;
|
|
for E := succ(sllNone) to high(E) do begin
|
|
if (Sender = Self) and not (E in FLog.Events) then
|
|
continue; // from TLogFrame.CreateCustom()
|
|
chklstEvents.Items.AddObject(ToCaption(E), pointer(ord(E)));
|
|
end;
|
|
chklstEvents.Height := 8 + chklstEvents.Count * chklstEvents.ItemHeight;
|
|
pmFilterClick(FMenuFilterAll);
|
|
if Sender = nil then
|
|
exit;
|
|
btnStartLog.Show;
|
|
btnStopLog.Hide;
|
|
edtExistingLogKB.Show;
|
|
lblExistingLogKB.Show;
|
|
edtSearch.Hide;
|
|
btnSearchNext.Hide;
|
|
BtnSearchPrevious.Hide;
|
|
mmoBottom.Text := '';
|
|
drwgrdEvents.Row := 0;
|
|
drwgrdEvents.RowCount := 0;
|
|
drwgrdEvents.Tag := 0;
|
|
tmrRefresh.Enabled := false;
|
|
(Owner as TAdminControl).EndLog(self);
|
|
end;
|
|
|
|
procedure TLogFrame.LogFilter(F: TSynLogInfos);
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 0 to chklstEvents.Count - 1 do
|
|
chklstEvents.Checked[i] := TSynLogInfo(chklstEvents.Items.Objects[i]) in F;
|
|
chklstEventsClickCheck(nil);
|
|
end;
|
|
|
|
procedure TLogFrame.pmFilterClick(Sender: Tobject);
|
|
begin
|
|
if Sender.InheritsFrom(TMenuItem) then
|
|
LogFilter(LOG_FILTER[TSynLogFilter(TMenuItem(Sender).Tag)]);
|
|
end;
|
|
|
|
procedure TLogFrame.EventsCheckToLogEvents;
|
|
var
|
|
i: integer;
|
|
events: TSynLogInfos;
|
|
begin
|
|
integer(events) := 0;
|
|
for i := 0 to chklstEvents.Count - 1 do
|
|
if chklstEvents.Checked[i] then
|
|
Include(events, TSynLogInfo(chklstEvents.Items.Objects[i]));
|
|
FLog.Events := events;
|
|
end;
|
|
|
|
procedure TLogFrame.btnStartLogClick(Sender: TObject);
|
|
var
|
|
cb: TLogFrameCallback;
|
|
kb, i: integer;
|
|
begin
|
|
cb := TLogFrameCallback.Create;
|
|
cb.Owner := Self;
|
|
cb.Pattern := FCallbackPattern;
|
|
Callback := cb;
|
|
FLogSafe.Lock;
|
|
try
|
|
try
|
|
FLog := TSynLogFileView.Create;
|
|
drwgrdEvents.DoubleBuffered := true;
|
|
drwgrdEvents.ColCount := 4;
|
|
drwgrdEvents.ColWidths[0] := 70;
|
|
drwgrdEvents.ColWidths[1] := 60;
|
|
drwgrdEvents.ColWidths[2] := 24;
|
|
drwgrdEvents.ColWidths[3] := 2000;
|
|
if Sender = self then
|
|
kb := 64 // from TLogFrame.CreateCustom
|
|
else
|
|
kb := StrToIntDef(edtExistingLogKB.Text, 0);
|
|
EventsCheckToLogEvents; // fill FLog.Events
|
|
Admin.SubscribeLog(FLog.Events, Callback, kb);
|
|
chklstEvents.Top := lblExistingLogKB.Top;
|
|
for i := chklstEvents.Count - 1 downto 0 do
|
|
if not chklstEvents.Checked[i] then
|
|
chklstEvents.Items.Delete(i);
|
|
chklstEvents.Height := 8 + chklstEvents.Count * chklstEvents.ItemHeight;
|
|
btnStopLog.Top := chklstEvents.Top + chklstEvents.Height + 8;
|
|
btnStartLog.Hide;
|
|
btnStopLog.Show;
|
|
edtExistingLogKB.Hide;
|
|
lblExistingLogKB.Hide;
|
|
edtSearch.Show;
|
|
btnSearchNext.Show;
|
|
BtnSearchPrevious.Show;
|
|
drwgrdEvents.Show;
|
|
tmrRefresh.Enabled := true;
|
|
except
|
|
Callback := nil;
|
|
FreeAndNil(FLog);
|
|
end;
|
|
finally
|
|
fLogSafe.UnLock;
|
|
end;
|
|
end;
|
|
|
|
const
|
|
TAG_NONE = 0;
|
|
TAG_REFRESH = 1;
|
|
|
|
procedure TLogFrame.ReceivedOne(const Text: RawUTF8);
|
|
var
|
|
P: PUTF8Char;
|
|
line: RawUTF8;
|
|
begin
|
|
// warning: this method is called from WebSockets thread, not UI thread
|
|
if Callback = nil then
|
|
exit;
|
|
FLogSafe.Lock;
|
|
try
|
|
if (FLog = nil) or (Text = '') then
|
|
exit;
|
|
P := pointer(Text);
|
|
repeat // handle multiple log rows in the incoming text
|
|
line := GetNextLine(P, P);
|
|
if length(line) < 24 then
|
|
continue;
|
|
FLog.AddInMemoryLine(line);
|
|
tmrRefresh.Tag := TAG_REFRESH; // notify tmrRefreshTimer()
|
|
until P = nil;
|
|
finally
|
|
FLogSafe.UnLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TLogFrame.tmrRefreshTimer(Sender: TObject);
|
|
var
|
|
moveToLast: boolean;
|
|
begin
|
|
FLogSafe.Lock; // to protect tmrRefresh.Tag access from ReceivedOne()
|
|
try
|
|
if (tmrRefresh.Tag = TAG_NONE) or (fLog = nil) then
|
|
exit;
|
|
moveToLast := drwgrdEvents.Row = drwgrdEvents.RowCount - 1;
|
|
drwgrdEvents.RowCount := FLog.SelectedCount;
|
|
if FLog.SelectedCount > 0 then
|
|
if (drwgrdEvents.Tag = 0) or moveToLast then begin
|
|
drwgrdEvents.Row := FLog.SelectedCount - 1;
|
|
drwgrdEvents.Tag := 1;
|
|
end;
|
|
drwgrdEvents.Invalidate;
|
|
tmrRefresh.Tag := TAG_NONE;
|
|
finally
|
|
FLogSafe.UnLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TLogFrame.drwgrdEventsDrawCell(Sender: TObject; ACol, ARow: Integer;
|
|
Rect: TRect; State: TGridDrawState);
|
|
var
|
|
txt: string;
|
|
inverted: boolean;
|
|
level: TSynLogInfo;
|
|
begin
|
|
with drwgrdEvents.Canvas do begin
|
|
Brush.Style := bsClear;
|
|
FLogSafe.Lock;
|
|
try
|
|
txt := FLog.GetCell(ACol,ARow,level);
|
|
finally
|
|
FLogSafe.UnLock;
|
|
end;
|
|
if level=sllNone then
|
|
Brush.Color := clLtGray else begin
|
|
inverted := (gdFocused in State) or (gdSelected in State);
|
|
if inverted then
|
|
Brush.Color := clBlack else
|
|
Brush.Color := LOG_LEVEL_COLORS[inverted,level];
|
|
Font.Color := LOG_LEVEL_COLORS[not inverted,level];
|
|
end;
|
|
FillRect(Rect);
|
|
TextRect(Rect,Rect.Left+4,Rect.Top,txt);
|
|
end;
|
|
end;
|
|
|
|
procedure TLogFrame.drwgrdEventsClick(Sender: TObject);
|
|
var
|
|
row: integer;
|
|
s: string;
|
|
sel: TGridRect;
|
|
begin
|
|
row := drwgrdEvents.Row;
|
|
sel := drwgrdEvents.Selection;
|
|
FLogSafe.Lock;
|
|
try
|
|
s := FLog.GetLineForMemo(row,sel.Top,sel.Bottom);
|
|
finally
|
|
FLogSafe.UnLock;
|
|
end;
|
|
mmoBottom.Text := s;
|
|
end;
|
|
|
|
procedure TLogFrame.btnSearchNextClick(Sender: TObject);
|
|
var
|
|
s: RawUTF8;
|
|
ndx: integer;
|
|
begin
|
|
s := UpperCase(StringToUTF8(edtSearch.Text));
|
|
FLogSafe.Lock;
|
|
Screen.Cursor := crHourGlass;
|
|
try
|
|
if Sender=BtnSearchPrevious then
|
|
ndx := FLog.SearchPreviousText(s,drwgrdEvents.Row) else
|
|
if Sender=edtSearch then
|
|
ndx := FLog.SearchNextText(s,drwgrdEvents.Row,0) else
|
|
ndx := FLog.SearchNextText(s,drwgrdEvents.Row,1); // e.g. BtnSearchNext
|
|
if ndx>=0 then
|
|
SetListItem(ndx,s);
|
|
finally
|
|
FLogSafe.UnLock;
|
|
Screen.Cursor := crDefault;
|
|
end;
|
|
end;
|
|
|
|
procedure TLogFrame.SetListItem(Index: integer; const search: RawUTF8);
|
|
var
|
|
i: integer;
|
|
s, ss: string;
|
|
begin
|
|
if (FLog = nil) or (cardinal(Index) >= cardinal(FLog.SelectedCount)) then
|
|
mmoBottom.Text := ''
|
|
else begin
|
|
drwgrdEvents.Row := Index;
|
|
if (search = '') and drwgrdEvents.Visible then
|
|
drwgrdEvents.SetFocus;
|
|
s := FLog.EventString(FLog.Selected[Index], '', 0, true);
|
|
mmoBottom.Text := s;
|
|
if search <> '' then begin
|
|
ss := UTF8ToString(search);
|
|
i := Pos(ss, SysUtils.UpperCase(s));
|
|
if i > 0 then begin
|
|
mmoBottom.SelStart := i - 1;
|
|
mmoBottom.SelLength := length(ss);
|
|
mmoBottom.SetFocus;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TLogFrame.Closing;
|
|
begin
|
|
Callback := nil;
|
|
FLogSafe.Lock;
|
|
try
|
|
FreeAndNil(fLog);
|
|
finally
|
|
FLogSafe.UnLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TLogFrame.chklstEventsDblClick(Sender: TObject);
|
|
var
|
|
i: integer;
|
|
E: TSynLogInfo;
|
|
begin
|
|
if FLog.EventLevel = nil then // plain text file does not handle this
|
|
exit;
|
|
i := chklstEvents.ItemIndex;
|
|
if i < 0 then
|
|
exit;
|
|
E := TSynLogInfo(chklstEvents.Items.Objects[i]);
|
|
FLogSafe.Lock;
|
|
try
|
|
i := FLog.SearchNextEvent(E,drwgrdEvents.Row);
|
|
if i>=0 then
|
|
SetListItem(i);
|
|
finally
|
|
FLogSafe.UnLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TLogFrame.chklstEventsClickCheck(Sender: TObject);
|
|
var
|
|
selected: integer;
|
|
begin
|
|
if FLog = nil then
|
|
exit;
|
|
EventsCheckToLogEvents; // fill FLog.Events
|
|
FLogSafe.Lock;
|
|
try
|
|
selected := FLog.Select(drwgrdEvents.Row);
|
|
if cardinal(selected) < cardinal(FLog.SelectedCount) then
|
|
drwgrdEvents.Row := 0; // avoid "Grid Out Of Range" when setting RowCount
|
|
drwgrdEvents.RowCount := FLog.SelectedCount;
|
|
if selected>=0 then
|
|
SetListItem(selected);
|
|
finally
|
|
FLogSafe.UnLock;
|
|
end;
|
|
if drwgrdEvents.Visible then begin
|
|
drwgrdEvents.Repaint;
|
|
drwgrdEventsClick(nil);
|
|
end;
|
|
end;
|
|
|
|
procedure TLogFrame.drwgrdEventsDblClick(Sender: TObject);
|
|
var ndx: integer;
|
|
begin
|
|
ndx := fLog.SearchEnterLeave(drwgrdEvents.Row);
|
|
if ndx>=0 then
|
|
SetListItem(ndx);
|
|
end;
|
|
|
|
|
|
{ TLogFrameChat }
|
|
|
|
constructor TLogFrameChat.CreateCustom(Owner: TComponent; const aAdmin:
|
|
IAdministratedDaemon; const aEvents, aPattern: RawUTF8);
|
|
begin
|
|
inherited;
|
|
chklstEvents.Enabled := false;
|
|
mmoChat := TMemo.Create(self);
|
|
mmoChat.Parent := self;
|
|
mmoChat.Height := 40;
|
|
mmoChat.Align := alTop;
|
|
mmoChat.OnKeyPress := mmoChatKeyPress;
|
|
end;
|
|
|
|
procedure TLogFrameChat.mmoChatKeyPress(Sender: TObject; var Key: Char);
|
|
begin
|
|
if Key = #13 then begin
|
|
if Assigned(Admin) then
|
|
Admin.DatabaseExecute('', FormatUTF8('#chat % %',
|
|
[ExeVersion.User, StringToUTF8(mmoChat.Text)]));
|
|
mmoChat.Clear;
|
|
Key := #0;
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
|