Delphi 写入流
有人知道如何将文件（文本）描述符与TStream组件关联，以便像writeln（）这样的I/O可以重定向到流吗？（如FPC单元StreamIO）。是否有一个预定义的函数（我正在使用XE，但如果它在2009年也能工作，那就太好了） 我有很多业务代码依赖于writeln（f，）格式选项，我想通过网络更新这些选项以登录。此升级必须以相对安全的方式完成，因为文件必须保持字节不变 （使用其他方法重写此业务代码实际上不是一个选项，如果它不存在，我将不得不自己尝试，或者将其写入tempfile并读回）Delphi 写入流,delphi,stream,Delphi,Stream,有人知道如何将文件（文本）描述符与TStream组件关联，以便像writeln（）这样的I/O可以重定向到流吗？（如FPC单元StreamIO）。是否有一个预定义的函数（我正在使用XE，但如果它在2009年也能工作，那就太好了） 我有很多业务代码依赖于writeln（f，）格式选项，我想通过网络更新这些选项以登录。此升级必须以相对安全的方式完成，因为文件必须保持字节不变 （使用其他方法重写此业务代码实际上不是一个选项，如果它不存在，我将不得不自己尝试，或者将其写入tempfile并读回） 添加：
添加：欢迎使用任何自定义TextRec示例和/或其中哪些字段具有用户状态的安全空间。下面的Peter也为Delphi编写了这样一个beast，也称为StreamIO，请参见
（链接文章包含该单元）。您可以查看我们的 它实现了许多功能（包括基于http.sys的http/1.1服务器），但也有一些虚拟文本文件要写入套接字。它用于实现HTTP客户端或服务器，或SMTP（发送电子邮件） 这将是一个很好的示例，介绍如何创建“虚拟”TTextRec，包括读写内容，以及如何处理错误。内部缓冲区大小也从其默认值得到了增强-这里默认情况下有1KB的缓存，而不是128字节 例如，以下是如何使用SMTP（从单元中提取的源代码）发送电子邮件：
函数sendmail（const Server:AnsiString；const From，CSVDest，Subject，Text:TSockData；
const Headers:TSockData=''；const User:TSockData=''；const Pass:TSockData=''；
常量端口：AnsiString='25'）：布尔值；
var-TCP:TCrtSocket；
过程预期（常数回答：TSockData）；
var-Res:TSockData；
开始
重复
readln（TCP.SockIn^，Res）；
直到（Length（Res）我在回答另一个问题时发布了这篇文章，虽然您想使用WriteLn（F，any，number，of，parameters），但这恰好是一种值得考虑的方法，不幸的是，我不能用我的WriteLine（aString）
方法准确地模仿WriteLn（F，…）
我想在流上使用ReadLn和WriteLn。不幸的是，我不能在WriteLn中支持任意参数，但我可以编写一个字符串，与Format（）结合使用就足够了。ieobject.WriteLine（Format（'stuff%d'，[aIntValue]）
我希望能够读取任何可能有CR、CR+LF或LF结尾的文件。我只需要Ansi/Ascii支持，因为它目前正在使用RawByteString。但是，您可以轻松地将UTF8支持添加到此类
需要一个类似于TextFile（文本行文件）的现代流类。我称之为TTextFile
，它是一个包装流的读写器类
对于大于2 gb的文件，它应在64位文件位置的基础上工作
我希望它能在Delphi7中工作，也能在Delphi XE2中工作，以及两者之间的一切
我希望它能非常快
--
要在文件流上执行现代写操作，请执行以下操作：
procedure TForm1.Button1Click(Sender: TObject);
var
ts:TTextStream;
begin
ts := TTextStream.Create('c:\temp\test.txt', fm_OpenWriteShared);
try
for t := 1 to 1000 do
ts.WriteLine('something');
end;
finally
ts.Free;
end;
end;
如果您想测试阅读能力，请写以下内容：
procedure TForm1.Button1Click(Sender: TObject);
var
ts:TTextStream;
s:String;
begin
ts := TTextStream.Create('c:\temp\test.txt', fm_OpenReadShared);
try
while not ts.Eof do begin
s := ts.ReadLine;
doSomethingWith(s);
end;
finally
ts.Free;
end;
end;
课程在这里：
unit textStreamUnit;
{$M+}
{$R-}
{
textStreamUnit
This code is based on some of the content of the JvCsvDataSet written by Warren Postma, and others,
licensed under MOZILLA Public License.
}
interface
uses
Windows,
Classes,
SysUtils;
const
cQuote = #34;
cLf = #10;
cCR = #13;
{ File stream mode flags used in TTextStream }
{ Significant 16 bits are reserved for standard file stream mode bits. }
{ Standard system values like fmOpenReadWrite are in SysUtils. }
fm_APPEND_FLAG = $20000;
fm_REWRITE_FLAG = $10000;
{ combined Friendly mode flag values }
fm_Append = fmOpenReadWrite or fm_APPEND_FLAG;
fm_OpenReadShared = fmOpenRead or fmShareDenyWrite;
fm_OpenRewrite = fmOpenReadWrite or fm_REWRITE_FLAG;
fm_Truncate = fmCreate or fm_REWRITE_FLAG;
fm_Rewrite = fmCreate or fm_REWRITE_FLAG;
TextStreamReadChunkSize = 8192; // 8k chunk reads.
resourcestring
RsECannotReadFile = 'Cannot read file %';
type
ETextStreamException = class(Exception);
{$ifndef UNICODE}
RawByteString=AnsiString;
{$endif}
TTextStream = class(TObject)
private
FStream: TFileStream; // Tried TJclFileStream also but it was too slow! Do NOT use JCL streams here. -wpostma.
FFilename: string;
FStreamBuffer: PAnsiChar;
FStreamIndex: Integer;
FStreamSize: Integer;
FLastReadFlag: Boolean;
procedure _StreamReadBufInit;
public
function ReadLine: RawByteString; { read a string, one per line, wow. Text files. Cool eh?}
procedure Append;
procedure Rewrite;
procedure Write(const s: RawByteString); {write a string. wow, eh? }
procedure WriteLine(const s: RawByteString); {write string followed by Cr+Lf }
procedure WriteChar(c: AnsiChar);
procedure WriteCrLf;
//procedure Write(const s: string);
function Eof: Boolean; {is at end of file? }
{ MODE is typically a fm_xxx constant thatimplies a default set of stream mode bits plus some extended bit flags that are specific to this stream type.}
constructor Create(const FileName: string; Mode: DWORD = fm_OpenReadShared; Rights: Cardinal = 0); reintroduce; virtual;
destructor Destroy; override;
function Size: Int64; //override; // sanity
{ read-only properties at runtime}
property Filename: string read FFilename;
property Stream: TFileStream read FStream; { Get at the underlying stream object}
end;
implementation
// 2 gigabyte file limit workaround:
function GetFileSizeEx(h: HFILE; FileSize: PULargeInteger): BOOL; stdcall; external Kernel32;
procedure TTextStream.Append;
begin
Stream.Seek(0, soFromEnd);
end;
constructor TTextStream.Create(const FileName: string; Mode: DWORD; Rights: Cardinal);
var
IsAppend: Boolean;
IsRewrite: Boolean;
begin
inherited Create;
FFilename := FileName;
FLastReadFlag := False;
IsAppend := (Mode and fm_APPEND_FLAG) <> 0;
IsRewrite := (Mode and fm_REWRITE_FLAG) <> 0;
FStream := TFileStream.Create(Filename, {16 lower bits only}Word(Mode), Rights);
//Stream := FStream; { this makes everything in the base class actually work if we inherited from Easy Stream}
if IsAppend then
Self.Append // seek to the end.
else
Stream.Position := 0;
if IsRewrite then
Rewrite;
_StreamReadBufInit;
end;
destructor TTextStream.Destroy;
begin
if Assigned(FStream) then
FStream.Position := 0; // avoid nukage
FreeAndNil(FStream);
FreeMem(FStreamBuffer); // Buffered reads for speed.
inherited Destroy;
end;
function TTextStream.Eof: Boolean;
begin
if not Assigned(FStream) then
Result := False
//Result := True
else
Result := FLastReadFlag and (FStreamIndex >= FStreamSize);
//Result := FStream.Position >= FStream.Size;
end;
{ TTextStream.ReadLine:
This reads a line of text, normally terminated by carriage return and/or linefeed
but it is a bit special, and adapted for CSV usage because CR/LF characters
inside quotes are read as a single line.
This is a VERY PERFORMANCE CRITICAL function. We loop tightly inside here.
So there should be as few procedure-calls inside the repeat loop as possible.
}
function TTextStream.ReadLine: RawByteString;
var
Buf: array of AnsiChar;
n: Integer;
QuoteFlag: Boolean;
LStreamBuffer: PAnsiChar;
LStreamSize: Integer;
LStreamIndex: Integer;
procedure FillStreamBuffer;
begin
FStreamSize := Stream.Read(LStreamBuffer[0], TextStreamReadChunkSize);
LStreamSize := FStreamSize;
if LStreamSize = 0 then
begin
if FStream.Position >= FStream.Size then
FLastReadFlag := True
else
raise ETextStreamException.CreateResFmt(@RsECannotReadFile, [FFilename]);
end
else
if LStreamSize < TextStreamReadChunkSize then
FLastReadFlag := True;
FStreamIndex := 0;
LStreamIndex := 0;
end;
begin
{ Ignore linefeeds, read until carriage return, strip carriage return, and return it }
SetLength(Buf, 150);
n := 0;
QuoteFlag := False;
LStreamBuffer := FStreamBuffer;
LStreamSize := FStreamSize;
LStreamIndex := FStreamIndex;
while True do
begin
if n >= Length(Buf) then
SetLength(Buf, n + 100);
if LStreamIndex >= LStreamSize then
FillStreamBuffer;
if LStreamIndex >= LStreamSize then
Break;
Buf[n] := LStreamBuffer[LStreamIndex];
Inc(LStreamIndex);
case Buf[n] of
cQuote: {34} // quote
QuoteFlag := not QuoteFlag;
cLf: {10} // linefeed
if not QuoteFlag then
Break;
cCR: {13} // carriage return
begin
if not QuoteFlag then
begin
{ If it is a CRLF we must skip the LF. Otherwise the next call to ReadLine
would return an empty line. }
if LStreamIndex >= LStreamSize then
FillStreamBuffer;
if LStreamBuffer[LStreamIndex] = cLf then
Inc(LStreamIndex);
Break;
end;
end
end;
Inc(n);
end;
FStreamIndex := LStreamIndex;
SetString(Result, PAnsiChar(@Buf[0]), n);
end;
procedure TTextStream.Rewrite;
begin
if Assigned(FStream) then
FStream.Size := 0;// truncate!
end;
function TTextStream.Size: Int64; { Get file size }
begin
if Assigned(FStream) then
GetFileSizeEx(FStream.Handle, PULargeInteger(@Result)) {int64 Result}
else
Result := 0;
end;
{ Look at this. A stream that can handle a string parameter. What will they think of next? }
procedure TTextStream.Write(const s: RawByteString);
begin
Stream.Write(s[1], Length(s)); {The author of TStreams would like you not to be able to just write Stream.Write(s). Weird. }
end;
procedure TTextStream.WriteChar(c: AnsiChar);
begin
Stream.Write(c, SizeOf(AnsiChar));
end;
procedure TTextStream.WriteCrLf;
begin
WriteChar(#13);
WriteChar(#10);
end;
procedure TTextStream.WriteLine(const s: RawByteString);
begin
Write(s);
WriteCrLf;
end;
procedure TTextStream._StreamReadBufInit;
begin
if not Assigned(FStreamBuffer) then
begin
//FStreamBuffer := AllocMem(TextStreamReadChunkSize);
GetMem(FStreamBuffer, TextStreamReadChunkSize);
end;
end;
end.
单位文本流单位；
{$M+}
{$R-}
{
文本流单元
此代码基于Warren Postma编写的JvCsvDataSet的一些内容，以及其他内容，
根据MOZILLA公共许可证授权。
}
接口
使用
窗户，
班级，
SysUtils；
常数
cQuote=#34；
cLf=#10；
cCR=#13；
{TTextStream中使用的文件流模式标志}
{为标准文件流模式位保留有效16位。}
{标准系统值（如fmOpenReadWrite）在SysUtils中。}
fm_附加_标志=$20000；
fm_重写_标志=$10000；
{组合友好模式标志值}
fm_Append=fmOpenReadWrite或fm_Append_标志；
fm_OpenReadShared=fmOpenRead或fmShareDenyWrite；
fm_OpenRewrite=fmOpenReadWrite或fm_REWRITE_标志；
fm_Truncate=fmCreate或fm_REWRITE_标志；
fm_Rewrite=fmCreate或fm_Rewrite_标志；
TextStreamReadChunkSize=8192；//8k块读取。
资源字符串
RsECannotReadFile='无法读取文件%'；
类型
ETextStreamException=class（异常）；
{$ifndefunicode}
RawByteString=AnsiString；
{$endif}
TTextStream=类（TObject）
私有的
FStream:TFileStream；//也尝试了TJclFileStream，但速度太慢！不要在此处使用JCL流。-wpostma。
FFilename：字符串；
FStreamBuffer:PAnsiChar；
FStreamIndex：整数；
fstreamize：整数；
FLastReadFlag：布尔型；
程序_StreamReadBufInit；
公众的
函数ReadLine:RawByteString；{读取一个字符串，每行一个，wow.Text files.Cool eh？}
程序附加；
程序重写；
过程写入（const s:RawByteString）{编写一个字符串。哇，嗯？}
过程WriteLine（const s:RawByteString）；{写入字符串，后跟Cr+Lf}
程序编写卡（c:AnsiChar）；
程序编写；
//过程写入（常量s:字符串）；
函数Eof:Boolean；{在文件末尾？}
{MODE通常是一个fm_xxx常量，它意味着一组默认的流模式位加上一些特定于此流类型的扩展位标志。}
构造函数创建（const FileName:string；Mode:DWORD=fm_OpenReadShared；Rights:Cardinal=0）；重新引入；虚拟；
析构函数销毁；重写；
函数大小：Int64；//重写；//健全
{运行时只读属性}
属性文件名：字符串读取FFilename；
属性流：TFileStream read FStream；{获取底层流对象}
结束；
实施
//2 GB文件限制解决方案：
函数GetFileSizeEx（h:HFILE；FileSize:PULargeInteger）：BOOL；stdcall；外部内核32；
加工
unit textStreamUnit;
{$M+}
{$R-}
{
textStreamUnit
This code is based on some of the content of the JvCsvDataSet written by Warren Postma, and others,
licensed under MOZILLA Public License.
}
interface
uses
Windows,
Classes,
SysUtils;
const
cQuote = #34;
cLf = #10;
cCR = #13;
{ File stream mode flags used in TTextStream }
{ Significant 16 bits are reserved for standard file stream mode bits. }
{ Standard system values like fmOpenReadWrite are in SysUtils. }
fm_APPEND_FLAG = $20000;
fm_REWRITE_FLAG = $10000;
{ combined Friendly mode flag values }
fm_Append = fmOpenReadWrite or fm_APPEND_FLAG;
fm_OpenReadShared = fmOpenRead or fmShareDenyWrite;
fm_OpenRewrite = fmOpenReadWrite or fm_REWRITE_FLAG;
fm_Truncate = fmCreate or fm_REWRITE_FLAG;
fm_Rewrite = fmCreate or fm_REWRITE_FLAG;
TextStreamReadChunkSize = 8192; // 8k chunk reads.
resourcestring
RsECannotReadFile = 'Cannot read file %';
type
ETextStreamException = class(Exception);
{$ifndef UNICODE}
RawByteString=AnsiString;
{$endif}
TTextStream = class(TObject)
private
FStream: TFileStream; // Tried TJclFileStream also but it was too slow! Do NOT use JCL streams here. -wpostma.
FFilename: string;
FStreamBuffer: PAnsiChar;
FStreamIndex: Integer;
FStreamSize: Integer;
FLastReadFlag: Boolean;
procedure _StreamReadBufInit;
public
function ReadLine: RawByteString; { read a string, one per line, wow. Text files. Cool eh?}
procedure Append;
procedure Rewrite;
procedure Write(const s: RawByteString); {write a string. wow, eh? }
procedure WriteLine(const s: RawByteString); {write string followed by Cr+Lf }
procedure WriteChar(c: AnsiChar);
procedure WriteCrLf;
//procedure Write(const s: string);
function Eof: Boolean; {is at end of file? }
{ MODE is typically a fm_xxx constant thatimplies a default set of stream mode bits plus some extended bit flags that are specific to this stream type.}
constructor Create(const FileName: string; Mode: DWORD = fm_OpenReadShared; Rights: Cardinal = 0); reintroduce; virtual;
destructor Destroy; override;
function Size: Int64; //override; // sanity
{ read-only properties at runtime}
property Filename: string read FFilename;
property Stream: TFileStream read FStream; { Get at the underlying stream object}
end;
implementation
// 2 gigabyte file limit workaround:
function GetFileSizeEx(h: HFILE; FileSize: PULargeInteger): BOOL; stdcall; external Kernel32;
procedure TTextStream.Append;
begin
Stream.Seek(0, soFromEnd);
end;
constructor TTextStream.Create(const FileName: string; Mode: DWORD; Rights: Cardinal);
var
IsAppend: Boolean;
IsRewrite: Boolean;
begin
inherited Create;
FFilename := FileName;
FLastReadFlag := False;
IsAppend := (Mode and fm_APPEND_FLAG) <> 0;
IsRewrite := (Mode and fm_REWRITE_FLAG) <> 0;
FStream := TFileStream.Create(Filename, {16 lower bits only}Word(Mode), Rights);
//Stream := FStream; { this makes everything in the base class actually work if we inherited from Easy Stream}
if IsAppend then
Self.Append // seek to the end.
else
Stream.Position := 0;
if IsRewrite then
Rewrite;
_StreamReadBufInit;
end;
destructor TTextStream.Destroy;
begin
if Assigned(FStream) then
FStream.Position := 0; // avoid nukage
FreeAndNil(FStream);
FreeMem(FStreamBuffer); // Buffered reads for speed.
inherited Destroy;
end;
function TTextStream.Eof: Boolean;
begin
if not Assigned(FStream) then
Result := False
//Result := True
else
Result := FLastReadFlag and (FStreamIndex >= FStreamSize);
//Result := FStream.Position >= FStream.Size;
end;
{ TTextStream.ReadLine:
This reads a line of text, normally terminated by carriage return and/or linefeed
but it is a bit special, and adapted for CSV usage because CR/LF characters
inside quotes are read as a single line.
This is a VERY PERFORMANCE CRITICAL function. We loop tightly inside here.
So there should be as few procedure-calls inside the repeat loop as possible.
}
function TTextStream.ReadLine: RawByteString;
var
Buf: array of AnsiChar;
n: Integer;
QuoteFlag: Boolean;
LStreamBuffer: PAnsiChar;
LStreamSize: Integer;
LStreamIndex: Integer;
procedure FillStreamBuffer;
begin
FStreamSize := Stream.Read(LStreamBuffer[0], TextStreamReadChunkSize);
LStreamSize := FStreamSize;
if LStreamSize = 0 then
begin
if FStream.Position >= FStream.Size then
FLastReadFlag := True
else
raise ETextStreamException.CreateResFmt(@RsECannotReadFile, [FFilename]);
end
else
if LStreamSize < TextStreamReadChunkSize then
FLastReadFlag := True;
FStreamIndex := 0;
LStreamIndex := 0;
end;
begin
{ Ignore linefeeds, read until carriage return, strip carriage return, and return it }
SetLength(Buf, 150);
n := 0;
QuoteFlag := False;
LStreamBuffer := FStreamBuffer;
LStreamSize := FStreamSize;
LStreamIndex := FStreamIndex;
while True do
begin
if n >= Length(Buf) then
SetLength(Buf, n + 100);
if LStreamIndex >= LStreamSize then
FillStreamBuffer;
if LStreamIndex >= LStreamSize then
Break;
Buf[n] := LStreamBuffer[LStreamIndex];
Inc(LStreamIndex);
case Buf[n] of
cQuote: {34} // quote
QuoteFlag := not QuoteFlag;
cLf: {10} // linefeed
if not QuoteFlag then
Break;
cCR: {13} // carriage return
begin
if not QuoteFlag then
begin
{ If it is a CRLF we must skip the LF. Otherwise the next call to ReadLine
would return an empty line. }
if LStreamIndex >= LStreamSize then
FillStreamBuffer;
if LStreamBuffer[LStreamIndex] = cLf then
Inc(LStreamIndex);
Break;
end;
end
end;
Inc(n);
end;
FStreamIndex := LStreamIndex;
SetString(Result, PAnsiChar(@Buf[0]), n);
end;
procedure TTextStream.Rewrite;
begin
if Assigned(FStream) then
FStream.Size := 0;// truncate!
end;
function TTextStream.Size: Int64; { Get file size }
begin
if Assigned(FStream) then
GetFileSizeEx(FStream.Handle, PULargeInteger(@Result)) {int64 Result}
else
Result := 0;
end;
{ Look at this. A stream that can handle a string parameter. What will they think of next? }
procedure TTextStream.Write(const s: RawByteString);
begin
Stream.Write(s[1], Length(s)); {The author of TStreams would like you not to be able to just write Stream.Write(s). Weird. }
end;
procedure TTextStream.WriteChar(c: AnsiChar);
begin
Stream.Write(c, SizeOf(AnsiChar));
end;
procedure TTextStream.WriteCrLf;
begin
WriteChar(#13);
WriteChar(#10);
end;
procedure TTextStream.WriteLine(const s: RawByteString);
begin
Write(s);
WriteCrLf;
end;
procedure TTextStream._StreamReadBufInit;
begin
if not Assigned(FStreamBuffer) then
begin
//FStreamBuffer := AllocMem(TextStreamReadChunkSize);
GetMem(FStreamBuffer, TextStreamReadChunkSize);
end;
end;
end.
procedure TForm1.Button1Click(Sender: TObject);
const
MAX_RETRIES_TO_LOCK_FILE = 5;
TIME_BETWEEN_LOCK_RETRIES = 300; // ms
FILENAME = 'c:\temp\test.txt';
var
ts:TTextStream;
counter: byte;
begin
try
for counter := 1 to MAX_RETRIES_TO_LOCK_FILE do
begin
if not IsFileInUse(FILENAME) then
begin
// ts := TTextStream.Create(FILENAME, fmCreate or fmShareDenyWrite);
ts := TTextStream.Create(FILENAME, fmOpenReadWrite or fmShareDenyWrite);
if ts.Handle > 0 then
Break
else
FreeAndNil(ts)
end
else
begin
Sleep(TIME_BETWEEN_LOCK_RETRIES); // little pause then try again
end;
end;
if ts.Handle > 0 then
ts.WriteLine('something')
else
MessageDlg('Failed to create create or access file, mtError, [mbOK], 0);
finally
if Assigned(ts) then
begin
FlushFileBuffers(ts.Handle);
FreeAndNil(ts);
end;
end;
end;
unit TextStreamUnit;
{$M+}
{$R-}
{
TextStreamUnit
This code is based on some of the content of the JvCsvDataSet written by Warren Postma, and others,
licensed under MOZILLA Public License.
}
interface
uses
Windows,
Classes,
SysUtils;
const
cQuote = #34;
cLf = #10;
cCR = #13;
{ File stream mode flags used in TTextStream }
{ Significant 16 bits are reserved for standard file stream mode bits. }
{ Standard system values like fmOpenReadWrite are in SysUtils. }
fm_APPEND_FLAG = $20000;
fm_REWRITE_FLAG = $10000;
{ combined Friendly mode flag values }
fm_Append = fmOpenReadWrite or fm_APPEND_FLAG;
fm_OpenReadShared = fmOpenRead or fmShareDenyWrite;
fm_OpenRewrite = fmOpenReadWrite or fm_REWRITE_FLAG;
fm_Truncate = fmCreate or fm_REWRITE_FLAG;
fm_Rewrite = fmCreate or fm_REWRITE_FLAG;
TextStreamReadChunkSize = 8192; // 8k chunk reads.
resourcestring
RsECannotReadFile = 'Cannot read file %';
type
ETextStreamException = class(Exception);
{$ifndef UNICODE}
RawByteString=AnsiString;
{$endif}
TTextStream = class(TObject)
private
FStream: TFileStream; // Tried TJclFileStream also but it was too slow! Do NOT use JCL streams here. -wpostma.
FFilename: string;
FStreamBuffer: PAnsiChar;
FStreamIndex: Integer;
FStreamSize: Integer;
FLastReadFlag: Boolean;
FHandle: integer;
procedure _StreamReadBufInit;
public
function ReadLine: RawByteString; { read a string, one per line, wow. Text files. Cool eh?}
procedure Append;
procedure Rewrite;
procedure Write(const s: RawByteString); {write a string. wow, eh? }
procedure WriteLine(const s: RawByteString); {write string followed by Cr+Lf }
procedure WriteChar(c: AnsiChar);
procedure WriteCrLf;
//procedure Write(const s: string);
function Eof: Boolean; {is at end of file? }
{ MODE is typically a fm_xxx constant thatimplies a default set of stream mode bits plus some extended bit flags that are specific to this stream type.}
constructor Create(const FileName: string; Mode: DWORD = fm_OpenReadShared; Rights: Cardinal = 0); reintroduce; virtual;
destructor Destroy; override;
function Size: Int64; //override; // sanity
{ read-only properties at runtime}
property Filename: string read FFilename;
property Handle: integer read FHandle;
property Stream: TFileStream read FStream; { Get at the underlying stream object}
end;
implementation
// 2 gigabyte file limit workaround:
function GetFileSizeEx(h: HFILE; FileSize: PULargeInteger): BOOL; stdcall; external Kernel32;
procedure TTextStream.Append;
begin
Stream.Seek(0, soFromEnd);
end;
constructor TTextStream.Create(const FileName: string; Mode: DWORD; Rights: Cardinal);
var
IsAppend: Boolean;
IsRewrite: Boolean;
begin
inherited Create;
FFilename := FileName;
FLastReadFlag := False;
IsAppend := (Mode and fm_APPEND_FLAG) <> 0;
IsRewrite := (Mode and fm_REWRITE_FLAG) <> 0;
FStream := TFileStream.Create(Filename, {16 lower bits only}Word(Mode), Rights);
FHandle := FStream.Handle;
//Stream := FStream; { this makes everything in the base class actually work if we inherited from Easy Stream}
if IsAppend then
Self.Append // seek to the end.
else
Stream.Position := 0;
if IsRewrite then
Rewrite;
_StreamReadBufInit;
end;
destructor TTextStream.Destroy;
begin
if Assigned(FStream) then
FStream.Position := 0; // avoid nukage
FreeAndNil(FStream);
FreeMem(FStreamBuffer); // Buffered reads for speed.
inherited Destroy;
end;
function TTextStream.Eof: Boolean;
begin
if not Assigned(FStream) then
Result := False
//Result := True
else
Result := FLastReadFlag and (FStreamIndex >= FStreamSize);
//Result := FStream.Position >= FStream.Size;
end;
{ TTextStream.ReadLine:
This reads a line of text, normally terminated by carriage return and/or linefeed
but it is a bit special, and adapted for CSV usage because CR/LF characters
inside quotes are read as a single line.
This is a VERY PERFORMANCE CRITICAL function. We loop tightly inside here.
So there should be as few procedure-calls inside the repeat loop as possible.
}
function TTextStream.ReadLine: RawByteString;
var
Buf: array of AnsiChar;
n: Integer;
QuoteFlag: Boolean;
LStreamBuffer: PAnsiChar;
LStreamSize: Integer;
LStreamIndex: Integer;
procedure FillStreamBuffer;
begin
FStreamSize := Stream.Read(LStreamBuffer[0], TextStreamReadChunkSize);
LStreamSize := FStreamSize;
if LStreamSize = 0 then
begin
if FStream.Position >= FStream.Size then
FLastReadFlag := True
else
raise ETextStreamException.CreateResFmt(@RsECannotReadFile, [FFilename]);
end
else
if LStreamSize < TextStreamReadChunkSize then
FLastReadFlag := True;
FStreamIndex := 0;
LStreamIndex := 0;
end;
begin
{ Ignore linefeeds, read until carriage return, strip carriage return, and return it }
SetLength(Buf, 150);
n := 0;
QuoteFlag := False;
LStreamBuffer := FStreamBuffer;
LStreamSize := FStreamSize;
LStreamIndex := FStreamIndex;
while True do
begin
if n >= Length(Buf) then
SetLength(Buf, n + 100);
if LStreamIndex >= LStreamSize then
FillStreamBuffer;
if LStreamIndex >= LStreamSize then
Break;
Buf[n] := LStreamBuffer[LStreamIndex];
Inc(LStreamIndex);
case Buf[n] of
cQuote: {34} // quote
QuoteFlag := not QuoteFlag;
cLf: {10} // linefeed
if not QuoteFlag then
Break;
cCR: {13} // carriage return
begin
if not QuoteFlag then
begin
{ If it is a CRLF we must skip the LF. Otherwise the next call to ReadLine
would return an empty line. }
if LStreamIndex >= LStreamSize then
FillStreamBuffer;
if LStreamBuffer[LStreamIndex] = cLf then
Inc(LStreamIndex);
Break;
end;
end
end;
Inc(n);
end;
FStreamIndex := LStreamIndex;
SetString(Result, PAnsiChar(@Buf[0]), n);
end;
procedure TTextStream.Rewrite;
begin
if Assigned(FStream) then
FStream.Size := 0;// truncate!
end;
function TTextStream.Size: Int64; { Get file size }
begin
if Assigned(FStream) then
GetFileSizeEx(FStream.Handle, PULargeInteger(@Result)) {int64 Result}
else
Result := 0;
end;
{ Look at this. A stream that can handle a string parameter. What will they think of next? }
procedure TTextStream.Write(const s: RawByteString);
begin
Stream.Write(s[1], Length(s)); {The author of TStreams would like you not to be able to just write Stream.Write(s). Weird. }
end;
procedure TTextStream.WriteChar(c: AnsiChar);
begin
Stream.Write(c, SizeOf(AnsiChar));
end;
procedure TTextStream.WriteCrLf;
begin
WriteChar(#13);
WriteChar(#10);
end;
procedure TTextStream.WriteLine(const s: RawByteString);
begin
Write(s);
WriteCrLf;
end;
procedure TTextStream._StreamReadBufInit;
begin
if not Assigned(FStreamBuffer) then
begin
//FStreamBuffer := AllocMem(TextStreamReadChunkSize);
GetMem(FStreamBuffer, TextStreamReadChunkSize);
end;
end;
end.