I created a class for writing thread-safe log in a text file using CriticalSection.
I am not an expert of CriticalSection and multi-threading programming (...and Delphi), I'm definitely doing something wrong...
unit ErrorLog;
interface
uses
Winapi.Windows, System.SysUtils;
type
TErrorLog = class
private
FTextFile : TextFile;
FLock : TRTLCriticalSection;
public
constructor Create(const aLogFilename:string);
destructor Destroy; override;
procedure Write(const ErrorText: string);
end;
implementation
constructor TErrorLog.Create(const aLogFilename:string);
begin
inherited Create;
InitializeCriticalSection(FLock);
AssignFile(FTextFile, aLogFilename);
if FileExists(aLogFilename) then
Append(FTextFile)
else
Rewrite(FTextFile);
end;
destructor TErrorLog.Destroy;
const
fmTextOpenWrite = 55218;
begin
EnterCriticalSection(FLock);
try
if TTextRec(FTextFile).Mode <> fmTextOpenWrite then
CloseFile(FTextFile);
inherited Destroy;
finally
LeaveCriticalSection(FLock);
DeleteCriticalSection(FLock);
end;
end;
procedure TErrorLog.Write(const ErrorText: string);
begin
EnterCriticalSection(FLock);
try
WriteLn(FTextFile, ErrorText);
finally
LeaveCriticalSection(FLock);
end;
end;
end.
to test the class I created a form with a timer set to 100 milliseconds:
procedure TForm1.Timer1Timer(Sender: TObject);
var
I : integer;
aErrorLog : TErrorLog;
begin
aErrorLog := nil;
for I := 0 to 1000 do begin
try
aErrorLog := TErrorLog.Create(FormatDateTime('ddmmyyyy', Now) + '.txt');
aErrorLog.Write('new line');
finally
if Assigned(aErrorLog) then FreeAndNil(aErrorLog);
end;
end;
end;
the logs are written, but occasionally raise I/O Error 32 exception on CloseFile(FTextFile) (probably because in use in another thread)
where am I doing wrong?
UPDATE:
after reading all the comments and the answers I have totally changed approach. I share my solution.
ThreadUtilities.pas
(* Implemented for Delphi3000.com Articles, 11/01/2004
Chris Baldwin
Director & Chief Architect
Alive Technology Limited
http://www.alivetechnology.com
*)
unit ThreadUtilities;
interface
uses Windows, SysUtils, Classes;
type
EThreadStackFinalized = class(Exception);
TSimpleThread = class;
// Thread Safe Pointer Queue
TThreadQueue = class
private
FFinalized: Boolean;
FIOQueue: THandle;
public
constructor Create;
destructor Destroy; override;
procedure Finalize;
procedure Push(Data: Pointer);
function Pop(var Data: Pointer): Boolean;
property Finalized: Boolean read FFinalized;
end;
TThreadExecuteEvent = procedure (Thread: TThread) of object;
TSimpleThread = class(TThread)
private
FExecuteEvent: TThreadExecuteEvent;
protected
procedure Execute(); override;
public
constructor Create(CreateSuspended: Boolean; ExecuteEvent: TThreadExecuteEvent; AFreeOnTerminate: Boolean);
end;
TThreadPoolEvent = procedure (Data: Pointer; AThread: TThread) of Object;
TThreadPool = class(TObject)
private
FThreads: TList;
FThreadQueue: TThreadQueue;
FHandlePoolEvent: TThreadPoolEvent;
procedure DoHandleThreadExecute(Thread: TThread);
public
constructor Create( HandlePoolEvent: TThreadPoolEvent; MaxThreads: Integer = 1); virtual;
destructor Destroy; override;
procedure Add(const Data: Pointer);
end;
implementation
{ TThreadQueue }
constructor TThreadQueue.Create;
begin
//-- Create IO Completion Queue
FIOQueue := CreateIOCompletionPort(INVALID_HANDLE_VALUE, 0, 0, 0);
FFinalized := False;
end;
destructor TThreadQueue.Destroy;
begin
//-- Destroy Completion Queue
if (FIOQueue <> 0) then
CloseHandle(FIOQueue);
inherited;
end;
procedure TThreadQueue.Finalize;
begin
//-- Post a finialize pointer on to the queue
PostQueuedCompletionStatus(FIOQueue, 0, 0, Pointer($FFFFFFFF));
FFinalized := True;
end;
(* Pop will return false if the queue is completed *)
function TThreadQueue.Pop(var Data: Pointer): Boolean;
var
A: Cardinal;
OL: POverLapped;
begin
Result := True;
if (not FFinalized) then
//-- Remove/Pop the first pointer from the queue or wait
GetQueuedCompletionStatus(FIOQueue, A, ULONG_PTR(Data), OL, INFINITE);
//-- Check if we have finalized the queue for completion
if FFinalized or (OL = Pointer($FFFFFFFF)) then begin
Data := nil;
Result := False;
Finalize;
end;
end;
procedure TThreadQueue.Push(Data: Pointer);
begin
if FFinalized then
Raise EThreadStackFinalized.Create('Stack is finalized');
//-- Add/Push a pointer on to the end of the queue
PostQueuedCompletionStatus(FIOQueue, 0, Cardinal(Data), nil);
end;
{ TSimpleThread }
constructor TSimpleThread.Create(CreateSuspended: Boolean;
ExecuteEvent: TThreadExecuteEvent; AFreeOnTerminate: Boolean);
begin
FreeOnTerminate := AFreeOnTerminate;
FExecuteEvent := ExecuteEvent;
inherited Create(CreateSuspended);
end;
procedure TSimpleThread.Execute;
begin
if Assigned(FExecuteEvent) then
FExecuteEvent(Self);
end;
{ TThreadPool }
procedure TThreadPool.Add(const Data: Pointer);
begin
FThreadQueue.Push(Data);
end;
constructor TThreadPool.Create(HandlePoolEvent: TThreadPoolEvent;
MaxThreads: Integer);
begin
FHandlePoolEvent := HandlePoolEvent;
FThreadQueue := TThreadQueue.Create;
FThreads := TList.Create;
while FThreads.Count < MaxThreads do
FThreads.Add(TSimpleThread.Create(False, DoHandleThreadExecute, False));
end;
destructor TThreadPool.Destroy;
var
t: Integer;
begin
FThreadQueue.Finalize;
for t := 0 to FThreads.Count-1 do
TThread(FThreads[t]).Terminate;
while (FThreads.Count > 0) do begin
TThread(FThreads[0]).WaitFor;
TThread(FThreads[0]).Free;
FThreads.Delete(0);
end;
FThreadQueue.Free;
FThreads.Free;
inherited;
end;
procedure TThreadPool.DoHandleThreadExecute(Thread: TThread);
var
Data: Pointer;
begin
while FThreadQueue.Pop(Data) and (not TSimpleThread(Thread).Terminated) do begin
try
FHandlePoolEvent(Data, Thread);
except
end;
end;
end;
end.
ThreadFileLog.pas
(* From: http://delphi.cjcsoft.net/viewthread.php?tid=45763 *)
unit ThreadFileLog;
interface
uses Windows, ThreadUtilities, System.Classes;
type
PLogRequest = ^TLogRequest;
TLogRequest = record
LogText : String;
FileName : String;
end;
TThreadFileLog = class(TObject)
private
FThreadPool: TThreadPool;
procedure HandleLogRequest(Data: Pointer; AThread: TThread);
public
constructor Create();
destructor Destroy; override;
procedure Log(const FileName, LogText: string);
end;
implementation
uses
System.SysUtils;
(* Simple reuse of a logtofile function for example *)
procedure LogToFile(const FileName, LogString: String);
var
F: TextFile;
begin
AssignFile(F, FileName);
if not FileExists(FileName) then
Rewrite(F)
else
Append(F);
try
Writeln(F, LogString);
finally
CloseFile(F);
end;
end;
constructor TThreadFileLog.Create();
begin
FThreadPool := TThreadPool.Create(HandleLogRequest, 1);
end;
destructor TThreadFileLog.Destroy;
begin
FThreadPool.Free;
inherited;
end;
procedure TThreadFileLog.HandleLogRequest(Data: Pointer; AThread: TThread);
var
Request: PLogRequest;
begin
Request := Data;
try
LogToFile(Request^.FileName, Request^.LogText);
finally
Dispose(Request);
end;
end;
procedure TThreadFileLog.Log(const FileName, LogText: string);
var
Request: PLogRequest;
begin
New(Request);
Request^.LogText := LogText;
Request^.FileName := FileName;
FThreadPool.Add(Request);
end;
end.
Basic form example
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls,
Vcl.StdCtrls, ThreadFileLog;
type
TForm1 = class(TForm)
BtnStart: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure BtnStartClick(Sender: TObject);
private
FThreadFileLog : TThreadFileLog;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.BtnStartClick(Sender: TObject);
var
I : integer;
aNow : TDateTime;
begin
aNow := Now;
for I := 0 to 500 do
FThreadFileLog.Log(
FormatDateTime('ddmmyyyyhhnn', aNow) + '.txt',
FormatDateTime('dd-mm-yyyy hh:nn:ss.zzz', aNow) + ': I: ' + I.ToString
);
ShowMessage('logs are performed!');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FThreadFileLog := TThreadFileLog.Create();
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FThreadFileLog.Free;
ReportMemoryLeaksOnShutdown := true;
end;
end.
Output log:
30-11-2014 14.01.13.252: I: 0
30-11-2014 14.01.13.252: I: 1
30-11-2014 14.01.13.252: I: 2
30-11-2014 14.01.13.252: I: 3
30-11-2014 14.01.13.252: I: 4
30-11-2014 14.01.13.252: I: 5
30-11-2014 14.01.13.252: I: 6
30-11-2014 14.01.13.252: I: 7
30-11-2014 14.01.13.252: I: 8
30-11-2014 14.01.13.252: I: 9
...
30-11-2014 14.01.13.252: I: 500
Instead of checking TTextRec(FTextFile).Mode <> fmTextOpenWrite you should check whether your file is closed or not, and if it is not closed then you close it.
Try replacing the mentioned check with this code:
if TTextRec(FTextFile).Mode <> fmClosed then
CloseFile(FTextFile);
Edited:
This has nothing to do with antivirus locking the file. This is just a simple mistake in the destructor.
File is already opened in open write mode, original code is closing the file only when it is not in open write mode - so it is never closing the file.
Hope this explains where the mistake has happened.
As for the overall design of the logger's class. This was not the question, questions was simple, and I've provided a simple and working solution.
I think that if Simone would want us to teach him how to design logger class then he would ask for it.