Улучшение скорости записи в файл

Ответ 1

Правильный способ ускорить TextFile - использовать SetTextBuf. И возможно добавление {$I-} .... {$I+} вокруг всего доступа к файлу.

var
  TmpBuf: array[word] of byte;

..
  {$I-}
  AssignFile(fout, AFile);
  Append(fout);
  SetTextBuf(fOut,TmpBuf);
  for idx := 0 to ndx do
    begin
      MyPat := CPatientItem(FList.Objects[idx]);
      if not Assigned(MyPat) then Continue;
      MyPat.WriteItem(fout, AReplicat, AllFields);
    end;
  if ioresult<>0 then
    ShowMessage('Error writing file');
  CloseFile(fout);
  {$I+}
end;

Во всех случаях старый API файлов не используется в настоящее время...

{$I-} .... {$I+} должен быть добавлен также вокруг всех ваших подпрограмм, добавляющих содержимое в текстовый файл.

У меня есть эксперимент по созданию огромного текстового файла и буфера. Я написал выделенный класс в подразделе Open Source SynCommons под названием TTextWriter, который ориентирован на UTF-8. Я использую его, в частности, для производства JSON или Запись журнала с максимально возможной скоростью. Он избегает большинства временных распределений кучи (например, для преобразования из целочисленного значения), поэтому он даже очень хорош при многопоточном масштабировании. Некоторые высокоуровневые методы доступны для форматирования некоторого текста из открытого массива, например, функции format(), но гораздо быстрее.

