Back



 
Unit TextStream

Ever wanted to use Read/ReadLn/Write/WriteLn textfile functions on a stream? Here's how!

Sample code:

procedure WriteMonths;
var
  I: Integer;
  T: TextFile;
  S: TStream;
begin
  S := TFileStream.Create(ChangeFileExt(Application.ExeName, '.TXT'),
fmCreate);
  AssignStream(T, S);
  Rewrite(T);
  for I := 1 to 12 do
    WriteLn(T, I:2, '':1, LongMonthNames[I]);
  CloseFile(T);
end;

Now the code of the AssignStream function. See this Unit: (TextStream.Pas)
-------------------------------------------------------------------------------
unit TextStream;

{ Author: \/\//\ Wim, W.A. ten Brink, E-mail : Wim.tenBrink@Ediport.nl,
 phone  : +31 655 76 59 18. Copyright (C) 1999 by Workshop Alex.

   This is Freeware.
   This code is created as a sample about using TextFile functions with more
   complex input/output.
   It's kept simple to encourage other people to create their own TextFile-based
   routines. It's not that difficult... ;)
   I would appreciate bug-reports for this piece of code...}

interface

uses
  SysUtils, Classes;

procedure AssignStream(var T: TextFile; AStream: TStream);

implementation

{ We need to redefine a new TTextRec-UserData type. This can be used to store
  internal data of our textfile. Use as little space as possible. Even better,
  add only a pointer to a larger structure. }
type
  StreamData = record
    Stream: TStream;
    Filler: array[1..16] of Char;
  end;

  { The function that is called when the TextBuffer is flushed or full. }

function StreamWrite(var F: TTextRec): Integer; far;
begin
  StreamData(Pointer(@F.UserData)^).Stream.WriteBuffer(F.BufPtr^, F.BufPos);
  F.BufPos := 0;
  Result := 0;
end;

{ The function that is called when there's nothing left to read in the
  TextBuffer. }

function StreamRead(var F: TTextRec): Integer; far;
begin
  F.BufEnd := StreamData(Pointer(@F.UserData)^).Stream.Read(F.BufPtr^, F.BufSize);
  F.BufPos := 0;
  Result := 0;
end;

{ The Open-function for the TextFile. }

function StreamOpen(var F: TTextRec): Integer; far;
begin
  if (F.Mode = fmInput) then begin
    { Gonna read. }
    F.InOutFunc := @StreamRead;
    F.FlushFunc := Nil;
    StreamData(Pointer(@F.UserData)^).Stream.Position := 0;
    Result := 0;
  end
  else if (F.Mode = fmOutput) then begin
    { Gonna write }
    F.Mode := fmOutput;
    F.InOutFunc := @StreamWrite;
    F.FlushFunc := @StreamWrite;
    StreamData(Pointer(@F.UserData)^).Stream.Position := 0;
    Result := 0;
  end
  else begin
    { Gonna complain... Illegal function. }
    Result := 1;
  end;
end;

{ The Close-function for the TextFile. }

function StreamClose(var F: TTextRec): Integer; far;
begin
  StreamData(Pointer(@F.UserData)^).Stream.Position := 0;
  F.InOutFunc := Nil;
  F.FlushFunc := Nil;
  Result := 0;
end;

{ What to do when assigning the stream? }

procedure AssignStream(var T: TextFile; AStream: TStream);
begin
  with TTextRec(T) do begin
    { Streams have no handle... }
    Handle := 0;
    { After assigning, the file is closed. }
    Mode := fmClosed;
    { A TTextRec includes a Buffer. Just set it's size... }
    BufSize := SizeOf(Buffer);
    { Position inside the buffer: start & Stop. }
    BufPos := 0;
    BufEnd := 0;
    { Pointer to the buffer. (Changes when we call SetTextBuf procedure...) }
    BufPtr := @Buffer;
    { Initialize function-calls. }
    OpenFunc := @StreamOpen;
    InOutFunc := Nil;                   { Closed, so no input/Output routine. }
    FlushFunc := Nil;                   { Closed, so no Flush routine. }
    CloseFunc := @StreamClose;          { Also used as Flush-function when writing. }
    { Set the filename: No name... }
    Name[0] := #0;
    { And finally, our own data... Assign the stream to the file... }
    StreamData(Pointer(@UserData)^).Stream := AStream;
  end;
end;

end.


Back