From 32847f4988bbbb62010a7b3ee9db47470efa81f8 Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Sun, 25 May 2014 14:20:58 +0000 Subject: [PATCH] Added: RunInMainThread property for Event Observer Added: Named pipe client - uses standard observers to output log --- NamedPipeClient/X2LogNamedPipeClient.dpr | 7 +- NamedPipeClient/X2LogNamedPipeClient.dproj | 5 + NamedPipeClient/source/MainFrm.pas | 229 ++------------- Test/X2LogTest.dpr | 4 +- Test/X2LogTest.dproj | 2 + Test/resources/ObserverActive.bmp | Bin 0 -> 1222 bytes Test/resources/ObserverInactive.bmp | Bin 0 -> 1222 bytes Test/source/MainFrm.dfm | 221 ++++++++++++++- Test/source/MainFrm.pas | 145 +++++++--- X2Log.Client.Base.pas | 76 +++++ X2Log.Client.NamedPipe.pas | 310 +++++++++++++++++++++ X2Log.Global.pas | 2 +- X2Log.Intf.pas | 36 ++- X2Log.Observer.CustomThreaded.pas | 2 + X2Log.Observer.Event.pas | 20 +- X2Log.Observer.MonitorForm.dfm | 7 +- X2Log.Observer.NamedPipe.pas | 90 +++--- X2Log.pas | 47 +--- 18 files changed, 831 insertions(+), 372 deletions(-) create mode 100644 Test/resources/ObserverActive.bmp create mode 100644 Test/resources/ObserverInactive.bmp create mode 100644 X2Log.Client.Base.pas create mode 100644 X2Log.Client.NamedPipe.pas 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 0000000000000000000000000000000000000000..60c218de6ffb59fcb565e2065719db61b32e90ea GIT binary patch literal 1222 zcmZ?rJ;uTS24+B71IXfmVnzlIu=oTZd6*A^85n^aApQ@8VpEkEgyyO;2+!AKkXvrd zAilzYL1KjwgZwH}2I&nJ3^E%m8RWLvF<35eU{KuU!l1mzgF$7l7lYb1S7{s7;IE+F2NH~Me(I^J}6Y&fNCleWrPNy=MoK0siJD15|ej$s& z;$k*~)#Y3Uo2&T@w$}<6+>XRDxSh#j@VJ=I;Bd2;!SPlJgY%s-2Dkf_3?(OP8A{L8 zGq^vfV(@ra&EWZ{h9TxoD?`oIZU(>SjST)Tn;Bvrwlf3(>EJhQ3}Np(8PXs1GUPp- z!jS%M3PZum84Q&#=Q1RIoy3swc^X6G?a2&NU#(~8`nHZ?=DW=deZMz>!)KHj4S|sq z0{{R2NB6EK3oA3DAXrpDgrA>>gP9x1(U+8z5E0?$UfNQ#JX01FR2H8nLk zIY|*7W(EdxU0q!uPf`R})|gqCnCODoz=Fum-rCeaLrq3p6KIf?qm7}qqKp#Q0ta(T LBNbaP6F~p~3B`4g literal 0 HcmV?d00001 diff --git a/Test/resources/ObserverInactive.bmp b/Test/resources/ObserverInactive.bmp new file mode 100644 index 0000000000000000000000000000000000000000..2c3c7edc4cb7ab9a3447a5ed477e58cd97ab0c2f GIT binary patch literal 1222 zcmeH{&r4KM9K}DQAwxRxh=(FiC6ni`VHjhy(VC2DA;F|EpkQPWf{O~Hm_al&9MC{0 z8&MY#WEj*cqHqx+6$FB~FL#pIW}sa^7S)_?Pr*fhLf*?c_ndp-`-KDdd!}>s0Ny%o z&U&LtcHzVC-DeHIKePjU#u&)#is%NFts6M)pNO6RNM(GBiuh;TM2@=797hvhXz0pO z-}8-7-!G2!i8ox$8fO-^kOE7G0^IoE;L05u?XM@^+qNMs!bz3zMRE zN?g1v`liLDtVoS-k;-f{eD5olXGQHSZk1z95k!K)##&=6GiyT8 p=5WxhvaN&A8f$9~*BvRdYfPcYskU&VTVColI2nnCoF-51(H~toguMU& literal 0 HcmV?d00001 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);