6

我的程序正在处理传入的字符串（来自 Telnet、HTTP 等），我必须使用 Delphi XE2 将这些字符串写入文本文件以进行日志记录。

有时程序可能会崩溃，我需要确保剩余的字符串不会丢失，所以我打开/关闭每个传入字符串的文件，我遇到了一些性能问题。例如，下面的代码需要 8 秒才能完成。

我的代码包含在下面，有什么方法可以提高性能吗？

（对于下面的测试，只需创建一个带有 a Button : Button1、带有OnClick事件和 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;
4

4 回答 4

15

使用 a TStreamWriter，它是自动缓冲的，并且可以处理将其缓冲区自动刷新到TFileStream。如果需要，它还允许您选择附加到现有文件，设置字符编码以支持 Unicode，并允许您在其各种重载Create构造函数中设置不同的缓冲区大小（默认为 1024 字节或 1K）。

（请注意，刷新TStreamWriter仅将 的内容写入TStreamBuffer；TFileStream它不会刷新 OS 文件系统缓冲区，因此在TFileStream释放 之前，该文件实际上并未写入磁盘。）

不要每次都创建 StreamWriter；只需创建并打开一次，最后关闭它：

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;
于 2012-11-09T12:57:07.190 回答
3

除了重新打开文件来将关键数据保存在磁盘上，您还可以使用FlushFileBuffers函数或通过调用带有and标志的CreateFile函数来打开文件以进行无缓冲 I/O （参见第一个链接中的部分）。FILE_FLAG_NO_BUFFERINGFILE_FLAG_WRITE_THROUGHRemarks

于 2012-11-09T11:33:53.447 回答
2

您的问题似乎是您需要在每次写入后刷新缓存，以便在应用程序崩溃时不会丢失数据。

尽管我确信这里的其他答案非常好，但您无需对代码进行如此广泛的更改。您需要做的就是 Flush(FText) 在每次写入后调用。

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;
于 2012-11-10T12:18:58.027 回答
1

出于某种原因，从一个文本文件中简单地读取并写入文本输出文件我发现 TextFile WriteLn 仍然是最快的方法。

  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

// 使用上述代码，半 Gb 文件耗时 27 秒，使用 Martijn 提供的示例中的 TStreamWriter 耗时 54 秒：o

于 2015-10-27T19:32:41.167 回答