Text File Writing performances in Delphi

问题

My soft treat incoming strings (from Telnet or HTTP or...), and I have to write text file with Delphi XE2 for having a trace of incomming treated strings. As sometimes the string may crash the program I need to be sure to have the string in my file. So I open/close the file for every incoming string and I have some performance problems. Typically (for my code test) 8 seconds for

My code is here, is there a way to improve the perfs keeping the function ? (For test just create a Form with a Button : Button1, with OnClick event & 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;

回答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;

回答2:

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

回答3:

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;

回答4:

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

来源：https://stackoverflow.com/questions/13306752/text-file-writing-performances-in-delphi