Text File Writing Performance in Delphi

Question

My program is processing incoming strings (from Telnet, HTTP, etc), and I have to write these to a text file with Delphi XE2 for logging purposes.

Sometimes the program may crash and I need to be sure that the remaining strings are not lost so I open/close the file for every incoming string and I have some performance problems. The code below, for example, takes 8 seconds to complete.

My code is included below, is there some way to improve the performance?

(For the test below simply create a Form with a Button : Button1, with OnClick event and a Label : lbl1).

Procedure AddToFile(Source: string; FileName :String);
var
  FText : Text;
  TmpBuf: array[word] of byte;
Begin
  {$I-}
  AssignFile(FText, FileName);
  Append(FText);
  SetTextBuf(FText, TmpBuf);
  Writeln(FText, Source);
  CloseFile(FText);
  {$I+}
end;

procedure initF(FileName : string);
Var  FText : text;
begin
  {$I-}
  if FileExists(FileName) then  DeleteFile(FileName);
  AssignFile(FText, FileName);
  ReWrite(FText);
  CloseFile(FText);
  {$I+}
end;

procedure TForm1.Button1Click(Sender: TObject);
var tTime : TDateTime;
    iBcl : Integer;
    FileName : string;
begin
  FileName := 'c:\Test.txt';
  lbl1.Caption := 'Go->' + FileName; lbl1.Refresh;
  initF(FileName);
  tTime := Now;
  For iBcl := 0 to 2000 do
    AddToFile(IntToStr(ibcl) + '   ' +  'lkjlkjlkjlkjlkjlkjlkj' , FileName);
  lbl1.Caption  :=  FormatDateTime('sss:zzz',Now-tTime);
end;

Answer 1

Use a TStreamWriter, which is automatically buffered, and can handle flushing its buffers to the TFileStream automatically. It also allows you to choose to append to an existing file if you need to, set character encodings for Unicode support, and lets you set a different buffer size (the default is 1024 bytes, or 1K) in its various overloaded Create constructors.

(Note that flushing the TStreamWriter only writes the content of the TStreamBuffer to the TFileStream; it doesn't flush the OS file system buffers, so the file isn't actually written on disk until the TFileStream is freed.)

Don't create the StreamWriter every time; just create and open it once, and close it at the end:

function InitLog(const FileName: string): TStreamWriter;
begin
  Result := TStreamWriter.Create(FileName, True);
  Result.AutoFlush := True;         // Flush automatically after write
  Result.NewLine := sLineBreak;     // Use system line breaks
end;

procedure CloseLog(const StreamWriter: TStreamWriter);
begin
  StreamWriter.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var 
  tTime : TDateTime;
  iBcl : Integer;
  LogSW: TStreamWriter;
  FileName: TFileName;
begin
  FileName := 'c:\Test.txt';
  LogSW := InitLog(FileName);
  try
    lbl1.Caption := 'Go->' + FileName; 
    lbl1.Refresh;
    tTime := Now;

    For iBcl := 0 to 2000 do
      LogSW.WriteLine(IntToStr(ibcl) + '   ' +  'lkjlkjlkjlkjlkjlkjlkj');

    lbl1.Caption  :=  FormatDateTime('sss:zzz',Now - tTime);
  finally
    CloseLog(LogSW);
  end;
end;