Writeln to stream

有人知道如何将文件(文本(描述符与 TStream 组件相关联，以便像 I/O 这样的 writeln(( 可以重定向到流？(如FPC单元StreamIO(。某处是否有预定义的功能(我正在使用XE，但如果它也适用于2009年就好了(

我有很多业务代码依赖于 writeln(f，( 之类的格式化选项，我想更新这些选项以通过网络登录。此升级必须以相对安全的方式完成，因为文件必须与字节相同。

(使用其他方式重写此业务代码实际上不是一种选择，如果它不存在，我将不得不自己尝试，或者必须与写入临时文件并读回它有关(

补充：欢迎任何自定义文本记录的示例和/或其中哪些字段具有用户状态的安全空间。

Peter Below也为Delphi写了这样一个野兽，也叫StreamIO，见 http://groups.google.com/group/borland.public.delphi.objectpascal/msg/d682a8b5a5760ac4?pli=1

(链接的帖子包含单元(。

您可以查看我们的SynCrtSock开源单元。

它实现了很多功能(包括基于 http.sys 的 HTTP/1.1 服务器(，但它也有一些虚拟文本文件可以写入套接字。例如，它用于实现HTTP客户端或服务器，或SMTP(发送电子邮件(。

这将是如何创建"虚拟"TTextRec的一个很好的示例，包括读取和写入内容，以及处理错误。内部缓冲区大小也从其默认值增强 - 此处默认有 1KB 的缓存，而不是 128 字节。

例如，以下是如何使用它通过SMTP(从单元中提取的源代码(发送电子邮件：

function SendEmail(const Server: AnsiString; const From, CSVDest, Subject, Text: TSockData;
  const Headers: TSockData=''; const User: TSockData=''; const Pass: TSockData='';
  const Port: AnsiString='25'): boolean;
var TCP: TCrtSocket;
procedure Expect(const Answer: TSockData);
var Res: TSockData;
begin
  repeat
    readln(TCP.SockIn^,Res);
  until (Length(Res)<4)or(Res[4]<>'-');
  if not IdemPChar(pointer(Res),pointer(Answer)) then
    raise Exception.Create(string(Res));
end;
procedure Exec(const Command, Answer: TSockData);
begin
  writeln(TCP.SockOut^,Command);
  Expect(Answer)
end;
var P: PAnsiChar;
    rec, ToList: TSockData;
begin
  result := false;
  P := pointer(CSVDest);
  if P=nil then exit;
  TCP := Open(Server, Port);
  if TCP<>nil then
  try
    TCP.CreateSockIn; // we use SockIn and SockOut here
    TCP.CreateSockOut;
    Expect('220');
    if (User<>'') and (Pass<>'') then begin
      Exec('EHLO '+Server,'25');
      Exec('AUTH LOGIN','334');
      Exec(Base64Encode(User),'334');
      Exec(Base64Encode(Pass),'235');
    end else
      Exec('HELO '+Server,'25');
    writeln(TCP.SockOut^,'MAIL FROM:<',From,'>'); Expect('250');
    ToList := 'To: ';
    repeat
      rec := trim(GetNextItem(P));
      if rec='' then continue;
      if pos(TSockData('<'),rec)=0 then
        rec := '<'+rec+'>';
      Exec('RCPT TO:'+rec,'25');
      ToList := ToList+rec+', ';
    until P=nil;
    Exec('DATA','354');
    writeln(TCP.SockOut^,'Subject: ',Subject,#13#10,
      ToList,#13#10'Content-Type: text/plain; charset=ISO-8859-1'#13#10+
      'Content-Transfer-Encoding: 8bit'#13#10,
      Headers,#13#10#13#10,Text);
    Exec('.','25');
    writeln(TCP.SockOut^,'QUIT');
    result := true;
  finally
    TCP.Free;
  end;
end;

根据定义，它将仅生成 Ansi 内容。

它的目标是Delphi 5到XE2 - 因此将包括Delphi 2009或XE。

我发布了这个来回答另一个问题，它恰好是一种值得考虑的方法，尽管你想做 WriteLn(F，any，number，of，parameters(，不幸的是，我不能完全模仿WriteLn(F, ...)，用我的WriteLine(aString)方法。

我想使用 ReadLn 和 WriteLn，但在流上。不幸的是，我不能在 WriteLn 中支持任意参数，但我可以编写一个字符串，它与 Format(( 结合使用对我来说就足够了。即object.WriteLine( Format('stuff %d',[aIntValue]))
我希望能够读取任何可能有 CR、CR+LF 或只是 LF 结尾的文件。我只想要Ansi/ASCII支持，因为它目前使用的是RawByteString，但是，您可以轻松地将UTF8支持添加到此类中。
需要一个等效于文本文件(文本行文件(的现代类似流的类。我称之为TTextFile，它是一个包装Stream的读者/作家类。
对于 2 GB>的文件，它应该在 64 位文件位置的基础上工作。
我希望这在Delphi 7中起作用，也可以在Delphi XE2中工作，以及介于两者之间的所有内容。
我希望它非常非常快。

要在文件流上执行现代 WriteLn，您需要执行以下操作：

  procedure TForm1.Button1Click(Sender: TObject);
    var
    ts:TTextStream;
    begin
     ts := TTextStream.Create('c:temptest.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:temptest.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.

我刚刚使用了Warren的TextStreamUnit并且可以工作(谢谢Warren(，但由于我也需要一个句柄，所以我修改了源代码以包含它。示例代码中使用的函数 IsFileInUse(文件名(可以在此处找到：http://delphi.about.com/od/delphitips2009/qt/is-file-in-use.htm。这种组合帮助我处理了所有测试情况，即多个客户端经常读取某些网络文件但很少写入该文件，而无需某些服务器应用程序序列化写入请求。请随时对修改后的示例代码进行任何改进。顺便说一句，您可能希望在此操作期间显示沙漏光标。

下面是示例代码：

procedure TForm1.Button1Click(Sender: TObject);
const
  MAX_RETRIES_TO_LOCK_FILE = 5;
  TIME_BETWEEN_LOCK_RETRIES = 300; // ms
  FILENAME = 'c:temptest.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.

相关内容

最新更新

热门标签：