Delphi multi-threading file write: I/O error 32

Question

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

Answer 1

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.

Answer 2

If you want an error log class, where multiple threads can write to a log file, it is correct to protect the writing method with a critical section.

Now, since you will only instantiate one of those error logging objects in your application, there is no need to protect the destructor method with a critical section.

The location of your error log file should reside in the application data folder.

The I/O error 32 is: The process cannot access the file because it is being used by another process.

The reason for this sharing violation could be in your application or an external application. Writing inside the application directory could trigger some antivirus protection for example. Or your application is holding the file open in several places with different file modes.

Your test is flawed in multiple ways:

• Instantiate the error log class once at application start, and destroy it when the application closes.
• Write to your error log from different threads, not from multiple iterations within a timer event.
• A timer event should only execute a program sequence for a short duration.

• A try / finally sequence is structured like this:

  anObject := TObject.Create;
  try
    // Do something with anObject
  finally
    anObject.Free;
  end;