Ответ 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.