Вот интерфейс этого класса:

  /// simple writer to a Stream, specialized for the TEXT format
  // - use an internal buffer, faster than string+string
  // - some dedicated methods is able to encode any data with JSON escape
  TTextWriter = class
  protected
    B, BEnd: PUTF8Char;
    fStream: TStream;
    fInitialStreamPosition: integer;
    fStreamIsOwned: boolean;
    // internal temporary buffer
    fTempBufSize: Integer;
    fTempBuf: PUTF8Char;
    // [0..4] for 'u0001' four-hex-digits template, [5..7] for one UTF-8 char
    BufUnicode: array[0..7] of AnsiChar;
    /// flush and go to next char
    function FlushInc: PUTF8Char;
    function GetLength: integer;
  public
    /// the data will be written to the specified Stream
    // - aStream may be nil: in this case, it MUST be set before using any
    // Add*() method
    constructor Create(aStream: TStream; aBufSize: integer=1024);
    /// the data will be written to an internal TMemoryStream
    constructor CreateOwnedStream;
    /// release fStream is is owned
    destructor Destroy; override;
    /// retrieve the data as a string
    // - only works if the associated Stream Inherits from TMemoryStream: return
    // '' if it is not the case
    function Text: RawUTF8;
    /// write pending data to the Stream
    procedure Flush;
    /// append one char to the buffer
    procedure Add(c: AnsiChar); overload; {$ifdef HASINLINE}inline;{$endif}
    /// append two chars to the buffer
    procedure Add(c1,c2: AnsiChar); overload; {$ifdef HASINLINE}inline;{$endif}
    /// append an Integer Value as a String
    procedure Add(Value: Int64); overload;
    /// append an Integer Value as a String
    procedure Add(Value: integer); overload;
    /// append a Currency from its Int64 in-memory representation
    procedure AddCurr64(Value: PInt64); overload;
    /// append a Currency from its Int64 in-memory representation
    procedure AddCurr64(const Value: Int64); overload;
    /// append a TTimeLog value, expanded as Iso-8601 encoded text
    procedure AddTimeLog(Value: PInt64);
    /// append a TDateTime value, expanded as Iso-8601 encoded text
    procedure AddDateTime(Value: PDateTime); overload;
    /// append a TDateTime value, expanded as Iso-8601 encoded text
    procedure AddDateTime(const Value: TDateTime); overload;
    /// append an Unsigned Integer Value as a String
    procedure AddU(Value: cardinal); 
    /// append a floating-point Value as a String
    // - double precision with max 3 decimals is default here, to avoid rounding
    // problems
    procedure Add(Value: double; decimals: integer=3); overload;
    /// append strings or integers with a specified format
    // - % = #37 indicates a string, integer, floating-point, or class parameter
    // to be appended as text (e.g. class name)
    // - $ = #36 indicates an integer to be written with 2 digits and a comma
    // - £ = #163 indicates an integer to be written with 4 digits and a comma
    // - µ = #181 indicates an integer to be written with 3 digits without any comma
    // - ¤ = #164 indicates CR+LF chars
    // - CR = #13 indicates CR+LF chars
    // - § = #167 indicates to trim last comma
    // - since some of this characters above are > #127, they are not UTF-8
    // ready, so we expect the input format to be WinAnsi, i.e. mostly English
    // text (with chars < #128) with some values to be inserted inside
    // - if StringEscape is false (by default), the text won't be escaped before
    // adding; but if set to true text will be JSON escaped at writing 
    procedure Add(Format: PWinAnsiChar; const Values: array of const;
      Escape: TTextWriterKind=twNone); overload;
    /// append CR+LF chars
    procedure AddCR; {$ifdef HASINLINE}inline;{$endif}
    /// write the same character multiple times
    procedure AddChars(aChar: AnsiChar; aCount: integer);
    /// append an Integer Value as a 2 digits String with comma
    procedure Add2(Value: integer);
    /// append the current date and time, in a log-friendly format
    // - e.g. append '20110325 19241502 '
    // - this method is very fast, and avoid most calculation or API calls
    procedure AddCurrentLogTime;
    /// append an Integer Value as a 4 digits String with comma
    procedure Add4(Value: integer);
    /// append an Integer Value as a 3 digits String without any added comma
    procedure Add3(Value: integer);
    /// append a line of text with CR+LF at the end
    procedure AddLine(const Text: shortstring);
    /// append a String
    procedure AddString(const Text: RawUTF8); {$ifdef HASINLINE}inline;{$endif}
    /// append a ShortString
    procedure AddShort(const Text: ShortString); {$ifdef HASINLINE}inline;{$endif}
    /// append a ShortString property name, as '"PropName":'
    procedure AddPropName(const PropName: ShortString);
    /// append an Instance name and pointer, as '"TObjectList(00425E68)"'+SepChar
    // - Instance must be not nil
    procedure AddInstanceName(Instance: TObject; SepChar: AnsiChar);
    /// append an Instance name and pointer, as 'TObjectList(00425E68)'+SepChar
    // - Instance must be not nil
    procedure AddInstancePointer(Instance: TObject; SepChar: AnsiChar);
    /// append an array of integers as CSV
    procedure AddCSV(const Integers: array of Integer); overload;
    /// append an array of doubles as CSV
    procedure AddCSV(const Doubles: array of double; decimals: integer); overload;
    /// append an array of RawUTF8 as CSV
    procedure AddCSV(const Values: array of RawUTF8); overload;
    /// write some data as hexa chars
    procedure WrHex(P: PAnsiChar; Len: integer);
    /// write some data Base64 encoded
    // - if withMagic is TRUE, will write as '"\uFFF0base64encodedbinary"'
    procedure WrBase64(P: PAnsiChar; Len: cardinal; withMagic: boolean);
    /// write some #0 ended UTF-8 text, according to the specified format
    procedure Add(P: PUTF8Char; Escape: TTextWriterKind); overload;
    /// write some #0 ended UTF-8 text, according to the specified format
    procedure Add(P: PUTF8Char; Len: PtrInt; Escape: TTextWriterKind); overload;
    /// write some #0 ended Unicode text as UTF-8, according to the specified format
    procedure AddW(P: PWord; Len: PtrInt; Escape: TTextWriterKind); overload;
    /// append some chars to the buffer
    // - if Len is 0, Len is calculated from zero-ended char
    // - don't escapes chars according to the JSON RFC
    procedure AddNoJSONEscape(P: Pointer; Len: integer=0);
    /// append some binary data as hexadecimal text conversion
    procedure AddBinToHex(P: Pointer; Len: integer);
    /// fast conversion from binary data into hexa chars, ready to be displayed
    // - using this function with Bin^ as an integer value will encode it
    // in big-endian order (most-signignifican byte first): use it for display
    // - up to 128 bytes may be converted 
    procedure AddBinToHexDisplay(Bin: pointer; BinBytes: integer);
    /// add the pointer into hexa chars, ready to be displayed
    procedure AddPointer(P: PtrUInt);
    /// append some unicode chars to the buffer
    // - WideCharCount is the unicode chars count, not the byte size
    // - don't escapes chars according to the JSON RFC
    // - will convert the Unicode chars into UTF-8
    procedure AddNoJSONEscapeW(P: PWord; WideCharCount: integer);
    /// append some UTF-8 encoded chars to the buffer
    // - if Len is 0, Len is calculated from zero-ended char
    // - escapes chars according to the JSON RFC
    procedure AddJSONEscape(P: Pointer; Len: PtrInt=0); overload;
    /// append some UTF-8 encoded chars to the buffer, from a generic string type
    // - faster than AddJSONEscape(pointer(StringToUTF8(string))
    // - if Len is 0, Len is calculated from zero-ended char
    // - escapes chars according to the JSON RFC
    procedure AddJSONEscapeString(const s: string); {$ifdef UNICODE}inline;{$endif}
    /// append some Unicode encoded chars to the buffer
    // - if Len is 0, Len is calculated from zero-ended widechar
    // - escapes chars according to the JSON RFC
    procedure AddJSONEscapeW(P: PWord; Len: PtrInt=0);
    /// append an open array constant value to the buffer
    // - "" will be added if necessary
    // - escapes chars according to the JSON RFC
    // - very fast (avoid most temporary storage)
    procedure AddJSONEscape(const V: TVarRec); overload;
    /// append a dynamic array content as UTF-8 encoded JSON array
    // - expect a dynamic array TDynArray wrapper as incoming parameter
    // - TIntegerDynArray, TInt64DynArray, TCardinalDynArray, TDoubleDynArray,
    // TCurrencyDynArray, TWordDynArray and TByteDynArray will be written as
    // numerical JSON values
    // - TRawUTF8DynArray, TWinAnsiDynArray, TRawByteStringDynArray,
    // TStringDynArray, TWideStringDynArray, TSynUnicodeDynArray, TTimeLogDynArray,
    // and TDateTimeDynArray will be written as escaped UTF-8 JSON strings
    // (and Iso-8601 textual encoding if necessary)
    // - any other kind of dynamic array (including array of records) will be
    // written as Base64 encoded binary stream, with a JSON_BASE64_MAGIC prefix
    // (UTF-8 encoded \uFFF0 special code)
    // - examples: '[1,2,3,4]' or '["\uFFF0base64encodedbinary"]'
    procedure AddDynArrayJSON(const DynArray: TDynArray);
    /// append some chars to the buffer in one line
    // - P should be ended with a #0
    // - will write #1..#31 chars as spaces (so content will stay on the same line)
    procedure AddOnSameLine(P: PUTF8Char); overload;
    /// append some chars to the buffer in one line
    // - will write #0..#31 chars as spaces (so content will stay on the same line)
    procedure AddOnSameLine(P: PUTF8Char; Len: PtrInt); overload;
    /// append some wide chars to the buffer in one line
    // - will write #0..#31 chars as spaces (so content will stay on the same line)
    procedure AddOnSameLineW(P: PWord; Len: PtrInt); 
    /// serialize as JSON the given object
    // - this default implementation will write null, or only write the
    // class name and pointer if FullExpand is true - use TJSONSerializer.
    // WriteObject method for full RTTI handling
    // - default implementation will write TList/TCollection/TStrings/TRawUTF8List
    // as appropriate array of class name/pointer (if FullExpand=true) or string
    procedure WriteObject(Value: TObject; HumanReadable: boolean=false;
      DontStoreDefault: boolean=true; FullExpand: boolean=false); virtual;
    /// the last char appended is canceled
    procedure CancelLastChar; {$ifdef HASINLINE}inline;{$endif}
    /// the last char appended is canceled if it was a ','
    procedure CancelLastComma; {$ifdef HASINLINE}inline;{$endif}
    /// rewind the Stream to the position when Create() was called
    procedure CancelAll;
    /// count of add byte to the stream
    property TextLength: integer read GetLength;
    /// the internal TStream used for storage
    property Stream: TStream read fStream write fStream;
  end;

Как вы можете видеть, существует даже некоторая сериализация, и методы CancelLastComma / CancelLastChar очень полезны для получения быстрых данных JSON или CSV из цикла.

О скорости и времени, эта процедура работает быстрее, чем мой доступ к диску, что составляет около 100 МБ/с. Я думаю, что он может достичь около 500 МБ/с при добавлении данных в TMemoryStream вместо TFileStream.

Ответ 2

Я не делал этого некоторое время, но вы должны иметь возможность устанавливать более крупный буфер ввода-вывода текста следующим образом:

var
  fout : TextFile;
  idx, ndx : integer;
  MyPat : CPatientItem;
  Buffer: array[0..65535] of char; // 64K - example
begin
  ndx := FList.Count - 1;
  AssignFile(fout, AFile);
  SetTextBuf(fout, Buffer);
  Append(fout);

Ответ 3

Используйте Process Explorer из SysInternals для просмотра вывода. Я думаю, вы увидите, что пишете тысячи или миллионы маленьких кусков. Использование потокового ввода-вывода, в котором вы пишете одну операцию ввода-вывода, значительно улучшит ситуацию.

http://live.sysinternals.com/procexp.exe

Ответ 4

Когда я работал над пакетом архива, я заметил повышение производительности, когда я писал куски по 512 байт, что является размером по умолчанию для сектора диска. Обратите внимание, что размер сектора диска и размер блока файловой системы - это две разные вещи! Существуют функции WinAPI, которые получат размер блока вашего раздела - посмотрите здесь.

Ответ 5

Я бы предложил переключиться на TFileStream или TMemoryStream, а не на файл в стиле старого стиля. Если вы используете TFileStream, вы можете установить размер файла один раз на основе оценки того, что вам нужно, вместо того, чтобы искать в программе следующий пустой блок пространства для использования для каждой записи. Затем вы можете расширить его или усечь его по мере необходимости. Если вы используете TMemoryStream - сохраните данные и используйте SaveToFile() - все это будет выписано из памяти в файл за один раз. Это должно ускорить процесс для вас.

Ответ 6

Я подозреваю, что время записи НЕ является проблемой. Отнимающая много времени часть подпрограммы вытесняет 500 полей. Вы можете проверить это, заменив поток потокового mecahanism на константную строку эквивалентной длины. Я гарантирую, что это будет намного быстрее. Итак, чтобы оптимизировать процедуру, вам необходимо оптимизировать потоковое поле, а не фактическую запись!