Написано в поток

Question

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

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

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

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

Answer 1

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

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

Answer 2

Вы можете взглянуть на наше SynCrtSock Open Source устройство .

Он реализует множество функций (включая сервер 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 - поэтому будет включать Delphi2009 или XE.

Answer 3

Я только что использовал TextStreamUnit Уоррена, и он работает (спасибо Уоррену), но так как мне также понадобился дескриптор, я изменил исходный код, чтобы включить его. Функцию IsFileInUse (FileName), используемую в примере кода, можно найти здесь: 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:\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.

Answer 4

Я отправил это в ответ на другой вопрос, и это подход стоит рассмотреть, хотя вы хотите сделать WriteLn (F, любое, число, из, параметров), и я, к сожалению, не могу точно имитировать WriteLn(F, ...),с моим WriteLine(aString) методом.

1. Я хочу использовать ReadLn и WriteLn, но в потоках.К сожалению, я не могу поддерживать произвольные параметры в WriteLn, но я могу написать строку, которой в сочетании с Format () мне достаточно.т.е. object.WriteLine( Format('stuff %d',[aIntValue]))

2. Я хочу иметь возможность читать любой файл, который может иметь окончания CR, CR + LF или только LF.Мне нужна только поддержка Ansi / Ascii, поскольку в настоящее время она использует RawByteString, однако вы можете легко добавить поддержку UTF8 к этому классу.

3. Современный Stream-подобный класс, эквивалентный TextFile (файлстрок текста).Я называю это TTextFile, и это класс чтения / записи, заключающий в себе Stream.

4. Он должен работать на основе 64-битной позиции файла для файлов> 2 ГБ.

5. Я хочу, чтобы это работало в Delphi 7, а также в Delphi XE2 и между ними.

6. Я хотел, чтобы это было очень-очень-очень быстро,

-

Чтобы выполнить современный 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.