Многопоточный файл Delphi write: Ошибка ввода-вывода 32

Question

Я создал класс для записи потокобезопасного журнала в текстовом файле с использованием CriticalSection.

Я не эксперт CriticalSection и многопоточного программирование (... и Delphi), я определенно делаю что-то неправильно ...

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. 

протестировать класс, который я создал форму с таймер установлен на 100 миллисекунд:

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; 

написаны журналы, но иногда поднимает I/O Error 32 исключения на CloseFile(FTextFile) (вероятно, потому, что при использовании в другом потоке)

где я делаю неправильно?

UPDATE:

после прочтения всех комментариев и ответов я полностью изменил подход. Я разделяю свое решение.

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 Пример формы

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. 

журнал Выход:

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

Вместо проверки TTextRec(FTextFile).Mode <> fmTextOpenWrite вы должны проверить, является ли файл закрыт или нет, и если это не закрыт, то закрыть его.

Попробуйте заменить указанную проверку с этим кодом:

if TTextRec(FTextFile).Mode <> fmClosed then 
    CloseFile(FTextFile); 

Отредактировано:

Это не имеет ничего общего с антивирусами блокирующих файл. Это просто ошибка в деструкторе.

Файл уже открыт в режиме открытой записи, оригинальный код закрытия файла только тогда, когда он в режиме открытой записи не - так никогда закрытия файла.

Надеюсь, это объясняет, где произошла ошибка.

Что касается общей конструкции класса регистратора. Это был не вопрос, вопросы были просты, и я представил простое и рабочее решение.

Я думаю, что если бы Симона хотела, чтобы мы научили его создавать логгерский класс, он попросил бы об этом.

Answer 2

Если вам нужен класс журнала ошибок, в котором несколько потоков могут записываться в файл журнала, правильно защитить метод записи с помощью критического раздела.

Теперь, поскольку вы создадите экземпляр одного из этих объектов регистрации ошибок в своем приложении, нет необходимости защищать метод деструктора с критическим сектором.

Местоположение вашего файла журнала ошибок должно находиться в папке данных приложения.

Ошибка 32 ввода/вывода: The process cannot access the file because it is being used by another process.

Причиной этого нарушения обмена может быть в вашем приложении или внешнее приложение. Написание внутри каталога приложения может вызвать некоторую антивирусную защиту, например. Или ваше приложение держит файл открытым в нескольких местах с разными файловыми режимами.

Ваш тест испорчен несколькими способами:

• Инстанцировать класс журнала ошибок один раз при запуске приложения, и уничтожить его, когда приложение закрывается.
• Напишите в журнал ошибок из разных потоков, а не из нескольких итераций в событии таймера.
• Событие таймера должно выполнять только последовательность программ в течение короткой продолжительности.

• попытка/наконец последовательность структурирована следующим образом:

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