2012-01-31 17 views
11

¿Alguien sabe cómo asociar un descriptor de archivo (texto) con un componente TStream, para que writeln() como E/S pueda ser redirigido a la secuencia? (como la unidad FPC StreamIO). ¿Hay una función predefinida en algún lugar (estoy usando XE, pero sería bueno si también funcionó en 2009)Writeln para transmitir

Tengo un montón de código de negocio que se basa en el writeln (f), como las opciones de formato que Me gustaría actualizar para iniciar sesión en la red. Esta actualización debe realizarse de una manera relativamente segura, ya que los archivos deben permanecer iguales al byte.

(Reescribiendo el código de negocio utilizando otros medios no es realmente una opción, si no existe Voy a tener que probar a mí mismo, o va a tener que ver con una escritura a un archivo temporal y la lectura de vuelta)

Agregado: cualquier ejemplo de textrecs personalizados sería bienvenido y/o cuáles campos tienen espacio seguro para el estado del usuario.

Respuesta

10

Peter A continuación escribió una bestia para Delphi también, también llamado StreamIO, ver http://groups.google.com/group/borland.public.delphi.objectpascal/msg/d682a8b5a5760ac4?pli=1

(post vinculado contiene la unidad).

+1

+1 retén agradable. Supongo que la unidad de FPC StreamIO es básicamente la misma ... Pero no estoy seguro de que maneje texto Unicode. Probablemente se sorprenderá con el tipo de texto Ansi cuando use Writeln(). Y no olvide configurar {$ I-} para un proceso mucho más rápido, si está seguro de que su destino TStream no fallará. –

+0

Nombre de la misma unidad, el mismo nombre de función, tomaremos esto, muchas gracias :-) –

+0

Puede darnos algún ejemplo de cómo usar esta unidad. – Branko

3

Puede echar un vistazo a nuestro SynCrtSock Open Source unit.

Implementa muchas características (incluido un servidor HTTP/1.1 basado en http.sys), pero también tiene algunos archivos de texto virtual para escribir en un socket. Se usa, p. implementar un cliente o servidor HTTP, o SMTP (para enviar un correo electrónico).

Será una buena muestra de cómo crear un "virtual" TTextRec, incluida la lectura de contenido de escritura &, y también la manipulación de errores. El tamaño del búfer interno también se mejora a partir de su valor predeterminado: aquí tiene 1 KB de almacenamiento en caché de forma predeterminada, en lugar de 128 bytes.

Por ejemplo, aquí es cómo se puede utilizar para enviar un correo electrónico a través de SMTP (código fuente extrae de la unidad):

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; 

Se producirá solamente ANSI contenido, por definición.

Dirige Delphi 5 hasta XE2, por lo que incluirá Delphi 2009 o XE.

+0

+1 También es bueno porque muestra las otras funciones. Sin embargo, no parece seguro a 64 bits. El controlador * nix es de 32 bits, y un puntero no encaja en él. –

+0

Hmm, en la segunda comprobación, Delphi lo define como THandle. Un tipo de Windows, y no sé cómo lo definen en * nix. –

1

Publiqué esto en respuesta a otra pregunta, y resulta ser un enfoque que vale la pena considerar aunque quiera escribir WriteLn (F, cualquiera, número, de, parámetros), y lamentablemente no puedo imitar exactamente WriteLn(F, ...), con mi método WriteLine(aString).

  1. Quiero usar ReadLn y WriteLn, pero en los arroyos. Desafortunadamente no puedo soportar parámetros arbitrarios en WriteLn, pero puedo escribir una cadena, que en combinación con Format() es suficiente para mí. es decir, object.WriteLine(Format('stuff %d',[aIntValue]))

  2. Quiero poder leer cualquier archivo que pueda tener CR, CR + LF o solo terminaciones LF. Solo quiero compatibilidad con Ansi/Ascii, ya que actualmente usa RawByteString, sin embargo, puede agregar fácilmente el soporte UTF8 a esta clase.

  3. Se necesita una clase similar a Stream moderna equivalente a TextFile (archivo de líneas de texto). Lo llamo TTextFile, y es una clase de lector/escritor que envuelve un Stream.

  4. Debería funcionar en una base de posición de archivos de 64 bits para archivos> 2 gb.

  5. Quiero que esto funcione en Delphi 7, y también en Delphi XE2, y todo lo demás.

  6. Quería que fuera muy, muy, muy rápido.

-

para hacer un WriteLn moderna en una secuencia de archivo, se podría hacer esto:

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; 

Esto es lo que iba a escribir si quieres probar la lectura:

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; 

La clase está aquí:

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. 
+0

¿Cómo funciona esto sin cambios en el código comercial?Que fueron explícitamente excluidos? –

+0

No puedo proporcionar esa parte de este enfoque. Puedes escribir una verdadera función var-args en C/C++, pero no puedes hacerlo con Pascal, y entonces estás atrapado usando WriteLn, que tiene su propio conjunto de inconvenientes. Lo publiqué porque otros que buscan el nombre de la pregunta podrían no estar en contra de cambiar WriteLn (F, x, y, z) a F.WriteLine (FOrmat ('aaa', [x, y, z])) –

+0

No estoy viendo la verdad del comentario C Para este tipo de material de const sería suficiente, SI tuviera que reescribirlo. Pero está cambiando el posicionamiento exacto y el formato de punto flotante que quiero evitar, ya que varios clientes tienen sus propios analizadores hechos a mano (y probablemente con errores horribles) para el formato. O algunos clientes que notan un algo de redondeo ligeramente diferente, etc. –

1

Acabo de utilizar Warren's TextStreamUnit y funciona (gracias Warren), pero como también necesitaba un Handle he modificado el código fuente para incluirlo. La función IsFileInUse (FileName) utilizada en el código de ejemplo se puede encontrar aquí: http://delphi.about.com/od/delphitips2009/qt/is-file-in-use.htm. Esta combinación me ha ayudado a manejar todas las situaciones probadas cuando varios clientes leen a menudo algún archivo de red, pero rara vez escriben en él, sin que algunas aplicaciones de servidor serialicen las solicitudes de escritura. Siéntase libre de hacer cualquier mejora en mi código de muestra modificado. Por cierto, es probable que desee mostrar el cursor del reloj de arena durante esta operación.

Aquí es el código de ejemplo:

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; 

Aquí está la unidad modificada:

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. 
Cuestiones relacionadas