2014-05-18 18:09:07 +00:00
|
|
|
unit MainFrm;
|
|
|
|
|
|
|
|
interface
|
|
|
|
uses
|
|
|
|
System.Classes,
|
|
|
|
Vcl.ComCtrls,
|
|
|
|
Vcl.Controls,
|
|
|
|
Vcl.ExtCtrls,
|
|
|
|
Vcl.Forms,
|
|
|
|
Vcl.StdCtrls,
|
|
|
|
|
2014-05-25 14:20:58 +00:00
|
|
|
X2Log.Intf, Vcl.ImgList;
|
2014-05-18 18:09:07 +00:00
|
|
|
|
|
|
|
|
|
|
|
type
|
|
|
|
TMainForm = class(TForm)
|
|
|
|
btnClose: TButton;
|
2014-05-20 19:17:23 +00:00
|
|
|
btnVerbose: TButton;
|
2014-05-18 18:09:07 +00:00
|
|
|
edtMessage: TEdit;
|
|
|
|
GroupBox1: TGroupBox;
|
|
|
|
lblMessage: TLabel;
|
|
|
|
mmoEvent: TMemo;
|
|
|
|
pcObservers: TPageControl;
|
|
|
|
pnlButtons: TPanel;
|
|
|
|
tsEvent: TTabSheet;
|
|
|
|
tsFile: TTabSheet;
|
|
|
|
lblException: TLabel;
|
|
|
|
edtException: TEdit;
|
|
|
|
btnException: TButton;
|
|
|
|
tsNamedPipe: TTabSheet;
|
2014-05-20 08:49:57 +00:00
|
|
|
btnMonitorForm: TButton;
|
2014-05-20 19:17:23 +00:00
|
|
|
btnInfo: TButton;
|
|
|
|
btnWarning: TButton;
|
|
|
|
btnError: TButton;
|
2014-05-25 14:20:58 +00:00
|
|
|
btnEventStart: TButton;
|
|
|
|
btnEventStop: TButton;
|
|
|
|
ilsObservers: TImageList;
|
|
|
|
btnFileStart: TButton;
|
|
|
|
btnFileStop: TButton;
|
|
|
|
btnNamedPipeStart: TButton;
|
|
|
|
btnNamedPipeStop: TButton;
|
|
|
|
edtFilename: TEdit;
|
|
|
|
lblFilename: TLabel;
|
|
|
|
rbProgramData: TRadioButton;
|
|
|
|
rbUserData: TRadioButton;
|
|
|
|
rbAbsolute: TRadioButton;
|
|
|
|
edtPipeName: TEdit;
|
|
|
|
lblPipeName: TLabel;
|
2014-05-18 18:09:07 +00:00
|
|
|
|
|
|
|
procedure FormCreate(Sender: TObject);
|
|
|
|
procedure FormDestroy(Sender: TObject);
|
2014-05-20 19:17:23 +00:00
|
|
|
procedure btnCloseClick(Sender: TObject);
|
|
|
|
procedure btnLogClick(Sender: TObject);
|
2014-05-18 18:09:07 +00:00
|
|
|
procedure edtExceptionKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
|
|
procedure edtMessageKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
|
|
procedure btnExceptionClick(Sender: TObject);
|
2014-05-20 08:49:57 +00:00
|
|
|
procedure btnMonitorFormClick(Sender: TObject);
|
2014-05-25 14:20:58 +00:00
|
|
|
procedure btnEventStartClick(Sender: TObject);
|
|
|
|
procedure btnEventStopClick(Sender: TObject);
|
|
|
|
procedure btnFileStartClick(Sender: TObject);
|
|
|
|
procedure btnFileStopClick(Sender: TObject);
|
|
|
|
procedure btnNamedPipeStartClick(Sender: TObject);
|
|
|
|
procedure btnNamedPipeStopClick(Sender: TObject);
|
2014-05-18 18:09:07 +00:00
|
|
|
private
|
|
|
|
FLog: IX2Log;
|
2014-05-25 14:20:58 +00:00
|
|
|
FEventObserver: IX2LogObserver;
|
|
|
|
FFileObserver: IX2LogObserver;
|
|
|
|
FNamedPipeObserver: IX2LogObserver;
|
2014-05-18 18:09:07 +00:00
|
|
|
protected
|
|
|
|
procedure DoLog(Sender: TObject; Level: TX2LogLevel; const Msg, Details: string);
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
|
|
System.SysUtils,
|
|
|
|
Winapi.Windows,
|
|
|
|
|
|
|
|
X2Log,
|
|
|
|
X2Log.Constants,
|
|
|
|
X2Log.Exception.madExcept,
|
|
|
|
X2Log.Observer.Event,
|
|
|
|
X2Log.Observer.LogFile,
|
2014-05-20 08:49:57 +00:00
|
|
|
X2Log.Observer.MonitorForm,
|
2014-05-18 18:09:07 +00:00
|
|
|
X2Log.Observer.NamedPipe;
|
|
|
|
|
|
|
|
|
|
|
|
{$R *.dfm}
|
|
|
|
|
|
|
|
|
|
|
|
{ TMainForm }
|
|
|
|
procedure TMainForm.FormCreate(Sender: TObject);
|
|
|
|
begin
|
2014-05-20 08:49:57 +00:00
|
|
|
{ Testing the localization (Dutch) }
|
2014-05-18 18:09:07 +00:00
|
|
|
SetLogResourceString(@LogLevelVerbose, 'Uitgebreid');
|
|
|
|
SetLogResourceString(@LogLevelInfo, 'Informatie');
|
|
|
|
SetLogResourceString(@LogLevelWarning, 'Waarschuwing');
|
|
|
|
SetLogResourceString(@LogLevelError, 'Fout');
|
|
|
|
|
2014-05-20 08:49:57 +00:00
|
|
|
SetLogResourceString(@LogMonitorFormColumnTime, 'Tijd');
|
|
|
|
SetLogResourceString(@LogMonitorFormColumnMessage, 'Melding');
|
|
|
|
|
2014-05-20 09:19:04 +00:00
|
|
|
SetLogResourceString(@LogMonitorFormButtonClear, 'Wissen');
|
2014-05-20 19:17:23 +00:00
|
|
|
SetLogResourceString(@LogMonitorFormButtonCopyDetails, 'Kopieren');
|
2014-05-20 09:19:04 +00:00
|
|
|
SetLogResourceString(@LogMonitorFormButtonSaveDetails, 'Opslaan');
|
2014-05-20 19:17:23 +00:00
|
|
|
SetLogResourceString(@LogMonitorFormStatusPaused, 'Gepauseerd: %d melding(en) overgeslagen');
|
2014-05-20 09:19:04 +00:00
|
|
|
|
2014-05-18 18:09:07 +00:00
|
|
|
FLog := TX2Log.Create;
|
|
|
|
FLog.SetExceptionStrategy(TX2LogmadExceptExceptionStrategy.Create);
|
|
|
|
|
|
|
|
pcObservers.ActivePageIndex := 0;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
procedure TMainForm.FormDestroy(Sender: TObject);
|
|
|
|
begin
|
|
|
|
FLog := nil;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
procedure TMainForm.DoLog(Sender: TObject; Level: TX2LogLevel; const Msg, Details: string);
|
|
|
|
begin
|
|
|
|
mmoEvent.Lines.Add(GetLogLevelText(Level) + ': ' + Msg + ' (' + Details + ')');
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
procedure TMainForm.edtMessageKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
|
|
begin
|
|
|
|
if Key = VK_RETURN then
|
|
|
|
begin
|
|
|
|
btnException.Click;
|
|
|
|
Key := 0;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
procedure TMainForm.edtExceptionKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
|
|
begin
|
|
|
|
if Key = VK_RETURN then
|
|
|
|
begin
|
|
|
|
btnException.Click;
|
|
|
|
Key := 0;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2014-05-20 19:17:23 +00:00
|
|
|
procedure TMainForm.btnCloseClick(Sender: TObject);
|
2014-05-18 18:09:07 +00:00
|
|
|
begin
|
2014-05-20 19:17:23 +00:00
|
|
|
Close;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
procedure TMainForm.btnLogClick(Sender: TObject);
|
|
|
|
begin
|
|
|
|
if Sender = btnVerbose then
|
|
|
|
FLog.Verbose(edtMessage.Text)
|
|
|
|
else if Sender = btnInfo then
|
|
|
|
FLog.Info(edtMessage.Text)
|
|
|
|
else if Sender = btnWarning then
|
|
|
|
FLog.Warning(edtMessage.Text)
|
|
|
|
else if Sender = btnError then
|
|
|
|
FLog.Error(edtMessage.Text);
|
2014-05-18 18:09:07 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
procedure TMainForm.btnExceptionClick(Sender: TObject);
|
|
|
|
begin
|
|
|
|
try
|
|
|
|
{ Throw an actual exception, don't just create it, to allow
|
|
|
|
strategies like madExcept to do their stack trace }
|
|
|
|
raise EAbort.Create(edtException.Text);
|
|
|
|
except
|
|
|
|
on E:Exception do
|
|
|
|
FLog.Exception(E);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2014-05-20 08:49:57 +00:00
|
|
|
|
|
|
|
procedure TMainForm.btnMonitorFormClick(Sender: TObject);
|
|
|
|
begin
|
|
|
|
TX2LogObserverMonitorForm.ShowInstance(FLog);
|
|
|
|
end;
|
|
|
|
|
2014-05-25 14:20:58 +00:00
|
|
|
|
|
|
|
procedure TMainForm.btnEventStartClick(Sender: TObject);
|
|
|
|
begin
|
|
|
|
if not Assigned(FEventObserver) then
|
|
|
|
begin
|
|
|
|
FEventObserver := TX2LogEventObserver.Create(DoLog);
|
|
|
|
FLog.Attach(FEventObserver);
|
|
|
|
|
|
|
|
tsEvent.ImageIndex := 1;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
procedure TMainForm.btnEventStopClick(Sender: TObject);
|
|
|
|
begin
|
|
|
|
if Assigned(FEventObserver) then
|
|
|
|
begin
|
|
|
|
FLog.Detach(FEventObserver);
|
|
|
|
FEventObserver := nil;
|
|
|
|
|
|
|
|
tsEvent.ImageIndex := 0;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
procedure TMainForm.btnFileStartClick(Sender: TObject);
|
|
|
|
begin
|
|
|
|
if not Assigned(FFileObserver) then
|
|
|
|
begin
|
|
|
|
if rbProgramData.Checked then
|
|
|
|
FFileObserver := TX2LogFileObserver.CreateInProgramData(edtFilename.Text)
|
|
|
|
else if rbUserData.Checked then
|
|
|
|
FFileObserver := TX2LogFileObserver.CreateInUserAppData(edtFilename.Text)
|
|
|
|
else
|
|
|
|
FFileObserver := TX2LogFileObserver.Create(edtFilename.Text);
|
|
|
|
|
|
|
|
FLog.Attach(FFileObserver);
|
|
|
|
|
|
|
|
tsFile.ImageIndex := 1;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
procedure TMainForm.btnFileStopClick(Sender: TObject);
|
|
|
|
begin
|
|
|
|
if Assigned(FFileObserver) then
|
|
|
|
begin
|
|
|
|
FLog.Detach(FFileObserver);
|
|
|
|
FFileObserver := nil;
|
|
|
|
|
|
|
|
tsFile.ImageIndex := 0;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
procedure TMainForm.btnNamedPipeStartClick(Sender: TObject);
|
|
|
|
begin
|
|
|
|
if not Assigned(FNamedPipeObserver) then
|
|
|
|
begin
|
|
|
|
FNamedPipeObserver := TX2LogNamedPipeObserver.Create(edtPipeName.Text);
|
|
|
|
FLog.Attach(FNamedPipeObserver);
|
|
|
|
|
|
|
|
tsNamedPipe.ImageIndex := 1;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
procedure TMainForm.btnNamedPipeStopClick(Sender: TObject);
|
|
|
|
begin
|
|
|
|
if Assigned(FNamedPipeObserver) then
|
|
|
|
begin
|
|
|
|
FLog.Detach(FNamedPipeObserver);
|
|
|
|
FNamedPipeObserver := nil;
|
|
|
|
|
|
|
|
tsNamedPipe.ImageIndex := 0;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2014-05-18 18:09:07 +00:00
|
|
|
end.
|