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)异常（可能是因为在另一个线程中使用）

我在哪里做错了？

更新

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

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);

<强>被修改：

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

文件已在开放式写入模式下打开，原始代码仅在处于打开写入模式时不时关闭文件 - 因此从不关闭文件。

希望这能解释错误发生的位置。

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

我认为如果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;

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

2 个答案: