異步追加到德爾福的.txt文件

Question

我想運行一個郵件服務器，我想跟蹤登錄，連接等事件。我想將這些數據保存在日誌.txt文件中。但由於它必須異步完成，我不知道如何鎖定當前數據附加的文件，然後釋放它以備下次使用。所以基本上我要求的程序說明所謂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; 

Answer 1

從一個應用程序，你可以做一個隊列，把線那裏。然後一個線程檢查這個隊列，並按照到達順序寫入日誌文件中的行。

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; 

在窗體創建：

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

形式破壞：

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

用法：

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