Writeln to stream

Кто-нибудь знает, как связать дескриптор файла (текста) с компонентом TStream, так что writeln() как I/O может быть перенаправлен в поток? (например, блок FPC StreamIO). Есть некоторая предопределенная функция где-нибудь (я использую XE, но было бы неплохо, если бы она также работала в 2009 году)

У меня много бизнес-кода, который опирается на параметры writeln (f,), подобные форматированию, которые я бы хотел обновить для входа в сеть. Это обновление должно выполняться относительным безопасным способом, поскольку файлы должны оставаться неизменными для байта.

(Переписывание этого бизнес-кода с использованием других средств на самом деле не является опцией, если он не существует, мне придется попробовать себя или сделать запись в файл tempfile и прочитать его обратно)

Добавлено: любой пример пользовательских textrecs будет приветствоваться и/или в каком из этих полей есть безопасная комната для пользовательского состояния.

Ответы

Ответ 1

Питер Ниже написал такого зверя для Delphi тоже, также называемого StreamIO, см. http://groups.google.com/group/borland.public.delphi.objectpascal/msg/d682a8b5a5760ac4?pli=1

(связанная почта содержит блок).

Ответ 2

Вы можете посмотреть наш SynCrtSock блок с открытым исходным кодом.

Он реализует множество функций (включая HTTP/1.1 сервер http.sys), но он также имеет некоторые виртуальные текстовые файлы для записи в сокет. Он используется, например, для реализации HTTP-клиента или сервера или SMTP (для отправки электронной почты).

Это будет хороший пример того, как создать "виртуальный" TTextRec, включая чтение и запись контента, а также обработку ошибок. Размер внутреннего буфера также увеличивается с его значения по умолчанию - здесь у вас есть 1 Кбайт кэширования по умолчанию, а не 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.

Ответ 3

Я разместил это в ответ на другой вопрос, и, похоже, это подход, который стоит рассмотреть, хотя вы хотите сделать 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 для этого класса.
Требуется современный Stream-подобный класс, эквивалентный TextFile (файл строк текста). Я называю это TTextFile, и класс читателя/писателя обертывает Stream.
Он должен работать на основе 64-битной позиции файла для файлов > 2 gb.
Я хочу, чтобы это работало в Delphi 7, а также в Delphi XE2 и все между ними.
Я хотел, чтобы это было очень быстро.

Чтобы сделать современный WriteLn в потоке файлов, вы сделаете следующее:

  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.

Ответ 4

Я только что использовал Warren TextStreamUnit, и он работает (спасибо Уоррен), но так как мне также нужна ручка, я изменил исходный код, чтобы включить его. Функция IsFileInUse (FileName), используемая в примере кода, находится здесь: http://delphi.about.com/od/delphitips2009/qt/is-file-in-use.htm. Эта комбинация помогла мне справиться со всеми проверенными ситуациями, когда несколько клиентов часто читают какой-либо сетевой файл, но редко пишут на него, не имея сериализации запросов на запись в сервере. Не стесняйтесь делать какие-либо улучшения в моем модифицированном образце кода. Btw, вы, вероятно, захотите отобразить часовой указатель в течение этой операции.

Вот пример кода:

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.