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;
|
|
|
|
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-30 12:51:01 +00:00
|
|
|
btnBinary: TButton;
|
2014-05-31 11:14:05 +00:00
|
|
|
pcDispatch: TPageControl;
|
|
|
|
tsText: TTabSheet;
|
|
|
|
tsException: TTabSheet;
|
|
|
|
tsBinary: TTabSheet;
|
|
|
|
pnlDispatch: TPanel;
|
|
|
|
bvlDispatch: TBevel;
|
2014-05-31 20:10:10 +00:00
|
|
|
pnlObservers: TPanel;
|
|
|
|
bvlObservers: TBevel;
|
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
|
2014-05-30 12:51:01 +00:00
|
|
|
procedure DoLog(Sender: TObject; Level: TX2LogLevel; const Msg: string; Details: IX2LogDetails);
|
2014-05-18 18:09:07 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
|
|
System.SysUtils,
|
|
|
|
Winapi.Windows,
|
|
|
|
|
|
|
|
X2Log,
|
|
|
|
X2Log.Constants,
|
2014-05-30 12:51:01 +00:00
|
|
|
X2Log.Details.Default,
|
2014-05-18 18:09:07 +00:00
|
|
|
X2Log.Exception.madExcept,
|
|
|
|
X2Log.Observer.Event,
|
|
|
|
X2Log.Observer.LogFile,
|
2014-05-20 08:49:57 +00:00
|
|
|
X2Log.Observer.MonitorForm,
|
2014-05-31 11:14:05 +00:00
|
|
|
X2Log.Observer.NamedPipe,
|
|
|
|
X2Log.Global;
|
2014-05-18 18:09:07 +00:00
|
|
|
|
|
|
|
|
|
|
|
{$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-30 13:06:47 +00:00
|
|
|
SetLogResourceString(@LogMonitorFormSaveDetailsFilter, 'Alle bestanden (*.*)|*.*');
|
|
|
|
|
2014-05-18 18:09:07 +00:00
|
|
|
FLog := TX2Log.Create;
|
|
|
|
FLog.SetExceptionStrategy(TX2LogmadExceptExceptionStrategy.Create);
|
|
|
|
|
2014-05-31 11:14:05 +00:00
|
|
|
pcDispatch.ActivePageIndex := 0;
|
2014-05-18 18:09:07 +00:00
|
|
|
pcObservers.ActivePageIndex := 0;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
procedure TMainForm.FormDestroy(Sender: TObject);
|
|
|
|
begin
|
|
|
|
FLog := nil;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
2014-05-30 12:51:01 +00:00
|
|
|
procedure TMainForm.DoLog(Sender: TObject; Level: TX2LogLevel; const Msg: string; Details: IX2LogDetails);
|
|
|
|
var
|
|
|
|
text: string;
|
|
|
|
logDetailsText: IX2LogDetailsText;
|
|
|
|
|
2014-05-18 18:09:07 +00:00
|
|
|
begin
|
2014-05-30 12:51:01 +00:00
|
|
|
text := GetLogLevelText(Level) + ': ' + Msg;
|
|
|
|
|
|
|
|
if Supports(Details, IX2LogDetailsText, logDetailsText) then
|
|
|
|
text := text + ' (' + logDetailsText.AsString + ')';
|
|
|
|
|
|
|
|
mmoEvent.Lines.Add(text);
|
2014-05-18 18:09:07 +00:00
|
|
|
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
|
2014-05-30 12:51:01 +00:00
|
|
|
FLog.Error(edtMessage.Text)
|
|
|
|
else if Sender = btnBinary then
|
|
|
|
FLog.InfoEx(edtMessage.Text, TX2LogBinaryDetails.Create(#0#1#2#3'Test'#12'Some more data'));
|
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
|
2014-05-31 11:14:05 +00:00
|
|
|
// TX2LogObserverMonitorForm.ShowInstance(FLog);
|
|
|
|
TX2LogObserverMonitorForm.ShowInstance(Tx2globallog.Instance);
|
2014-05-20 08:49:57 +00:00
|
|
|
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.
|