Delphi多线程文件写入：I/O错误32

我创建了一个类，用于在文本文件中写入线程安全日志，使用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.

基本形式示例

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

而不是检查TTextRec(FTextFile).Mode <> fmTextOpenWrite您应该检查您的文件是否已关闭，如果是not关闭然后你关闭它。

尝试用以下代码替换提到的检查：

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

Edited:

这与防病毒软件锁定文件无关。这只是析构函数中的一个简单错误。

文件已经以打开写入模式打开，原始代码仅在文件打开时关闭文件not在开放写入模式下 - 就是这样never关闭文件。

希望这能解释错误发生在哪里。

至于logger的类的整体设计。这不是问题，问题很简单，我提供了一个简单且可行的解决方案。

我认为如果 Simone 希望我们教他如何设计记录器类，那么他会提出要求。