Delphi多线程文件写入：I/O错误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;

日志已写入，但偶尔会在CloseFile(FTextFile) 上引发I/O Error 32 异常（可能是因为在另一个线程中使用）

我哪里做错了？

更新：

在阅读了所有 cmets 和答案后，我完全改变了方法。我分享我的解决方案。

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

Answer 1

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

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

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

已编辑：

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

文件已经以开放写入模式打开，原始代码仅在不处于开放写入模式时才关闭文件 - 所以它从不关闭文件。

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

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

我认为如果 Simone 想要我们教他如何设计记录器类，那么他会要求的。

Answer 2

如果你想要一个错误日志类，多个线程可以写入一个日志文件，用临界区保护写入方法是正确的。

现在，由于您只会在应用程序中实例化其中一个错误记录对象，因此无需使用临界区来保护析构函数。

错误日志文件的位置应位于应用程序数据文件夹中。

I/O 错误 32 是：The process cannot access the file because it is being used by another process.

这种共享冲突的原因可能在于您的应用程序或外部应用程序。 例如，在应用程序目录中写入可能会触发一些防病毒保护。或者您的应用程序在多个位置以不同的文件模式保持文件处于打开状态。

您的测试在多个方面存在缺陷：

• 在应用程序启动时将错误日志类实例化一次，并在应用程序关闭时将其销毁。
• 从不同的线程写入错误日志，而不是从计时器事件中的多次迭代写入。
• 定时器事件应该只在短时间内执行程序序列。

• try / finally 序列的结构如下：

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