mirror of
https://github.com/danieleteti/delphimvcframework.git
synced 2024-11-17 08:45:55 +01:00
b22a41ca91
0b6857bd Updated unit tests and automatic tasks 35d130d6 VERSION_1_4_4 2e4a80f4 Removed PasDoc documentation; Added unit tests for LogLayoutToLogFormat 8f61bc22 Removed TLogAppenderOptions, DEFAULT_LOG_FILENAME_FORMAT is now TLogLayout.* (there many possibilities); FileName layout use placeholders instead of indices (as format function does). be43f781 Merge branch 'master' into v2.0 git-subtree-dir: lib/loggerpro git-subtree-split: 0b6857bd8d51f5acb246561564b3c3bbd963d192
114 lines
2.7 KiB
ObjectPascal
114 lines
2.7 KiB
ObjectPascal
unit RedisAppenderFormU;
|
|
|
|
interface
|
|
|
|
uses
|
|
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
|
|
System.Classes, Vcl.Graphics,
|
|
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, LoggerPro, Vcl.ExtCtrls;
|
|
|
|
type
|
|
TMainForm = class(TForm)
|
|
Button1: TButton;
|
|
Button2: TButton;
|
|
Button3: TButton;
|
|
Button4: TButton;
|
|
Button5: TButton;
|
|
procedure Button1Click(Sender: TObject);
|
|
procedure Button2Click(Sender: TObject);
|
|
procedure Button3Click(Sender: TObject);
|
|
procedure Button4Click(Sender: TObject);
|
|
procedure Button5Click(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
private
|
|
fContext: string;
|
|
{ Private declarations }
|
|
public
|
|
|
|
end;
|
|
|
|
var
|
|
MainForm: TMainForm;
|
|
|
|
implementation
|
|
|
|
{$R *.dfm}
|
|
|
|
|
|
uses LoggerProConfig;
|
|
|
|
procedure TMainForm.Button1Click(Sender: TObject);
|
|
begin
|
|
Log.Debug('This is a debug message with TAG1 (%s)', [fContext], 'TAG1');
|
|
end;
|
|
|
|
procedure TMainForm.Button2Click(Sender: TObject);
|
|
begin
|
|
Log.Info('This is a info message with TAG1 (%s)', [fContext], 'TAG1');
|
|
end;
|
|
|
|
procedure TMainForm.Button3Click(Sender: TObject);
|
|
begin
|
|
Log.Warn('This is a warning message with TAG1 (%s)', [fContext], 'TAG1');
|
|
end;
|
|
|
|
procedure TMainForm.Button4Click(Sender: TObject);
|
|
begin
|
|
Log.Error('This is a error message with TAG1 (%s)', [fContext], 'TAG1');
|
|
end;
|
|
|
|
procedure TMainForm.Button5Click(Sender: TObject);
|
|
var
|
|
lThreadProc: TProc;
|
|
begin
|
|
lThreadProc := procedure
|
|
var
|
|
I: Integer;
|
|
lThreadID: string;
|
|
begin
|
|
lThreadID := IntToStr(TThread.Current.ThreadID);
|
|
for I := 1 to 100 do
|
|
begin
|
|
Log.Debug('log message ' + TimeToStr(now) + ' ThreadID: ' + lThreadID,
|
|
'MULTITHREADING');
|
|
Log.Info('log message ' + TimeToStr(now) + ' ThreadID: ' + lThreadID,
|
|
'MULTITHREADING');
|
|
Log.Warn('log message ' + TimeToStr(now) + ' ThreadID: ' + lThreadID,
|
|
'MULTITHREADING');
|
|
Log.Error('log message ' + TimeToStr(now) + ' ThreadID: ' + lThreadID,
|
|
'MULTITHREADING');
|
|
end;
|
|
end;
|
|
TThread.CreateAnonymousThread(lThreadProc).Start;
|
|
TThread.CreateAnonymousThread(lThreadProc).Start;
|
|
TThread.CreateAnonymousThread(lThreadProc).Start;
|
|
TThread.CreateAnonymousThread(lThreadProc).Start;
|
|
end;
|
|
|
|
function GetUserFromWindows: string;
|
|
var
|
|
iLen: Cardinal;
|
|
begin
|
|
iLen := 256;
|
|
Result := StringOfChar(#0, iLen);
|
|
GetUserName(PChar(Result), iLen);
|
|
SetLength(Result, iLen-1);
|
|
end;
|
|
|
|
function GetComputerNameFromWindows: string;
|
|
var
|
|
iLen: Cardinal;
|
|
begin
|
|
iLen := MAX_COMPUTERNAME_LENGTH + 1;
|
|
Result := StringOfChar(#0, iLen);
|
|
GetComputerName(PChar(Result), iLen);
|
|
SetLength(Result, iLen);
|
|
end;
|
|
|
|
procedure TMainForm.FormCreate(Sender: TObject);
|
|
begin
|
|
fContext := GetUserFromWindows + '@' + GetComputerNameFromWindows;
|
|
end;
|
|
|
|
end.
|