multithreadingdelphicritical-section

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


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

Solution

  • 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.