diff --git a/NamedPipeClient/X2LogNamedPipeClient.dpr b/NamedPipeClient/X2LogNamedPipeClient.dpr
index 5503192..b8066a3 100644
--- a/NamedPipeClient/X2LogNamedPipeClient.dpr
+++ b/NamedPipeClient/X2LogNamedPipeClient.dpr
@@ -3,7 +3,12 @@ program X2LogNamedPipeClient;
uses
Vcl.Forms,
MainFrm in 'source\MainFrm.pas' {MainForm},
- X2Log.Intf in '..\X2Log.Intf.pas';
+ X2Log.Intf in '..\X2Log.Intf.pas',
+ X2Log.Client.NamedPipe in '..\X2Log.Client.NamedPipe.pas',
+ X2Log.Client.Base in '..\X2Log.Client.Base.pas',
+ X2Log.Observer.Event in '..\X2Log.Observer.Event.pas',
+ X2Log.Constants in '..\X2Log.Constants.pas',
+ X2Log.Observer.Custom in '..\X2Log.Observer.Custom.pas';
{$R *.res}
diff --git a/NamedPipeClient/X2LogNamedPipeClient.dproj b/NamedPipeClient/X2LogNamedPipeClient.dproj
index eb8409d..0ee8f08 100644
--- a/NamedPipeClient/X2LogNamedPipeClient.dproj
+++ b/NamedPipeClient/X2LogNamedPipeClient.dproj
@@ -87,6 +87,11 @@
dfm
+
+
+
+
+
Cfg_2
Base
diff --git a/NamedPipeClient/source/MainFrm.pas b/NamedPipeClient/source/MainFrm.pas
index e0d0f07..a1d80d0 100644
--- a/NamedPipeClient/source/MainFrm.pas
+++ b/NamedPipeClient/source/MainFrm.pas
@@ -2,8 +2,12 @@ unit MainFrm;
interface
uses
- Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
- Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
+ System.Classes,
+ Vcl.Controls,
+ Vcl.Forms,
+ Vcl.StdCtrls,
+
+ X2Log.Intf;
type
@@ -12,232 +16,35 @@ type
procedure FormCreate(Sender: TObject);
private
- FClientThread: TThread;
-
- procedure DoMessage(Sender: TObject; Msg: TStream);
+ FClient: IX2LogObservable;
+ FObserver: IX2LogObserver;
+ protected
+ procedure DoLog(Sender: TObject; Level: TX2LogLevel; const Msg, Details: string);
end;
implementation
uses
- System.SyncObjs,
-
- X2Log.Intf;
+ X2Log.Constants,
+ X2Log.Client.NamedPipe,
+ X2Log.Observer.Event;
{$R *.dfm}
-type
- TClientMessageEvent = procedure(Sender: TObject; Msg: TStream) of object;
-
- TClientThread = class(TThread)
- private
- FTerminateEvent: TEvent;
- FPipe: THandle;
- FOverlappedRead: TOverlapped;
- FReadBuffer: array[0..4095] of Byte;
- FMessage: TMemoryStream;
- FOnMessage: TClientMessageEvent;
- protected
- procedure Execute; override;
- procedure TerminatedSet; override;
-
- procedure ReadMessage;
- procedure HandleMessage;
-
- procedure DoMessage;
- public
- constructor Create;
- destructor Destroy; override;
-
- property OnMessage: TClientMessageEvent read FOnMessage write FOnMessage;
- end;
-
-
{ TMainForm }
procedure TMainForm.FormCreate(Sender: TObject);
begin
- FClientThread := TClientThread.Create;
- (FClientThread as TClientThread).OnMessage := DoMessage;
+ FClient := TX2LogNamedPipeClient.Create('X2LogTest');
+ FObserver := TX2LogEventObserver.Create(DoLog);
+ FClient.Attach(FObserver);
end;
-procedure TMainForm.DoMessage(Sender: TObject; Msg: TStream);
-
- function ReadString: string;
- var
- size: Cardinal;
-
- begin
- Msg.ReadBuffer(size, SizeOf(cardinal));
- if size > 0 then
- begin
- SetLength(Result, size);
- Msg.ReadBuffer(Result[1], size * SizeOf(Char));
- end else
- Result := '';
- end;
-
-var
- level: TX2LogLevel;
- logMsg: string;
- detail: string;
-
+procedure TMainForm.DoLog(Sender: TObject; Level: TX2LogLevel; const Msg, Details: string);
begin
- Msg.ReadBuffer(level, SizeOf(TX2LogLevel));
- logMsg := ReadString;
- detail := ReadString;
-
- mmoLog.Lines.Add(logMsg + ' (' + detail + ')');
-end;
-
-
-const
- FILE_WRITE_ATTRIBUTES = $0100;
-
-{ TClientThread }
-constructor TClientThread.Create;
-begin
- FTerminateEvent := TEvent.Create(nil, True, False, '');
- FMessage := TMemoryStream.Create;
-
- inherited Create(False);
-end;
-
-destructor TClientThread.Destroy;
-begin
- FreeAndNil(FMessage);
- FreeAndNil(FTerminateEvent);
-
- inherited Destroy;
-end;
-
-
-procedure TClientThread.Execute;
-var
- mode: Cardinal;
- readEvent: TEvent;
- events: array[0..1] of THandle;
- waitResult: Cardinal;
- bytesTransferred: Cardinal;
-
-begin
- while not Terminated do
- begin
- FPipe := CreateFile('\\.\pipe\X2LogTest', GENERIC_READ or FILE_WRITE_ATTRIBUTES,
- 0, nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
-
- if FPipe = INVALID_HANDLE_VALUE then
- begin
- if GetLastError = ERROR_PIPE_BUSY then
- begin
- if not WaitNamedPipe('\\.\pipe\X2LogTest', 5000) then
- exit;
- end else
- RaiseLastOSError;
- end else
- break;
- end;
-
- if Terminated then
- exit;
-
- mode := PIPE_READMODE_MESSAGE;
- if not SetNamedPipeHandleState(FPipe, mode, nil, nil) then
- exit;
-
- readEvent := TEvent.Create(nil, False, False, '');
- events[0] := FTerminateEvent.Handle;
- events[1] := readEvent.Handle;
-
- FOverlappedRead.hEvent := readEvent.Handle;
- ReadMessage;
-
- while not Terminated do
- begin
- waitResult := WaitForMultipleObjects(Length(events), @events, False, INFINITE);
-
- case waitResult of
- WAIT_OBJECT_0:
- { Terminated }
- break;
-
- WAIT_OBJECT_0 + 1:
- { Read event completed }
- if GetOverlappedResult(FPipe, FOverlappedRead, bytesTransferred, False) then
- begin
- FMessage.WriteBuffer(FReadBuffer[0], bytesTransferred);
- HandleMessage;
- ReadMessage;
- end else
- begin
- if GetLastError = ERROR_MORE_DATA then
- begin
- FMessage.WriteBuffer(FReadBuffer[0], bytesTransferred);
- ReadMessage;
- end else
- break;
- end;
- end;
- end;
-
- CloseHandle(FPipe);
-end;
-
-
-procedure TClientThread.ReadMessage;
-var
- bytesRead: Cardinal;
- lastError: Cardinal;
-
-begin
- while True do
- begin
- if ReadFile(FPipe, FReadBuffer, SizeOf(FReadBuffer), bytesRead, @FOverlappedRead) then
- begin
- { Immediate result }
- FMessage.WriteBuffer(FReadBuffer[0], bytesRead);
- HandleMessage;
- end else
- begin
- { More data, pending I/O or an actual error }
- lastError := GetLastError;
-
- if lastError = ERROR_IO_PENDING then
- break
- else if lastError = ERROR_MORE_DATA then
- FMessage.WriteBuffer(FReadBuffer[0], SizeOf(FReadBuffer))
- else
- break;
- end;
- end;
-end;
-
-
-procedure TClientThread.HandleMessage;
-begin
- if FMessage.Size > 0 then
- begin
- FMessage.Position := 0;
- Synchronize(DoMessage);
- FMessage.Clear;
- end;
-end;
-
-
-procedure TClientThread.TerminatedSet;
-begin
- inherited TerminatedSet;
-
- FTerminateEvent.SetEvent;
-end;
-
-
-procedure TClientThread.DoMessage;
-begin
- if Assigned(FOnMessage) then
- FOnMessage(Self, FMessage);
+ mmoLog.Lines.Add(GetLogLevelText(Level) + ': ' + Msg + ' (' + Details + ')');
end;
end.
diff --git a/Test/X2LogTest.dpr b/Test/X2LogTest.dpr
index 7e8778a..9d2c5ca 100644
--- a/Test/X2LogTest.dpr
+++ b/Test/X2LogTest.dpr
@@ -19,7 +19,9 @@ uses
X2Log.Observer.NamedPipe in '..\X2Log.Observer.NamedPipe.pas',
X2Log.Observer.CustomThreaded in '..\X2Log.Observer.CustomThreaded.pas',
X2Log.Observer.MonitorForm in '..\X2Log.Observer.MonitorForm.pas' {X2LogObserverMonitorForm},
- X2Log.Global in '..\X2Log.Global.pas';
+ X2Log.Global in '..\X2Log.Global.pas',
+ X2Log.Client.NamedPipe in '..\X2Log.Client.NamedPipe.pas',
+ X2Log.Client.Base in '..\X2Log.Client.Base.pas';
{$R *.res}
diff --git a/Test/X2LogTest.dproj b/Test/X2LogTest.dproj
index 29eb114..73007d5 100644
--- a/Test/X2LogTest.dproj
+++ b/Test/X2LogTest.dproj
@@ -190,6 +190,8 @@
dfm
+
+
Cfg_2
Base
diff --git a/Test/resources/ObserverActive.bmp b/Test/resources/ObserverActive.bmp
new file mode 100644
index 0000000..60c218d
Binary files /dev/null and b/Test/resources/ObserverActive.bmp differ
diff --git a/Test/resources/ObserverInactive.bmp b/Test/resources/ObserverInactive.bmp
new file mode 100644
index 0000000..2c3c7ed
Binary files /dev/null and b/Test/resources/ObserverInactive.bmp differ
diff --git a/Test/source/MainFrm.dfm b/Test/source/MainFrm.dfm
index 175cd64..23f0f83 100644
--- a/Test/source/MainFrm.dfm
+++ b/Test/source/MainFrm.dfm
@@ -26,41 +26,148 @@ object MainForm: TMainForm
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
- ActivePage = tsEvent
+ ActivePage = tsFile
Align = alClient
+ Images = ilsObservers
TabOrder = 0
- OnChange = pcObserversChange
- ExplicitTop = 113
- ExplicitHeight = 361
object tsEvent: TTabSheet
Caption = 'Event Observer '
- ExplicitHeight = 333
object mmoEvent: TMemo
AlignWithMargins = True
Left = 8
- Top = 8
+ Top = 40
Width = 571
- Height = 261
+ Height = 229
Margins.Left = 8
- Margins.Top = 8
+ Margins.Top = 40
Margins.Right = 8
Margins.Bottom = 8
Align = alClient
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 0
- ExplicitHeight = 317
+ ExplicitTop = 41
+ end
+ object btnEventStart: TButton
+ Left = 8
+ Top = 8
+ Width = 75
+ Height = 25
+ Caption = 'Start'
+ TabOrder = 1
+ OnClick = btnEventStartClick
+ end
+ object btnEventStop: TButton
+ Left = 89
+ Top = 8
+ Width = 75
+ Height = 25
+ Caption = 'Stop'
+ TabOrder = 2
+ OnClick = btnEventStopClick
end
end
object tsFile: TTabSheet
Caption = 'File Observer'
- ImageIndex = 1
- ExplicitHeight = 333
+ ExplicitLeft = -108
+ ExplicitTop = -5
+ object lblFilename: TLabel
+ Left = 12
+ Top = 64
+ Width = 46
+ Height = 13
+ Caption = 'Filename:'
+ end
+ object btnFileStart: TButton
+ Left = 8
+ Top = 8
+ Width = 75
+ Height = 25
+ Caption = 'Start'
+ TabOrder = 0
+ OnClick = btnFileStartClick
+ end
+ object btnFileStop: TButton
+ Left = 89
+ Top = 8
+ Width = 75
+ Height = 25
+ Caption = 'Stop'
+ TabOrder = 1
+ OnClick = btnFileStopClick
+ end
+ object edtFilename: TEdit
+ Left = 88
+ Top = 61
+ Width = 489
+ Height = 21
+ TabOrder = 2
+ Text = 'X2LogTest\Test.log'
+ end
+ object rbProgramData: TRadioButton
+ Left = 88
+ Top = 88
+ Width = 113
+ Height = 17
+ Caption = 'Program Data'
+ Checked = True
+ TabOrder = 3
+ TabStop = True
+ end
+ object rbUserData: TRadioButton
+ Left = 88
+ Top = 111
+ Width = 113
+ Height = 17
+ Caption = 'User Application Data'
+ TabOrder = 4
+ end
+ object rbAbsolute: TRadioButton
+ Left = 88
+ Top = 134
+ Width = 113
+ Height = 17
+ Caption = 'Absolute path'
+ TabOrder = 5
+ end
end
object tsNamedPipe: TTabSheet
Caption = 'Named Pipe Observer'
- ImageIndex = 2
- ExplicitHeight = 333
+ ExplicitLeft = 0
+ ExplicitTop = 30
+ object lblPipeName: TLabel
+ Left = 12
+ Top = 64
+ Width = 53
+ Height = 13
+ Caption = 'Pipe name:'
+ end
+ object btnNamedPipeStart: TButton
+ Left = 8
+ Top = 8
+ Width = 75
+ Height = 25
+ Caption = 'Start'
+ TabOrder = 0
+ OnClick = btnNamedPipeStartClick
+ end
+ object btnNamedPipeStop: TButton
+ Left = 89
+ Top = 8
+ Width = 75
+ Height = 25
+ Caption = 'Stop'
+ TabOrder = 1
+ OnClick = btnNamedPipeStopClick
+ end
+ object edtPipeName: TEdit
+ Left = 88
+ Top = 61
+ Width = 489
+ Height = 21
+ TabOrder = 2
+ Text = 'X2LogTest'
+ end
end
end
object pnlButtons: TPanel
@@ -200,4 +307,92 @@ object MainForm: TMainForm
OnClick = btnLogClick
end
end
+ object ilsObservers: TImageList
+ Height = 12
+ Width = 12
+ Left = 552
+ Top = 176
+ Bitmap = {
+ 494C01010200140020000C000C00FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
+ 0000000000003600000028000000300000000C00000001002000000000000009
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 000000000000000000000000000000000000000000000000000000000000788D
+ F400274DEA00274DEA001C41E5001C37D8007380E20000000000000000000000
+ 000000000000000000000000000074C97D001EA7330017A83000139F29001695
+ 220071BB76000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000000000000000000000000000000000004C6EF7003C6B
+ FF003C6BFF003162FF003162FF002855F5001B3EE1003C4FD700000000000000
+ 0000000000000000000043BE560028C1520026BF4F0026BF4F0021BA44001BB0
+ 3800139F290039A0400000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000000000000000000000000000819BFD004876FF004674
+ FF004674FF004674FF003C6BFF003162FF002D5CFC001B3EE1007380E2000000
+ 0000000000007CD58B0030C9610030C961002FC85F0028C1520028C1520026BF
+ 4F001BB03800139F290071BB7600000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000000000000000000000000000517EFE005484FF005484
+ FF005484FF004B79FF004674FF004674FF003162FF002855F5001D38D8000000
+ 00000000000046CC6A0038D16B0038D16B0038D16B0036CE690030C9610028C1
+ 520028C152001BB0380016952200000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000000000000000000000000000749EFF006295FF006295
+ FF006295FF005B8CFF005484FF004674FF004674FF003162FF001C41E5000000
+ 0000000000005CDC850041DA740041DA740041DA740038D16B0038D16B0030C9
+ 610028C1520021BA4400139F2900000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000089B1FF0071A6FF0071A6
+ FF006DA2FF006599FF005B8CFF005484FF004674FF003C6BFF00274DEA000000
+ 0000000000006EE5940049E27C0049E27C0049E27C0041DA740041DA740038D1
+ 6B0030C9610028C152001BB03800000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 000000000000000000000000000000000000000000007CA7FF008EBFFF0080B8
+ FF007AB2FF0071A6FF006295FF005B8CFF004674FF003C6BFF00294EEA000000
+ 00000000000067E28D0067EE940053EC860053EC860049E27C0041DA740038D1
+ 6B0030C9610028C152001EA73300000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 000000000000000000000000000000000000000000009FBCFF00ADD6FF0091CB
+ FF0080B8FF007AB2FF006A9FFF005D90FF004B79FF004674FF00788DF4000000
+ 00000000000095EAAF008AF6AE0061F5920056EF89004EE7810046DF790041DA
+ 740036CE69002CC55A0074C97D00000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 000000000000000000000000000000000000000000000000000089B1FF00B4DF
+ FF0091CBFF007AB2FF006DA2FF006295FF00517EFE004876FF00000000000000
+ 0000000000000000000079E99D008EFBB20068F396004FE9830047E07A003DD6
+ 700036CE690046C45D0000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 000000000000000000000000000000000000000000000000000000000000A3C0
+ FF0089B1FF008EBFFF007CA7FF005484FF00819BFD0000000000000000000000
+ 000000000000000000000000000099EEB3006EE5940070E998005CE1870048D1
+ 6F0081DB93000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 000000000000000000000000000000000000424D3E000000000000003E000000
+ 28000000300000000C0000000100010000000000600000000000000000000000
+ 000000000000000000000000FFFFFF00FFFFFF0000000000E07E070000000000
+ C03C030000000000801801000000000080180100000000008018010000000000
+ 801801000000000080180100000000008018010000000000C03C030000000000
+ E07E070000000000FFFFFF000000000000000000000000000000000000000000
+ 000000000000}
+ end
end
diff --git a/Test/source/MainFrm.pas b/Test/source/MainFrm.pas
index 2d070be..3a9dd30 100644
--- a/Test/source/MainFrm.pas
+++ b/Test/source/MainFrm.pas
@@ -9,7 +9,7 @@ uses
Vcl.Forms,
Vcl.StdCtrls,
- X2Log.Intf;
+ X2Log.Intf, Vcl.ImgList;
type
@@ -32,22 +32,41 @@ type
btnInfo: TButton;
btnWarning: TButton;
btnError: TButton;
+ 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;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
- procedure pcObserversChange(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure btnLogClick(Sender: TObject);
procedure edtExceptionKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure edtMessageKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure btnExceptionClick(Sender: TObject);
procedure btnMonitorFormClick(Sender: TObject);
+ procedure btnEventStartClick(Sender: TObject);
+ procedure btnEventStopClick(Sender: TObject);
+ procedure btnFileStartClick(Sender: TObject);
+ procedure btnFileStopClick(Sender: TObject);
+ procedure btnNamedPipeStartClick(Sender: TObject);
+ procedure btnNamedPipeStopClick(Sender: TObject);
private
FLog: IX2Log;
- FObserver: IX2LogObserver;
+ FEventObserver: IX2LogObserver;
+ FFileObserver: IX2LogObserver;
+ FNamedPipeObserver: IX2LogObserver;
protected
- procedure InitObserver;
-
procedure DoLog(Sender: TObject; Level: TX2LogLevel; const Msg, Details: string);
end;
@@ -90,7 +109,6 @@ begin
FLog.SetExceptionStrategy(TX2LogmadExceptExceptionStrategy.Create);
pcObservers.ActivePageIndex := 0;
- InitObserver;
end;
@@ -100,37 +118,6 @@ begin
end;
-procedure TMainForm.InitObserver;
-var
- activePage: TTabSheet;
-
-begin
- if Assigned(FObserver) then
- begin
- FLog.Detach(FObserver);
- FObserver := nil;
- end;
-
- activePage := pcObservers.ActivePage;
-
- if activePage = tsEvent then
- FObserver := TX2LogEventObserver.Create(DoLog)
- else if activePage = tsFile then
- FObserver := TX2LogFileObserver.CreateInProgramData('X2LogTest\Test.log');
-
- if activePage = tsNamedPipe then
- begin
- FObserver := TX2LogNamedPipeObserver.Create('X2LogTest');
- end else
- begin
-
- end;
-
- if Assigned(FObserver) then
- FLog.Attach(FObserver);
-end;
-
-
procedure TMainForm.DoLog(Sender: TObject; Level: TX2LogLevel; const Msg, Details: string);
begin
mmoEvent.Lines.Add(GetLogLevelText(Level) + ': ' + Msg + ' (' + Details + ')');
@@ -156,12 +143,6 @@ begin
end;
end;
-procedure TMainForm.pcObserversChange(Sender: TObject);
-begin
- InitObserver;
-end;
-
-
procedure TMainForm.btnCloseClick(Sender: TObject);
begin
Close;
@@ -199,4 +180,82 @@ begin
TX2LogObserverMonitorForm.ShowInstance(FLog);
end;
+
+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;
+
end.
diff --git a/X2Log.Client.Base.pas b/X2Log.Client.Base.pas
new file mode 100644
index 0000000..0e50b54
--- /dev/null
+++ b/X2Log.Client.Base.pas
@@ -0,0 +1,76 @@
+unit X2Log.Client.Base;
+
+interface
+uses
+ System.Classes,
+ System.Generics.Collections,
+
+ X2Log.Intf;
+
+
+type
+ TX2LogBaseClient = class(TInterfacedPersistent, IX2LogObservable)
+ private
+ FObservers: TList;
+ protected
+ property Observers: TList read FObservers;
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ { IX2LogBase }
+ procedure Log(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string = ''); virtual;
+
+ { IX2LogObservable }
+ procedure Attach(AObserver: IX2LogObserver);
+ procedure Detach(AObserver: IX2LogObserver);
+ end;
+
+
+implementation
+uses
+ System.SysUtils;
+
+
+{ TX2LogBaseClient }
+constructor TX2LogBaseClient.Create;
+begin
+ inherited Create;
+
+ FObservers := TList.Create;
+end;
+
+
+destructor TX2LogBaseClient.Destroy;
+begin
+ FreeAndNil(FObservers);
+
+ inherited Destroy;
+end;
+
+
+procedure TX2LogBaseClient.Attach(AObserver: IX2LogObserver);
+begin
+ { Explicit cast ensures we're getting the same pointer in Attach and Detach
+ if, for example, the implementing interface is a descendant of IX2LogObserver }
+ Observers.Add(AObserver as IX2LogObserver);
+end;
+
+
+procedure TX2LogBaseClient.Detach(AObserver: IX2LogObserver);
+begin
+ Observers.Remove(AObserver as IX2LogObserver);
+end;
+
+
+procedure TX2LogBaseClient.Log(ALevel: TX2LogLevel; const AMessage, ADetails: string);
+var
+ observer: IX2LogObserver;
+
+begin
+ for observer in Observers do
+ observer.Log(ALevel, AMessage, ADetails);
+end;
+
+end.
+
diff --git a/X2Log.Client.NamedPipe.pas b/X2Log.Client.NamedPipe.pas
new file mode 100644
index 0000000..08085f1
--- /dev/null
+++ b/X2Log.Client.NamedPipe.pas
@@ -0,0 +1,310 @@
+unit X2Log.Client.NamedPipe;
+
+interface
+uses
+ System.Classes,
+ System.Generics.Collections,
+
+ X2Log.Intf,
+ X2Log.Client.Base;
+
+
+type
+ TX2LogNamedPipeClient = class(TX2LogBaseClient, IX2LogBase)
+ private
+ FWorkerThread: TThread;
+ protected
+ property WorkerThread: TThread read FWorkerThread;
+ public
+ constructor Create(const APipeName: string);
+ end;
+
+
+implementation
+uses
+ System.SyncObjs,
+ System.SysUtils,
+
+ Winapi.Windows;
+
+
+type
+ TX2LogNamedPipeClientWorkerThread = class(TThread)
+ private
+ FLog: IX2LogBase;
+ FPipeName: string;
+
+ FTerminateEvent: TEvent;
+ FPipeHandle: THandle;
+ FOverlappedRead: TOverlapped;
+ FReadBuffer: array[0..4095] of Byte;
+ FMessageData: TMemoryStream;
+ protected
+ procedure Execute; override;
+ procedure TerminatedSet; override;
+
+ procedure ConnectPipe;
+ procedure ReadPipe;
+ procedure ClosePipe;
+
+ procedure ReadMessage;
+ procedure HandleMessage;
+
+ property Log: IX2LogBase read FLog;
+ property PipeName: string read FPipeName;
+
+ property TerminateEvent: TEvent read FTerminateEvent;
+ property PipeHandle: THandle read FPipeHandle;
+ property MessageData: TMemoryStream read FMessageData;
+ public
+ constructor Create(ALog: IX2LogBase; const APipeName: string);
+ end;
+
+
+const
+ PipeNamePrefix = '\\.\pipe\';
+
+ TimeoutBusyPipe = 5000;
+ TimeoutNoPipe = 1000;
+
+ ClearBufferTreshold = 4096;
+
+
+
+{ TX2LogNamedPipeClient }
+constructor TX2LogNamedPipeClient.Create(const APipeName: string);
+begin
+ inherited Create;
+
+ FWorkerThread := TX2LogNamedPipeClientWorkerThread.Create(Self, APipeName);
+end;
+
+
+{ TX2LogNamedPipeClientWorkerThread }
+constructor TX2LogNamedPipeClientWorkerThread.Create(ALog: IX2LogBase; const APipeName: string);
+begin
+ FTerminateEvent := TEvent.Create(nil, True, False, '');
+ FMessageData := TMemoryStream.Create;
+
+ FLog := ALog;
+ FPipeName := APipeName;
+
+ inherited Create(False);
+end;
+
+
+procedure TX2LogNamedPipeClientWorkerThread.Execute;
+begin
+ FPipeHandle := INVALID_HANDLE_VALUE;
+ try
+ while not Terminated do
+ begin
+ ConnectPipe;
+
+ if not Terminated then
+ ReadPipe;
+ end;
+ finally
+ ClosePipe;
+ end;
+end;
+
+
+procedure TX2LogNamedPipeClientWorkerThread.TerminatedSet;
+begin
+ inherited TerminatedSet;
+
+ TerminateEvent.SetEvent;
+end;
+
+
+procedure TX2LogNamedPipeClientWorkerThread.ConnectPipe;
+var
+ lastError: Cardinal;
+ mode: Cardinal;
+
+begin
+ while not Terminated do
+ begin
+ FPipeHandle := CreateFile(PChar(PipeNamePrefix + PipeName), GENERIC_READ or FILE_WRITE_ATTRIBUTES,
+ 0, nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
+
+ if PipeHandle = INVALID_HANDLE_VALUE then
+ begin
+ lastError := GetLastError;
+
+ case lastError of
+ ERROR_PIPE_BUSY:
+ { Pipe exists but is connecting to another client, wait for a new slot }
+ WaitNamedPipe(PChar(PipeNamePrefix + PipeName), TimeoutBusyPipe);
+
+ ERROR_FILE_NOT_FOUND:
+ { Pipe does not exist, try again later }
+ WaitForSingleObject(TerminateEvent.Handle, TimeoutNoPipe);
+ else
+ RaiseLastOSError;
+ end;
+ end else
+ begin
+ { Change to message mode }
+ mode := PIPE_READMODE_MESSAGE;
+ if not SetNamedPipeHandleState(PipeHandle, mode, nil, nil) then
+ RaiseLastOSError;
+
+ break;
+ end;
+ end;
+end;
+
+
+procedure TX2LogNamedPipeClientWorkerThread.ReadPipe;
+var
+ readEvent: TEvent;
+ events: array[0..1] of THandle;
+ waitResult: Cardinal;
+ bytesTransferred: Cardinal;
+
+begin
+ readEvent := TEvent.Create(nil, False, False, '');
+ events[0] := TerminateEvent.Handle;
+ events[1] := readEvent.Handle;
+
+ FOverlappedRead.hEvent := readEvent.Handle;
+ ReadMessage;
+
+ while (not Terminated) and (PipeHandle <> INVALID_HANDLE_VALUE) do
+ begin
+ waitResult := WaitForMultipleObjects(Length(events), @events, False, INFINITE);
+
+ case waitResult of
+ WAIT_OBJECT_0:
+ { Terminated }
+ break;
+
+ WAIT_OBJECT_0 + 1:
+ { Read event completed }
+ if GetOverlappedResult(PipeHandle, FOverlappedRead, bytesTransferred, False) then
+ begin
+ MessageData.WriteBuffer(FReadBuffer[0], bytesTransferred);
+ HandleMessage;
+ ReadMessage;
+ end else
+ begin
+ if GetLastError = ERROR_MORE_DATA then
+ begin
+ MessageData.WriteBuffer(FReadBuffer[0], bytesTransferred);
+ ReadMessage;
+ end else
+ begin
+ ClosePipe;
+ break;
+ end;
+ end;
+ end;
+ end;
+end;
+
+
+procedure TX2LogNamedPipeClientWorkerThread.ClosePipe;
+begin
+ if PipeHandle <> INVALID_HANDLE_VALUE then
+ begin
+ CloseHandle(PipeHandle);
+ FPipeHandle := INVALID_HANDLE_VALUE;
+ end;
+end;
+
+
+procedure TX2LogNamedPipeClientWorkerThread.ReadMessage;
+var
+ bytesRead: Cardinal;
+ lastError: Cardinal;
+
+begin
+ while PipeHandle <> INVALID_HANDLE_VALUE do
+ begin
+ if ReadFile(PipeHandle, FReadBuffer, SizeOf(FReadBuffer), bytesRead, @FOverlappedRead) then
+ begin
+ { Immediate result }
+ MessageData.WriteBuffer(FReadBuffer[0], bytesRead);
+ HandleMessage;
+ end else
+ begin
+ { More data, pending I/O or an actual error }
+ lastError := GetLastError;
+
+ if lastError = ERROR_IO_PENDING then
+ break
+ else if lastError = ERROR_MORE_DATA then
+ MessageData.WriteBuffer(FReadBuffer[0], SizeOf(FReadBuffer))
+ else
+ begin
+ ClosePipe;
+ break;
+ end;
+ end;
+ end;
+end;
+
+
+procedure TX2LogNamedPipeClientWorkerThread.HandleMessage;
+
+ function ReadString: WideString;
+ var
+ size: Cardinal;
+
+ begin
+ MessageData.ReadBuffer(size, SizeOf(cardinal));
+ if size > 0 then
+ begin
+ SetLength(Result, size);
+ MessageData.ReadBuffer(Result[1], size * SizeOf(WideChar));
+ end else
+ Result := '';
+ end;
+
+
+var
+ header: TX2LogMessageHeaderV1;
+ headerDiff: Integer;
+ msg: string;
+ details: string;
+
+begin
+ if MessageData.Size > 0 then
+ begin
+ try
+ MessageData.Position := 0;
+ MessageData.ReadBuffer(header, SizeOf(header));
+
+ if header.ID <> X2LogMessageHeader then
+ raise EReadError.Create('Invalid header ID');
+
+ headerDiff := SizeOf(header) - header.Size;
+ if headerDiff > 0 then
+ begin
+ { A larger, most likely newer version, header }
+ MessageData.Seek(headerDiff, soFromCurrent)
+ end else if headerDiff < 0 then
+ raise EReadError.Create('Header too small');
+
+ msg := ReadString;
+ details := ReadString;
+
+ Log.Log(header.Level, msg, details);
+ except
+ on E:EReadError do
+ ClosePipe;
+
+ on E:Exception do
+ RaiseLastOSError;
+ end;
+
+ if MessageData.Size > ClearBufferTreshold then
+ MessageData.Clear
+ else
+ MessageData.Position := 0;
+ end;
+end;
+
+end.
diff --git a/X2Log.Global.pas b/X2Log.Global.pas
index d6172d1..4fd1cf6 100644
--- a/X2Log.Global.pas
+++ b/X2Log.Global.pas
@@ -22,7 +22,7 @@ type
class procedure SetExceptionStrategy(AStrategy: IX2LogExceptionStrategy);
- { Facade for IX2LogMethods }
+ { Facade for IX2LogBase }
class procedure Log(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string = '');
class procedure Verbose(const AMessage: string; const ADetails: string = '');
diff --git a/X2Log.Intf.pas b/X2Log.Intf.pas
index 34ca6b4..44f2100 100644
--- a/X2Log.Intf.pas
+++ b/X2Log.Intf.pas
@@ -8,13 +8,13 @@ type
TX2LogLevel = (Verbose, Info, Warning, Error);
- IX2LogMethods = interface
+ IX2LogBase = interface
['{1949E8DC-6DC5-43DC-B678-55CF8274E79D}']
procedure Log(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string = '');
end;
- IX2LogObserver = interface(IX2LogMethods)
+ IX2LogObserver = interface(IX2LogBase)
['{CBC5C18E-84EE-43F4-8DBE-C66D06FCDE74}']
end;
@@ -25,11 +25,15 @@ type
end;
- IX2Log = interface(IX2LogMethods)
- ['{A6FF38F9-EDA8-4C76-9C95-2C0317560D78}']
+ IX2LogObservable = interface(IX2LogBase)
+ ['{50B47D5D-11E4-40E0-BBC4-8BA70697C1F9}']
procedure Attach(AObserver: IX2LogObserver);
procedure Detach(AObserver: IX2LogObserver);
+ end;
+
+ IX2Log = interface(IX2LogObservable)
+ ['{A6FF38F9-EDA8-4C76-9C95-2C0317560D78}']
procedure SetExceptionStrategy(AStrategy: IX2LogExceptionStrategy);
procedure Verbose(const AMessage: string; const ADetails: string = '');
@@ -40,6 +44,30 @@ type
end;
+
+ TX2LogMessageHeaderV1 = packed record
+ ID: Word;
+ Version: Byte;
+ Size: Word;
+ Level: TX2LogLevel;
+
+ {
+ Payload:
+
+ MessageLength: Cardinal
+ Message: WideString
+ DetailsLength: Cardinal
+ Details: WideString
+ }
+ end;
+
+ TX2LogMessageHeader = TX2LogMessageHeaderV1;
+
+const
+ X2LogMessageHeader: Word = $B258;
+ X2LogMessageVersion: Byte = 1;
+
+
implementation
end.
diff --git a/X2Log.Observer.CustomThreaded.pas b/X2Log.Observer.CustomThreaded.pas
index 75a5419..1011ff2 100644
--- a/X2Log.Observer.CustomThreaded.pas
+++ b/X2Log.Observer.CustomThreaded.pas
@@ -174,6 +174,8 @@ var
entry: TX2LogQueueEntry;
begin
+ NameThreadForDebugging('TX2LogObserverWorkerThread');
+
Setup;
try
while not Terminated do
diff --git a/X2Log.Observer.Event.pas b/X2Log.Observer.Event.pas
index fa7e297..fa5651f 100644
--- a/X2Log.Observer.Event.pas
+++ b/X2Log.Observer.Event.pas
@@ -13,23 +13,30 @@ type
TX2LogEventObserver = class(TX2LogCustomObserver)
private
FOnLog: TX2LogEvent;
+ FRunInMainThread: Boolean;
protected
procedure DoLog(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string = ''); override;
public
constructor Create(ALogLevels: TX2LogLevels = X2LogLevelsDefault); overload;
constructor Create(AOnLog: TX2LogEvent; ALogLevels: TX2LogLevels = X2LogLevelsDefault); overload;
+ property RunInMainThread: Boolean read FRunInMainThread write FRunInMainThread default True;
+
property OnLog: TX2LogEvent read FOnLog write FOnLog;
end;
implementation
+uses
+ System.Classes;
{ TX2LogEventObserver }
constructor TX2LogEventObserver.Create(ALogLevels: TX2LogLevels);
begin
inherited Create(ALogLevels);
+
+ FRunInMainThread := True;
end;
@@ -44,7 +51,18 @@ end;
procedure TX2LogEventObserver.DoLog(ALevel: TX2LogLevel; const AMessage, ADetails: string);
begin
if Assigned(FOnLog) then
- FOnLog(Self, ALevel, AMessage, ADetails);
+ begin
+ if RunInMainThread then
+ begin
+ TThread.Queue(nil,
+ procedure
+ begin
+ if Assigned(FOnLog) then
+ FOnLog(Self, ALevel, AMessage, ADetails);
+ end);
+ end else
+ FOnLog(Self, ALevel, AMessage, ADetails);
+ end;
end;
end.
diff --git a/X2Log.Observer.MonitorForm.dfm b/X2Log.Observer.MonitorForm.dfm
index 6dd97db..059f369 100644
--- a/X2Log.Observer.MonitorForm.dfm
+++ b/X2Log.Observer.MonitorForm.dfm
@@ -35,7 +35,6 @@ object X2LogObserverMonitorForm: TX2LogObserverMonitorForm
Align = alRight
BevelOuter = bvNone
TabOrder = 0
- ExplicitHeight = 500
object tbDetails: TToolBar
Left = 0
Top = 0
@@ -69,7 +68,6 @@ object X2LogObserverMonitorForm: TX2LogObserverMonitorForm
BevelKind = bkFlat
BevelOuter = bvNone
TabOrder = 1
- ExplicitHeight = 478
object HeaderControl1: THeaderControl
Left = 0
Top = 0
@@ -101,7 +99,6 @@ object X2LogObserverMonitorForm: TX2LogObserverMonitorForm
ReadOnly = True
ScrollBars = ssBoth
TabOrder = 1
- ExplicitHeight = 457
end
end
end
@@ -113,7 +110,6 @@ object X2LogObserverMonitorForm: TX2LogObserverMonitorForm
Align = alClient
BevelOuter = bvNone
TabOrder = 1
- ExplicitHeight = 500
object vstLog: TVirtualStringTree
Left = 0
Top = 22
@@ -138,7 +134,6 @@ object X2LogObserverMonitorForm: TX2LogObserverMonitorForm
OnGetImageIndex = vstLogGetImageIndex
OnGetHint = vstLogGetHint
OnInitNode = vstLogInitNode
- ExplicitHeight = 478
Columns = <
item
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coShowDropMark, coVisible, coAllowFocus]
@@ -199,7 +194,7 @@ object X2LogObserverMonitorForm: TX2LogObserverMonitorForm
Left = 584
Top = 48
Bitmap = {
- 494C0101090040007C0010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
+ 494C010109004000800010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000400000003000000001002000000000000030
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
diff --git a/X2Log.Observer.NamedPipe.pas b/X2Log.Observer.NamedPipe.pas
index 39f96ad..6b5776b 100644
--- a/X2Log.Observer.NamedPipe.pas
+++ b/X2Log.Observer.NamedPipe.pas
@@ -20,6 +20,7 @@ type
implementation
uses
+ System.Classes,
System.Generics.Collections,
System.SyncObjs,
System.SysUtils,
@@ -35,15 +36,18 @@ type
TX2LogNamedPipeClient = class(TObject)
private
FOverlapped: TOverlapped;
- FPipe: THandle;
+ FPipeHandle: THandle;
FState: TX2LogNamedPipeClientState;
FOverlappedEvent: TEvent;
FWriteQueue: TObjectQueue;
- FWriteBuffer: Pointer;
- FWriteBufferSize: Integer;
+ FWriteBuffer: TMemoryStream;
protected
function DoSend(AEntry: TX2LogQueueEntry): Boolean;
procedure ClearWriteBuffer;
+
+ property PipeHandle: THandle read FPipeHandle;
+ property WriteBuffer: TMemoryStream read FWriteBuffer;
+ property WriteQueue: TObjectQueue read FWriteQueue;
public
constructor Create(APipe: THandle);
destructor Destroy; override;
@@ -53,7 +57,7 @@ type
procedure Disconnect;
- property Pipe: THandle read FPipe;
+ property Pipe: THandle read FPipeHandle;
property Overlapped: TOverlapped read FOverlapped;
property OverlappedEvent: TEvent read FOverlappedEvent;
property State: TX2LogNamedPipeClientState read FState write FState;
@@ -65,7 +69,6 @@ type
FClients: TObjectList;
FPipeName: string;
protected
-
procedure WaitForEntry; override;
procedure ProcessEntry(AEntry: TX2LogQueueEntry); override;
procedure ProcessClientEvent(AClientIndex: Integer);
@@ -103,7 +106,7 @@ constructor TX2LogNamedPipeClient.Create(APipe: THandle);
begin
inherited Create;
- FPipe := APipe;
+ FPipeHandle := APipe;
FState := Listening;
FOverlappedEvent := TEvent.Create(nil, False, False, '');
@@ -115,8 +118,8 @@ destructor TX2LogNamedPipeClient.Destroy;
begin
FreeAndNil(FOverlappedEvent);
- if FPipe <> INVALID_HANDLE_VALUE then
- DisconnectNamedPipe(FPipe);
+ if PipeHandle <> INVALID_HANDLE_VALUE then
+ DisconnectNamedPipe(PipeHandle);
ClearWriteBuffer;
@@ -126,14 +129,14 @@ end;
procedure TX2LogNamedPipeClient.Send(AEntry: TX2LogQueueEntry);
begin
- if not Assigned(FWriteBuffer) then
+ if not Assigned(WriteBuffer) then
DoSend(AEntry)
else
begin
- if not Assigned(FWriteQueue) then
+ if not Assigned(WriteQueue) then
FWriteQueue := TObjectQueue.Create(True);
- FWriteQueue.Enqueue(TX2LogQueueEntry.Create(AEntry));
+ WriteQueue.Enqueue(TX2LogQueueEntry.Create(AEntry));
end;
end;
@@ -145,15 +148,18 @@ var
begin
ClearWriteBuffer;
- while FWriteQueue.Count > 0 do
+ if Assigned(WriteQueue) then
begin
- entry := FWriteQueue.Extract;
- try
- { Returns False when IO is pending }
- if not DoSend(entry) then
- break;
- finally
- FreeAndNil(entry);
+ while WriteQueue.Count > 0 do
+ begin
+ entry := WriteQueue.Extract;
+ try
+ { Returns False when IO is pending }
+ if not DoSend(entry) then
+ break;
+ finally
+ FreeAndNil(entry);
+ end;
end;
end;
end;
@@ -161,55 +167,49 @@ end;
procedure TX2LogNamedPipeClient.Disconnect;
begin
- if FPipe <> INVALID_HANDLE_VALUE then
+ if PipeHandle <> INVALID_HANDLE_VALUE then
begin
- CancelIo(FPipe);
- DisconnectNamedPipe(FPipe);
+ CancelIo(PipeHandle);
+ DisconnectNamedPipe(PipeHandle);
- FPipe := INVALID_HANDLE_VALUE;
+ FPipeHandle := INVALID_HANDLE_VALUE;
end;
end;
function TX2LogNamedPipeClient.DoSend(AEntry: TX2LogQueueEntry): Boolean;
- procedure AppendToBuffer(var APointer: PByte; const ASource; ASize: Cardinal); overload; inline;
- begin
- Move(ASource, APointer^, ASize);
- Inc(APointer, ASize);
- end;
-
- procedure AppendToBuffer(var APointer: PByte; const ASource: string); overload; inline;
+ procedure WriteString(const ASource: WideString);
var
sourceLength: Cardinal;
begin
sourceLength := Length(ASource);
- AppendToBuffer(APointer, sourceLength, SizeOf(Cardinal));
- AppendToBuffer(APointer, PChar(ASource)^, sourceLength * SizeOf(Char));
+ WriteBuffer.WriteBuffer(sourceLength, SizeOf(Cardinal));
+ WriteBuffer.WriteBuffer(PWideChar(ASource)^, sourceLength * SizeOf(WideChar));
end;
var
+ header: TX2LogMessageHeader;
bytesWritten: Cardinal;
- bufferPointer: PByte;
lastError: Cardinal;
begin
ClearWriteBuffer;
- FWriteBufferSize := SizeOf(TX2LogLevel) +
- SizeOf(Cardinal) + (Length(AEntry.Message) * SizeOf(Char)) +
- SizeOf(Cardinal) + (Length(AEntry.Details) * SizeOf(Char));
+ FWriteBuffer := TMemoryStream.Create;
- GetMem(FWriteBuffer, FWriteBufferSize);
+ header.ID := X2LogMessageHeader;
+ header.Version := X2LogMessageVersion;
+ header.Size := SizeOf(header);
+ header.Level := AEntry.Level;
- bufferPointer := FWriteBuffer;
- AppendToBuffer(bufferPointer, AEntry.Level, SizeOf(TX2LogLevel));
- AppendToBuffer(bufferPointer, AEntry.Message);
- AppendToBuffer(bufferPointer, AEntry.Details);
+ WriteBuffer.WriteBuffer(header, SizeOf(header));
+ WriteString(AEntry.Message);
+ WriteString(AEntry.Details);
- Result := WriteFile(Pipe, FWriteBuffer^, FWriteBufferSize, bytesWritten, @Overlapped);
+ Result := WriteFile(Pipe, WriteBuffer.Memory^, WriteBuffer.Size, bytesWritten, @Overlapped);
if not Result then
begin
lastError := GetLastError;
@@ -233,11 +233,7 @@ end;
procedure TX2LogNamedPipeClient.ClearWriteBuffer;
begin
- if Assigned(FWriteBuffer) then
- begin
- FreeMem(FWriteBuffer, FWriteBufferSize);
- FWriteBuffer := nil;
- end;
+ FreeAndNil(FWriteBuffer);
end;
diff --git a/X2Log.pas b/X2Log.pas
index cd5da64..f20a71e 100644
--- a/X2Log.pas
+++ b/X2Log.pas
@@ -6,30 +6,22 @@ uses
System.Generics.Collections,
System.SysUtils,
- X2Log.Intf;
+ X2Log.Intf,
+ X2Log.Client.Base;
type
- TX2Log = class(TInterfacedObject, IX2Log, IX2LogMethods)
+ TX2Log = class(TX2LogBaseClient, IX2Log)
private
FExceptionStrategy: IX2LogExceptionStrategy;
- FObservers: TList;
private
property ExceptionStrategy: IX2LogExceptionStrategy read FExceptionStrategy;
- property Observers: TList read FObservers;
public
constructor Create;
- destructor Destroy; override;
{ IX2Log }
- procedure Attach(AObserver: IX2LogObserver);
- procedure Detach(AObserver: IX2LogObserver);
-
procedure SetExceptionStrategy(AStrategy: IX2LogExceptionStrategy);
- { IX2LogMethods }
- procedure Log(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string = '');
-
procedure Verbose(const AMessage: string; const ADetails: string = '');
procedure Info(const AMessage: string; const ADetails: string = '');
procedure Warning(const AMessage: string; const ADetails: string = '');
@@ -48,33 +40,10 @@ constructor TX2Log.Create;
begin
inherited Create;
- FObservers := TList.Create;
SetExceptionStrategy(nil);
end;
-destructor TX2Log.Destroy;
-begin
- FreeAndNil(FObservers);
-
- inherited Destroy;
-end;
-
-
-procedure TX2Log.Attach(AObserver: IX2LogObserver);
-begin
- { Explicit cast ensures we're getting the same pointer in Attach and Detach
- if, for example, the implementing interface is a descendant of IX2LogObserver }
- Observers.Add(AObserver as IX2LogObserver);
-end;
-
-
-procedure TX2Log.Detach(AObserver: IX2LogObserver);
-begin
- Observers.Remove(AObserver as IX2LogObserver);
-end;
-
-
procedure TX2Log.SetExceptionStrategy(AStrategy: IX2LogExceptionStrategy);
begin
if Assigned(AStrategy) then
@@ -84,16 +53,6 @@ begin
end;
-procedure TX2Log.Log(ALevel: TX2LogLevel; const AMessage, ADetails: string);
-var
- observer: IX2LogObserver;
-
-begin
- for observer in Observers do
- observer.Log(ALevel, AMessage, ADetails);
-end;
-
-
procedure TX2Log.Verbose(const AMessage, ADetails: string);
begin
Log(TX2LogLevel.Verbose, AMessage, ADetails);