CODEWITHSUNDEEP
performancedelphifile-iodelphi-xe2
philnext
philnext

Reputation: 3402

Text File Writing Performance in Delphi

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;

Upvotes: 6

Views: 10375

Answers (4)

Max DiBiagio
Max DiBiagio

Reputation: 11

for some reason a simple reading from one text file and writing to text output file I found the TextFile WriteLn is still the fastest way.

  AssignFile(t,'c:\a\in.csv');
  Reset(t);
  AssignFile(outt,'c:\a\out.csv');
  ReWrite(outt);
  while not eof(t) do
  begin
    Readln(t,x);
    WriteLn(outt, x);   //27 sec, using LogSW.WriteLine(outx) takes 54 sec

// half Gb file took 27 sec with the above code, using TStreamWriter from example provided by Martijn took 54 seconds :o

Upvotes: 1

Ken White
Ken White

Reputation: 125620

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;

Upvotes: 15

David Dubois
David Dubois

Reputation: 3932

It seems your problem is that you need to flush the cache after each write so that you won't lose data if your application crashes.

Whereas I'm sure the other answers here are excellent, you needn't make such extensive changes to your code. All you need to do is call Flush(FText) after each write. 

const
  // 10 million tests
  NumberOfTests = 1000000;

  // Open and close with each write:        19.250 seconds

  // Open once, and flush after each write:  5.686 seconds

  // Open once, don't flush                  0.439 seconds

var
  FText : Text;
  TmpBuf: array[word] of byte;

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

procedure CloseTheFile;
begin
  CloseFile(FText);
end;

Procedure AddToFile(Source: string);
Begin
  {$I-}
  Writeln(FText, Source);

  // flush the cache after each write so that data will be written
  // even if program crashes.
  flush ( fText );              // <<<====   Flush the Cache after each write

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

  // put file close in a try/finally block to ensure file is closed
  // even if an exception is raised.
  try

    tTime := Now;
    For iBcl := 0 to NumberOfTests-1 do
      AddToFile(IntToStr(ibcl) + '   ' +  'lkjlkjlkjlkjlkjlkjlkj');
    lbl1.Caption  :=  FormatDateTime('sss:zzz',Now-tTime);

  finally
    CloseTheFile;
  end;
end;

Upvotes: 2

kludg
kludg

Reputation: 27493

Instead of reopening file to save critical data on disk you can either use FlushFileBuffers function or open a file for unbuffered I/O by calling the CreateFile function with the FILE_FLAG_NO_BUFFERING and FILE_FLAG_WRITE_THROUGH flags (see Remarks section in the first link).

Upvotes: 3

Related Questions