Asynchronous append to .txt file in delphi

2019-06-05 08:18发布

问题:

I'm trying to run a mail server and I want to keep track of the events like login, connect etc.. and I want to save this data in a log .txt file. But since it has to be done asynchronously I don't know how to lock the file for the current data append and then release it for next use. So basically I'm asking for help for a procedure called asyncAppendToFile(fileName : String; textToAppend : String)

procedure SMTPServerUserLogin(ASender: TIdSMTPServerContext;
  const AUsername, APassword: String; var VAuthenticated: Boolean);
begin
  asyncAppendToFile(myFile, 'User ' + AUserName + ' attempts a login');  
end; 

回答1:

From one application, you can make a queue and put the lines there. Then a Thread check for this queue and write to the log file the lines in arriving order.

TWorkerThread = class(TThread)
private
  Killed:boolean;
  ListLock:TRTLCriticalSection;
  Jobs:TStringList;
  JobEvent:TEvent;
protected
  procedure Execute; override;
  procedure DoJob;
public
  constructor Create(CreateSuspended: Boolean);
  destructor Destroy; override;
  procedure AddJob(s:string);
  function  JobCount: Integer;
  procedure Kill;
end;

constructor TWorkerThread.Create(CreateSuspended: Boolean);
begin
  inherited;
  Killed:=false;
  InitializeCriticalSection(ListLock);
  Jobs:=TStringList.Create;
  JobEvent:=TEvent.Create(nil, true, false, 'jobs.event');
end;

destructor TWorkerThread.Destroy;
begin
  Jobs.Free;
  JobEvent.Free;
  DeleteCriticalSection(ListLock);
  inherited;
end;

procedure TWorkerThread.Execute;
begin
  while not Killed or not Self.Terminated do
    begin
      EnterCriticalSection(ListLock);
      if Jobs.Count>0 then
        begin
          LeaveCriticalSection(ListLock);
          DoJob;
        end
      else
        begin
          JobEvent.ResetEvent;
          LeaveCriticalSection(ListLock);
          JobEvent.WaitFor(5000);
        end;
    end;
end;

procedure TWorkerThread.Kill;
begin
  Killed:=true;
  JobEvent.SetEvent;
  Terminate;
end;

procedure TWorkerThread.AddJob(s:string);
begin
  EnterCriticalSection(ListLock);
  try
    Jobs.Add(s);
    JobEvent.SetEvent;
  finally
    LeaveCriticalSection(ListLock);
  end;
end;

procedure TWorkerThread.DoJob;
var f:textfile;
    s:string;

begin
  //Pick the next Job
  EnterCriticalSection(ListLock);
  try
    s:=Jobs[0];
  finally
    LeaveCriticalSection(ListLock);
  end;

  //Do the work
  assignfile (f,'server.log');
  append(f);
  writeln(f,s);
  closefile (f);

  //Delete from queue
  EnterCriticalSection(ListLock);
  try
    Jobs.Delete(0);  
  finally
    LeaveCriticalSection(ListLock);
  end;
end;

In Form Create:

Worker:=TWorkerThread.Create(false);
Worker.Priority:=tpLower;

In Form Destroy:

Worker.Kill;
Worker.WaitFor;
Worker.Free;

Usage:

procedure SMTPServerUserLogin(ASender: TIdSMTPServerContext;
  const AUsername, APassword: String; var VAuthenticated: Boolean);
begin
  Worker.AddJob('User ' + AUserName + ' attempts a login');
end;