source upload
This commit is contained in:
Razor12911
525
contrib/mORMot/SQLite3/DDD/tools/dddToolsAdminLog.pas
Normal file
525
contrib/mORMot/SQLite3/DDD/tools/dddToolsAdminLog.pas
Normal file
@@ -0,0 +1,525 @@
|
||||
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.
|
||||
|
||||
Reference in New Issue
Block a user